[Gambas-user] How can I print my Gambas program code?

[Charlie Reinl]

Salut,

I found that in my archive,
It is gambas1 code who printed the open source and was called like this

> PUBLIC SUB mnuSourcePrinter_Click()
>     lp AS NEW CPrintSource
>     lp.LPrint(Name, Path, edtEditor)
> END
the code came original from a guy called Carsten Olsen and that was in
end 2004.

So look if you can use.

-- 
Amicalement
Charlie
-------------- next part --------------
' Gambas class file
PRIVATE sName           AS String
PRIVATE sPath           AS String
PRIVATE edtSource       AS GambasEditor
PRIVATE sTimestamp      AS String

PRIVATE iPosX           AS Integer
PRIVATE iPosY           AS Integer
PRIVATE iPageNo         AS Integer
PRIVATE iLineNo         AS Integer
PRIVATE iMaxString      AS Integer

PRIVATE iColors         AS NEW Integer[]
PRIVATE fntPrintFont    AS NEW Font
PRIVATE bPrintLineNo    AS Boolean
PRIVATE bPrintColor     AS Boolean
PRIVATE bPrintUseRelief AS Boolean

CONST iRightMargin      AS Integer = 200
CONST iLeftMargin       AS Integer = 200
CONST iTopMargin        AS Integer = 200
CONST iBottomMargin     AS Integer = 200

CONST placeCenter       AS String = "C"
CONST placeRight        AS String = "R"
CONST placeLeft         AS String = "L"

PUBLIC SUB _new()
  DIM n AS Integer

  iPageNo = 0
  iLineNo = 0
  FOR n = 0 TO 15
    iColors.Add(Val(Settings["/PrintSource/Color[" & Str(n) & "]", "-1"]))
  NEXT
  fntPrintFont = Font[Settings["/PrintSource/Font", Project.DEFAULT_FONT]]
  bPrintLineNo = Settings["/PrintSource/PrintLineNo", FALSE]
  bPrintColor = Settings["/PrintSource/PrintColor", FALSE]
  bPrintUseRelief = Settings["/PrintSource/PrintUseRelief", FALSE]
  
  sTimestamp = Format$(Now, "yyyy-mm-dd hh.nn.ss")

END

PUBLIC SUB _free()

END

PUBLIC SUB LPrint(Name AS String, Path AS String, Source AS GambasEditor)
  DIM iLine AS Integer
  
  sName = Name
  sPath = Path
  edtSource = Source

  IF printer.Setup() THEN
    ' nothing
  ELSE
    BeginPrinter()
    Draw.Font = fntPrintFont
    iMaxString = (Printer.Width - iLeftMargin - iRightMargin) / Draw.TextWidth(" ")

    PrntHeader(fntPrintFont)
    FOR iLine = 0 TO edtSource.Lines.Count
      LinePrint(edtSource.Lines[iLine], fntPrintFont, bPrintLineNo)
    NEXT
    PrntFooter(fntPrintFont)
    ClosePrinter()  
  ENDIF
  
END

PRIVATE PROCEDURE BeginPrinter()
  WAIT 0
  iPosX = iLeftMargin
  iPosY = iTopMargin
  Draw.Begin(Printer)
END

PRIVATE SUB ClosePrinter()
  WAIT 0
  Draw.End()
END

PRIVATE SUB LinePrint(Text AS String, Fnt AS font, PrintLineNo AS Boolean)
  DIM sText AS String
    
  DIM sSymbols AS String[]
  DIM iTypes AS Integer[]
  DIM iPositionss AS Integer[]

  DIM sSubText AS String[]
  DIM sWord AS String

  DIM sSymbol AS String
  DIM iType AS Integer
  DIM iLength AS Integer
  DIM iNoOfSpaces AS Integer
  DIM iPositions AS Integer
  DIM n AS Integer
  DIM m AS Integer

  INC iLineNo 
  
  IF PrintLineNo THEN
    Prnt(Format(iLineNo, "0000: "), -1, Fnt)
  ENDIF
  sText = Text
  GambasEditor.Analyze(sText)
  sSymbols = GambasEditor.Symbols
  iTypes = GambasEditor.Types
  iPositionss = GambasEditor.Positions
  
  iLength = 0
  FOR n = 0 TO sSymbols.Count - 1
    sSymbol = sSymbols[n]
    iType = iTypes[n]
    iPositions = iPositionss[n]
      
    iNoOfSpaces = iPositions - iLength - 1
    IF iNoOfSpaces > 0 THEN
      Prnt(Space(iNoOfSpaces), -1, Fnt)
    ENDIF
    iLength = iPositions + Len(sSymbol) - 1

    IF OutofPage(sSymbol) THEN
      sSubText = Split(sSymbol, " ")
      FOR EACH sWord IN sSubText
        IF Len(sWord) <= iMaxString THEN
          Prnt(sWord, iType, Fnt)
        ELSE
          FOR m = 1 TO Len(sWord)
            prnt(Mid(sWord, m, 1), iType, Fnt)
          NEXT                 
        ENDIF
        Prnt(" ", iType, Fnt)
      NEXT
    ELSE          
      Prnt(sSymbol, iType, Fnt)
    ENDIF
  NEXT

  IF EndOfPage() THEN
    PrntFooter(Fnt)
    NewPage()
    PrntHeader(Fnt)
  ELSE
    NewLine("")
'     IF PrintLineNo THEN
'       Prnt(Space(6), -1, Fnt)
'     ENDIF
  ENDIF
        
END

PRIVATE SUB Prnt(Text AS String,  Type AS Integer, Fnt AS font)
  Draw.Font = Fnt

  IF Type >= 0 AND bPrintColor THEN
    Draw.ForeColor = iColors[Type]   'SetColor(Type)
  ELSE
    Draw.ForeColor = color.Black
  ENDIF
  Draw.Font.Bold = SetBold(Type)

  IF iPosY = iTopMargin THEN
    iPosY = iTopMargin + Draw.TextHeight(Text)
  ENDIF

  IF OutOfPage(Text) THEN
    NewLine(Text)
  ENDIF
  
  Draw.Text(Text, iPosX, iPosY)
  iPosX = iPosX + Draw.TextWidth(Text)
END

PRIVATE SUB PrntAtX(X AS Integer, Text AS String, Place AS String, Fnt AS font)
  DIM iX AS Integer

  Draw.Font = Fnt
  Draw.ForeColor = color.Black
  SELECT Place
    CASE "C"
      iX = X - (Draw.TextWidth(Text) / 2)
    CASE "R"
      iX = X - Draw.TextWidth(Text)
    CASE ELSE
      iX = X 
  END SELECT    
  
  IF iPosY = 0 THEN
    iPosY = Draw.TextHeight(Text)
  ENDIF

  Draw.Text(Text, iX, iPosY)
END

PRIVATE SUB PrntHeader(Fnt AS Font)
  INC iPageNo
  
  Rect(iLeftMargin, iTopMargin, Printer.Width - iLeftMargin - iRightMargin, Draw.TextHeight(" "))  
  Fnt.Bold = TRUE
  Draw.ForeColor = color.Black
  PrntAtX(iLeftMargin, sTimestamp, PlaceLeft, Fnt)
  PrntAtX(Printer.Width / 2, sName, PlaceCenter, Fnt)
  PrntAtX(Printer.Width - iRightMargin, "Page: " & iPageNo, PlaceRight, Fnt)
  NewLine(" ")
  NewLine(" ")
  Fnt.Bold = FALSE
END

PRIVATE SUB PrntFooter(Fnt AS Font)
  
  
  iPosY = Printer.Height - iBottomMargin '+ Draw.TextHeight(" ")
  Rect(iLeftMargin, iPosY, Printer.Width - iLeftMargin - iRightMargin, Draw.TextHeight(" "))  
  Fnt.Bold = TRUE
  PrntAtX(Printer.Width - iRightMargin, "file:" & sPath, PlaceRight, Fnt)
  PrntAtX(iLeftMargin, "Gambas", PlaceLeft, Fnt)
  Fnt.Bold = FALSE  
  
END


PRIVATE FUNCTION EndOfPage(OPTIONAL printHeight AS Integer) AS Boolean
  IF printHeight <= 0 THEN
    printHeight = Printer.Height
  ENDIF
  
  IF iPosY > (printHeight - iBottomMargin - (Draw.TextHeight(" ") * 3)) THEN
    RETURN TRUE
  ELSE
    RETURN FALSE
  ENDIF
END

PRIVATE FUNCTION OutOfPage(Text AS String) AS Boolean
  IF (iPosX > Printer.Width - iRightMargin OR (iPosX + Draw.TextWidth(Text)) > Printer.Width - iRightMargin) THEN
    RETURN TRUE
  ELSE
    RETURN FALSE
  ENDIF
END

PRIVATE SUB NewPage()
  iPosX = iLeftMargin
  iPosY = iTopMargin
  Printer.NewPage()
END

PRIVATE SUB NewLine(Text AS String)
  iPosX = iLeftMargin
  iPosY = iPosY + Draw.TextHeight(Text)
END

PRIVATE SUB Line(X1 AS Integer, Y1 AS Integer, X2 AS Integer, Y2 AS Integer) 
  Draw.Line(X1, Y1, X2, Y2) 
END

PRIVATE SUB Rect(X1 AS Integer, Y1 AS Integer, X2 AS Integer, Y2 AS Integer) 
  Draw.Rect(X1, Y1, X2, Y2) 
END

PRIVATE FUNCTION SetBold(Type AS Integer) AS Boolean
  DIM bReturn AS Boolean

  IF bPrintUseRelief THEN  
    SELECT Type
      CASE 2
        bReturn = TRUE
      CASE ELSE
        bReturn = FALSE
    END SELECT
  ELSE
    bReturn = FALSE
  ENDIF
  RETURN bReturn
END