hier noch der Code von der Migrate.ch
Code: Alles auswählen
//////////////////////////////////////////////////////////////////////////
//
// Defines for the graphic mode report migrator.
//
// Copyright (c) 2014, Alaska Software. All rights reserved.
//
//////////////////////////////////////////////////////////////////////////
#ifndef __MIGRATE_CH__
#define __MIGRATE_CH__
// PreProcessor directives used to hook into
// EJECT @ , SAY commands
//
#ifdef GRAPHICS_PRINTER
#command SET DEVICE TO SCREEN => Set( _SET_DEVICE, "SCREEN" );;
ResetGraphicsPrinter()
#command SET DEVICE TO PRINTER => Set( _SET_DEVICE, "PRINTER" );;
SetGraphicsPrinter()
#command SET PRINTER TO OBJECT <o> ;
=> IF IsPrinter();;
GetPrinter():SetPrinter(<o>);;
ELSE ;;
Set( _SET_PRINTFILE, <o> );;
ENDIF
#command SET PRINTER TO PRESSPACE <o> ;
=> IF IsPrinter();;
GetPrinter():SetPresSpace(<o>);;
ENDIF
#command RESET PRINTER <o> ;
=> IF IsPrinter();;
GetPrinter():Reset(<o>);;
ENDIF
#command EJECT ;
=> IIF(IsPrinter(),GetPrinter():Eject(),_Eject())
#command @ <nRow>, <nCol> SAY <say> [PICTURE <pic>] [COLOR <Color>] ;
=> IF IsPrinter();;
GetPrinter():AtSayPict(<nRow>, <nCol>,<say>,<pic>);;
ELSE ;;
DevPos(<nRow>, <nCol>) ;;
DevOutPict(<say>, <pic> [,<Color>]);;
ENDIF
#command @ <nRow>, <nCol> SAY <say> [COLOR <Color>] ;
=> IF IsPrinter();;
GetPrinter():AtSay(<nRow>, <nCol>,<say>);;
ELSE ;;
DevPos(<nRow>, <nCol>) ;;
DevOut(<say> [,<Color>]);;
ENDIF
#command ? [<list,...>] ;
=> IIF(IsPrinter(),GetPrinter():Qout( <list> ),QOUT( <list> ))
#command ?? [<list,...>] ;
=> IIF(IsPrinter(),GetPrinter():QQout( <list> ),QQOUT( <list> ))
#command @ <nT>, <nL> IMAGE <cFile> ;
=> GetPrinter():DrawImage( <cFile>, <nT>, <nL> )
#command @ <nT>, <nL>, <nB>, <nR> IMAGE <cFile> ;
=> GetPrinter():DrawImage( <cFile>, <nT>, <nL>, <nB>, <nR> )
#xtrans MaxRow() => IIF(IsPrinter(),GetPrinter():MaxRow,&("MaxRow()"))
#xtrans MaxCol() => IIF(IsPrinter(),GetPrinter():MaxRow,&("MaxCol()"))
#endif
#endif
und der Teil-code von der Migrate.prg
Code: Alles auswählen
//////////////////////////////////////////////////////////////////////////
//
// Classes and functions used to implement the graphic mode report
// migrator.
//
// Copyright (c) 2014, Alaska Software. All rights reserved.
//
//////////////////////////////////////////////////////////////////////////
#include "gra.ch"
#include "set.ch"
#include "xbp.ch"
//*#### ANSI .t. äöü ÄÖÜ ß !!!!
#include "Common.ch"
#include "Appevent.ch"
#include "Font.ch"
#include "XBPDEV.ch"
#define TEXT_DATA 1
#define IMAGE_DATA 2
#define DRIVE_NOT_READY 21 // Fehlercode
STATIC GraphicPrinterObj := NIL
PROCEDURE MIGRATE
// Fehlende Prozeduren und Funktionen
// fehlende Prozeduren oder Funktionen werden als selbst. Prozeduren (*.prg) nachdem return eingefgt und mssen somit nicht extra compiliert werden
// alle Functionen oder Prozeduren enden mit Return
RETURN
FUNCTION IsPrinter()
IF GraphicPrinterObj == NIL
IF "LPT" $ Set(_SET_PRINTFILE) .AND.;
Set(_SET_DEVICE) == "PRINTER" .AND.;
GraphicPrinterObj== NIL
MyPrinter2():RunReport()
ENDIF
ENDIF
RETURN (GraphicPrinterObj != NIL)
FUNCTION GetPrinter()
RETURN GraphicPrinterObj
FUNCTION SetGraphicsPrinter()
IF(ValType(GraphicPrinterObj)=="O")
RETURN(NIL)
ENDIF
MyPrinter2():RunReport()
RETURN(NIL)
FUNCTION ResetGraphicsPrinter()
IF(ValType(GraphicPrinterObj)=="O")
GraphicPrinterObj:Eject()
GraphicPrinterObj:Destroy()
GraphicPrinterObj := NIL
ENDIF
RETURN(NIL)
#define PAGE_WIDTH 78
#define LINES_PER_PAGE ZEILENDE // ist Public-Variable "Zeilende" aus Programm Main Global
// wird im Druckmenue aus Datenbank eingestellt
// This class is used to render our report for
// the graphic printer.
//
CLASS MyPrinter2
CLASS VAR oPS
CLASS VAR aData
CLASS VAR oPrinter
CLASS VAR aSize
CLASS VAR nDX
CLASS VAR nDY
CLASS VAR lInternalPS
CLASS VAR lInternalPrinter
CLASS VAR IsOpenStartDoc // .t. after Startdoc(), .f. after Enddoc()
CLASS VAR cPrinterShowText // Parameter merken von ::StartDoc(cText) - store cText parameter
PROTECTED:
CLASS METHOD PrintEsc()
EXPORTED:
CLASS VAR Header
CLASS ACCESS METHOD GetMaxRow() VAR MaxRow
CLASS ACCESS METHOD GetMaxCol() VAR MaxCol
CLASS ACCESS METHOD GetFont() VAR Font
CLASS METHOD Init()
CLASS METHOD AtSay()
CLASS METHOD AtSayPict()
CLASS METHOD Eject()
CLASS METHOD SetFont()
CLASS METHOD QOut()
CLASS METHOD QQOut()
CLASS METHOD startDoc()
CLASS METHOD endDoc()
CLASS METHOD newPage()
CLASS METHOD DrawImage()
CLASS METHOD RunReport()
CLASS METHOD Destroy()
CLASS METHOD SetPrinter()
CLASS METHOD SetPrintFile()
CLASS METHOD SetPresSpace()
CLASS METHOD Reset()
ENDCLASS
CLASS METHOD MyPrinter2:Destroy()
IF ::lInternalPrinter == .T. .AND. ValType(::oPrinter)=="O"
::oPrinter:Destroy()
::oPrinter := NIL
ENDIF
IF ::lInternalPS == .T. .AND. ValType(::oPS)=="O"
::oPS:Destroy()
::oPS := NIL
ENDIF
RETURN
// initialize printer if name or object given
// dedicated printer is selected. MaxRow and
// MaxCol are used to determined space between
// lines and to calculate the position if
// @ row,col SAYs
//
CLASS METHOD MyPrinter2:Init(xPrinter,nMaxRow,nMaxCol)
LOCAL aSize
LOCAL cType := ValType( xPrinter )
IF cType $ "CU"
::oPrinter := XbpPrinter():New()
::oPrinter:Create( xPrinter )
::lInternalPrinter := .T.
ELSEIF cType == "O"
::oPrinter := xPrinter
::lInternalPrinter := .F.
ENDIF
IF ::oPS == NIL
::oPS := XbpPresSpace():New()
::lInternalPS := .T.
ENDIF
::Reset()
IF ::lInternalPS == .T.
::oPS:Create( ::oPrinter , ::aSize, GRA_PU_LOMETRIC )
ENDIF
::aData := {}
RETURN(SELF)
// Change the associated printer to a
// printer selected by the application.
// All output using @..SAY directly goes
// to this printer from now on
CLASS METHOD MyPrinter2:SetPrinter( oPrt )
LOCAL oFnt := ::oPS:SetFont()
::Destroy()
::Init( oPrt )
IF ValType(oFnt) == "O"
::SetFont( LTrim(Str(oFnt:NominalPointSize)) + "." + oFnt:FamilyName )
ENDIF
RETURN
//------------------------------------------------------------ // neu hinzugefügt, war nicht vorhanden
CLASS METHOD MyPrinter2:setPrintFile( cFileName )
local uReturn := NIL, oDC, nBreite,nHoehe,aPaperSize
if ::oPS:device():isDerivedFrom( "XbpPrinter" )
oDC := ::oPS:device() // xbpPrinter object
elseif ::oPrinter:device():isDerivedFrom( "XbpPrinter" )
oDC := ::oPrinter:device()
endif
if ! IsNil(oDC) .and. oDC:isDerivedFrom( "XbpPrinter" )
if ::IsOpenStartDoc // ::StartDoc() ist aktiv / is active
oDC:enddoc() // print
endif
uReturn := oDC:setPrintFile( cFileName )
aPaperSize := oDC:PaperSize() // hier kommen nur 6 Elemente
nBreite := aPaperSize[5] - aPaperSize[3] // laut DOKU sollten es 8 sein.
nHoehe := aPaperSize[6] - aPaperSize[4]
::oPS:Configure( oDC, {nBreite,nHoehe} , GRA_PU_LOMETRIC )
::SetInternalPageVars()
if ::IsOpenStartDoc // neu öffnen - open again
oDC:startdoc(::cPrinterShowText)
endif
endif
return uReturn
//-------------------------------------------------------------
// Associate an application-supplied
// Presentation Space with the line
// printer. All output using @..SAY
// goes to this PS now on
CLASS METHOD MyPrinter2:SetPresSpace( oPS )
LOCAL oFnt := ::oPS:SetFont()
IF oPS == ::oPS
RETURN
ENDIF
::Destroy()
::oPS := oPS
::lInternalPS := .F.
IF ValType(oFnt) == "O"
::SetFont( LTrim(Str(oFnt:NominalPointSize)) + "." + oFnt:FamilyName )
ENDIF
RETURN
// Reset the logicalcal page to cover
// the whole (possibly changed) print
// area. If <oPrt> is passed, this
// printer is set as the new output
// device.
CLASS METHOD MyPrinter2:Reset( oPrt )
LOCAL aSize
LOCAL nMaxRow
LOCAL nMaxCol
// Size of printable region on paper
IF ValType(oPrt) == "O"
::SetPrinter( oPrt )
ENDIF
// aSize := ::oPrinter:paperSize()
aSize := ::oPrinter:XbpPrinter:paperSize()
::aSize := { aSize[5] - aSize[3], ;
aSize[6] - aSize[4] }
IF(nMaxRow==NIL)
nMaxRow := LINES_PER_PAGE
ENDIF
IF(nMaxCol==NIL)
nMaxcol := PAGE_WIDTH
ENDIF
::nDX := Int( ::aSize[1] / nMaxCol )
::nDY := Int( ::aSize[2] / nMaxRow )
RETURN
// Simple Helper method used to specify Font
// for report
CLASS METHOD MyPrinter2:SetFont(cName)
LOCAL oFont := XbpFont():new(::oPS)
oFont:Generic := .T.
oFont:Vector := .T.
oFont:Fixed := .T.
oFont:FamilyName := SubStr( cName, At(".",cName) +1 )
oFont:nominalPointSize := Val( SubStr( cName,1, At(".",cName) -1 ) )
oFont:Create()
::oPS:setFont(oFont)
::nDX := oFont:Width
::nDY := oFont:Height
RETURN
// Simply collect all output strings
CLASS METHOD MyPrinter2:AtSay(nR,nC,cText)
// Numeric: also mit Str konvertieren damit tabellen decimals und length
// benutzt werden
IF(ValType(cText)=="N")
cText := Str( cText )
// Alle anderen nicht char typen mit Var2Char konvertieren
// eventuell Var2LChar() dann wäre der text locale spezifisch.
ELSEIF ValType(cText) != "C"
cText := Var2Char( cText )
ENDIF
AAdd( ::aData , {TEXT_DATA, nR,nC, cText,NIL} )
RETURN
// Simply collect all output strings, include picture mask
CLASS METHOD MyPrinter2:AtSayPict(nR,nC,xExpr,cPict)
AAdd( ::aData , {TEXT_DATA, nR,nC, Transform(xExpr,cPict)} )
RETURN
// now render the page and send it to the printer
CLASS METHOD MyPrinter2:Eject()
LOCAL n,nMaxY, cTmp, nX, nY, nIndex
IF(Len(::aData)==0)
RETURN
ENDIF
nMaxY := ::aSize[2] - ::nDY
// create new printer page
IF ::lInternalPS == .T.
::oPS:device():startDoc()
ENDIF
IF(ValType(::Header)=="C")
&(::Header)(::oPS)
ENDIF
FOR n:=1 TO Len(::aData)
DO CASE
CASE ::aData[n][1] == TEXT_DATA
nX := ::aData[n][3]*::nDX
nY := nMaxY - (::aData[n][2]*::nDY)
DO WHILE .T.
nIndex = At( Chr(27), ::aData[n][4] )
IF nIndex > 0
cTmp = SubStr( ::aData[n][4],1, nIndex -1 )
::PrintEsc( ::aData[n][4][nIndex+1] )
// NOTE: We throw away anything right of the Escape code
// so basically this only works if escape codes are send
// seperately.
// Original code was: ::aData[n][4] = SubStr( ::aData[n][4], nIndex +2 )
::aData[n][4] = ""
ELSE
cTmp := ::aData[n][4]
::aData[n][4] = ""
ENDIF
GraStringAt( ::oPS, {nX,nY}, cTmp )
IF Len(::aData[n][4]) == 0
EXIT
ENDIF
nX += Len(cTmp) * ::nDY
ENDDO
CASE ::aData[n][1] == IMAGE_DATA
::aData[n][3]:Draw( ::oPS, ::aData[n][2],,, GRA_BLT_BBO_IGNORE )
ENDCASE
NEXT n
// close page and sent it to printer
IF ::lInternalPS == .T.
::oPS:device():endDoc()
ENDIF
::aData := {}
RETURN
//------------------------------------------------------------ // neu hinzugefügt, war nicht vorhanden
CLASS METHOD MYPrinter2:StartDoc(cText,nSetPageNo)
local cAltDrive, cAltDir, cResetDir
local uReturn := SELF
aDATA := CText
DEFAULT cText TO ::SpoolJobName
DEFAULT nSetPageNo TO 1
cAltDrive := curdrive()
cAltDir := curdir()
::nPageNo := nSetPageNo
::IsOpenStartDoc := .t.
::cPrinterShowText := cText
if cAltDrive # curdrive() .or. cAltDir # curdir()
cResetDir := cAltDrive +":\"+ cAltDir
curdrive(cAltDrive)
curdir(cResetDir)
endif
return uReturn
//------------------------------------------------------------ // neu hinzugefügt, war nicht vorhanden
CLASS METHOD MyPrinter2:EndDoc()
local uReturn := SELF
::IsOpenStartDoc := .f.
if IsMethod(::oPS:device(),"EndDoc")
uReturn := ::oPS:device():EndDoc()
endif
return uReturn
//-------------------------------------------------------------
// now render the page and send it to the printer
CLASS METHOD MyPrinter2:newPage()
LOCAL n,nMaxY, cTmp, nX, nY, nIndex
IF(Len(::aData)==0)
RETURN
ENDIF
nMaxY := ::aSize[2] - ::nDY
// create new printer page
IF ::lInternalPS == .T.
::oPS:device():startDoc()
ENDIF
IF(ValType(::Header)=="C")
&(::Header)(::oPS)
ENDIF
FOR n:=1 TO Len(::aData)
DO CASE
CASE ::aData[n][1] == TEXT_DATA
nX := ::aData[n][3]*::nDX
nY := nMaxY - (::aData[n][2]*::nDY)
DO WHILE .T.
nIndex = At( Chr(27), ::aData[n][4] )
IF nIndex > 0
cTmp = SubStr( ::aData[n][4],1, nIndex -1 )
::PrintEsc( ::aData[n][4][nIndex+1] )
// NOTE: We throw away anything right of the Escape code
// so basically this only works if escape codes are send
// seperately.
// Original code was: ::aData[n][4] = SubStr( ::aData[n][4], nIndex +2 )
::aData[n][4] = ""
ELSE
cTmp := ::aData[n][4]
::aData[n][4] = ""
ENDIF
GraStringAt( ::oPS, {nX,nY}, cTmp )
IF Len(::aData[n][4]) == 0
EXIT
ENDIF
nX += Len(cTmp) * ::nDY
ENDDO
CASE ::aData[n][1] == IMAGE_DATA
::aData[n][3]:Draw( ::oPS, ::aData[n][2],,, GRA_BLT_BBO_IGNORE )
ENDCASE
NEXT n
// close page and sent it to printer
IF ::lInternalPS == .T.
::oPS:device():endDoc()
ENDIF
::aData := {}
RETURN
usw...
//