ich habe eine LinePrinter Funktion geschrieben, die die Umsetzung solcher Listen vereinfachen soll, gedruckt wird ausschließlich (wenn auch intern) über XbpPrinter() und GraStringAt().
set printer to wird nicht benötigt und muss entfernt werden.
Somit müssten alle Probleme von set printer to ... erledigt sein. 
Wichtig, da sowohl die Erstellung der Objekte (oPRN, oPS) als auch Start und Ende des Druckjobs außerhalb gesteuert werden, kann man mehrere Ausgaben mischen.
Und im eigenen Quellcode muss man nur VOR und NACH dem alten Quellcode wenige Zeilen einfügen / löschen.
Natürlich funktioniert der Ausdruck auch auf PDF oder andere Datei-Druckertreiber, sowie auf allen Druckern, die Windows selbst verwenden kann.
Für Verbesserungen bin ich offen und wenn es stabil ist (aktuell unterscheide ich noch nicht die Einstellung Top Left / Bottom Left) stelle ich es in die Wissensdatenbank.
Gleiches habe ich mit PDF (HBPrintPDF, etc.) vor...
Code: Alles auswählen
// Schriftart etc. wird vorher festgelegt
oPrn:startDoc("Test von LinePrinter") // bestimmt Dateinamen bei PDF Druckertreibern.
// init the LinePrinter function
QPRN( { oPS, nLineFeed, nFirstLine, nLinesPerPage, nLeftMargin } )
// the old Report stye ...
.... ? ...
// End of Printing
QPRN()
oPrn:endDoc()
Meine Funktion, kann auch über #translate auf ? umgeleitet werden, allerdings sollten man dann die Warnung ignorieren, dass evt. ein NIL zuviel übergeben wird, das habe ich nicht weg bekommen.
* Syntax der Funktion:
Erster Aufruf:
QPRN( { oPS, nLineFeed, nFirstLine, nLinesPerPage, nLeftMargin } ) // nLeftMargin = Blanks left of text
hierbei werden die nötigen Infos als Array übergeben:
- oPS (XbpPresentationSpace des XbpPrinters)
- Zeilenvorschub (Zeilenhöhe)
- Position der ersten Zeile (0,0 ist ja links unten, also etwa 2900)
- Zeilen pro Seite
- Blanks für linken Rand
Aufrufe für die Druckzeilen:
QPRN( "LF", .... ) => entspricht qout(...) oder ? ...
QPRN( "NO", .... ) => entspricht qout(...) oder ? ... "NO" kann auch NIL sein.
QPRN( "FF" ) => entspricht EJECT
QPRN( ) => setzt die Funktion zurück, wobei der Druckjob noch nicht geschlossen ist.
Das kann man mit #translate auch so umsetzen, dass die eigentlichen
alten Reportzeilen nicht geändert werden müssen:
#command ? [<list,...>] => QPRN( "LF", <list> )
#command ?? [<list,...>] => QPRN( "NO", <list> )
#command EJECT => QPRN( "FF" )
Mein Testprogramm sieht so aus:
Code: Alles auswählen
#include "Gra.ch"
#include "Xbp.ch"
#include "Common.ch"
#pragma Library( "XppUI2.lib" )
// TO DO --- Vorschub automatisch bestimmen und Top Left berücksichtigen.
/*
#command ? [<list,...>] => oSheet:Q( <list> )
#command ?? [<list,...>] => oSheet:QQ( <list> )
*/
#define PRINTERAUSWAHL .t.
// LinePrinter mit XbpPrinter() Objekt
// einfacher und zuverlässiger als SET PRINTER TO OBJECT ...
/* Syntax:
INIT: QPRN( { oPS, nLineFeed, nFirstLine, nLinesPerPage, nLeftMargin } ) // nLeftMargin = Blanks left of text
QOUT(): QPRN( "LF", .... )
QQOUT(): QPRN( "NO", .... )
EJECT: QPRN( "FF" )
? QPRN( "LF" )
END QPRN( )
#command ? [<list,...>] => QPRN( "LF", <list> )
#command ?? [<list,...>] => QPRN( "NO", <list> )
#command EJECT => QPRN( "FF" )
* Standard ist in Xbp.CH !
#ifndef __XWB__
#command ? [<list,...>] => QOUT( <list> )
#command ?? [<list,...>] => QQOUT( <list> )
#else
#command ? [[<foo1> [,<fooN>]] => Var2LChar(<foo1>)[+" "+Var2LChar(<fooN>)]
#command ?? [[<foo1> [,<fooN>]] => Var2LChar(<foo1>)[+" "+Var2LChar(<fooN>)]
#endif
#command EJECT => _Eject()
*/
PROCEDURE Main
LOCAL oPrn, oPS, oDlg, oFont, aSize
LOCAL nFirstLine, nLinesPerPage, nLineFeed, nLeftMargin
set charset to ansi
if PRINTERAUSWAHL
oDlg := XbpPrintDialog():new()
oDlg:create()
// Obtain configured printer object
oPrn := oDlg:display()
oDlg:destroy()
else
oPrn := XbpPrinter():new():create()
endif
IF oPrn <> NIL
// Create a new presentation space
oPS := XbpPresSpace():new()
// Size of printable region on paper
aSize := oPrn:paperSize()
aSize := { aSize[5] - aSize[3], aSize[6] - aSize[4] }
oPS:create( oPrn, aSize, GRA_PU_LOMETRIC )
// Font setzen ...
oFont := XbpFont():new(oPS) // Font for printer
if .t.
oFont:familyName := "Arial"
oFont:height := 0 // use nominalPointSize
oFont:width := 0 // use nominalPointSize
oFont:nominalPointSize := 10 // for Arial etc.
else
oFont:familyName := "Courier"
oFont:height := 16
oFont:width := 8
endif
oFont:create() // Create font
oPS:setFont(oFont)
// Zeilenanzahl berechnen oder festlegen !
// you can calculate the line parameter or just define what you want.
nLineFeed := -40
nFirstLine := aSize[2] + (nLineFeed * 1)
nLinesPerPage := 60
nLeftMargin := 5
oPrn:startDoc("Test von LinePrinter")
// init the LinePrinter function
QPRN( { oPS, nLineFeed, nFirstLine, nLinesPerPage, nLeftMargin } )
// the old Report stye ...
#command ? [<list,...>] => QPRN( "LF", <list> )
#command ?? [<list,...>] => QPRN( "NO", <list> )
#command EJECT => QPRN( "FF" )
? "Test 1",34,date(),time(),111.22
? "Test 2",35,date(),time(),112.22
? "Test 3",36,date(),time(),113.22
?
EJECT
? "New Page"
? ""
? "Text-"
?? "Ende"
#ifndef __XWB__
#command ? [<list,...>] => QOUT( <list> )
#command ?? [<list,...>] => QQOUT( <list> )
#else
#command ? [[<foo1> [,<fooN>]] => Var2LChar(<foo1>)[+" "+Var2LChar(<fooN>)]
#command ?? [[<foo1> [,<fooN>]] => Var2LChar(<foo1>)[+" "+Var2LChar(<fooN>)]
#endif
#command EJECT => _Eject()
// End of Printing
QPRN()
oPrn:endDoc()
oFont:destroy()
oPrn:destroy()
oPS:destroy()
ENDIF
return
procedure QPRN( xCommand )
STATIC oPrn, oPS, nLineFeed, nFirstLine, nLinesPerPage, nPosX, nPosY, nLine, cLM
LOCAL i, nParams, cTxt, uValue, aInfo, nTxtLen
nParams := PCount()
IF nParams = 0
// end of Printing
oPrn := NIL
oPS := NIL
nLine := 0
nLineFeed := 0
nFirstLine := 0
nLinesPerPage := 0
nPosX := 0
nPosY := 0
cLM := ""
else
// xCommand ...
DEFAULT xCommand TO "NO"
do case
case oPrn = NIL .and. valtype( xCommand ) # "A"
alert("QPRN wurde nicht initialisiert")
quit
case valtype( xCommand ) == "A"
// INIT: QPRN( { oPS, nLineFeed, nFirstLine, nLinesPerPagen, LeftMargin } )
oPS := xCommand[1] // XbpPresentationSpace
oPRN := oPS:device() // XbpPrinter
nLineFeed := xCommand[2]
nFirstLine := xCommand[3]
nLinesPerPage := xCommand[4]
if ! empty(xCommand[5])
cLM := space(xCommand[5])
endif
nLine := 1
nPosX := 0
nPosY := nFirstLine + nLineFeed
case valtype( xCommand ) == "C"
do case
case xCommand == "LF"
nPosX := 0
if nLine > 0
nPosY += nLineFeed
endif
nLine++
if nLine > nLinesPerPage
oPrn:newPage()
nPosX := 0
nPosY := nFirstLine + nLineFeed
endif
case xCommand == "FF"
oPrn:newPage()
nLine := 1
nPosX := 0
nPosY := nFirstLine + nLineFeed
case xCommand == "NO"
// OK
otherwise
alert("QPRN unbekanntes Kommando: '"+xCommand+"'")
quit
end
cTxt := cLM
for i := 2 to PCount()
uValue := PValue(i)
if i>2
cTxt += " "
endif
do case
case uValue = NIL
// nothing
case valtype(uValue) = "C"
cTxt += uValue
case valtype(uValue) = "N"
cTxt += alltrim(str(uValue))
case valtype(uValue) = "D"
cTxt += dtoc(uValue)
case valtype(uValue) = "L"
cTxt += iif(uValue,"J","N")
otherwise
cTxt += var2char(uValue)
end
next
aInfo := GraQueryTextBox(oPS, cTxt)
nTxtLen := aInfo[3,1] - aInfo[2,1]
GraStringAt( oPS, {nPosX,nPosY}, cTxt )
nPosX += nTxtLen
cTxt := ""
otherwise
alert("QPRN unbekanntes Kommando: '"+var2char(xCommand)+"'")
quit
end
endif
return
- dabei will ich nur ein paar Zeilen drucken 
