ich habe eine Druckerauswahl in meine Xbase++ Programm eingebunden
Das Programm funktionierte bisher ohne Druckerauswahl auf dem jeweils angeschlossenen Standard-Drucker, jetzt kann ich sogar vor dem Druck noch den Drucker auswählen
läuft alles prima, nur...
wenn ich keinen Drucker auswähle und auf "Abbruch" oder Drucker-Auswahl-Fenster schließen gehe, beendet sich das Programm komplett,
das fenster heißt "no Printer selected !"
das ist natürlich nicht gewünscht, es soll ja nur das Fenster wieder geschlossen werden und im Programm weiter gearbeitet werden können.
wo muss ich den Quellcode ändern?
das Programm Main ruft als erstes das Prg Migrate auf, in diesem wird Druck und Schriften belegt, anbei das komplette PRG "Migrate"
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"
#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 eingefügt und müssen 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)
RETURN(MAIN)
ENDIF
MyPrinter2():RunReport()
*RETURN(NIL)
RETURN(MAIN)
FUNCTION ResetGraphicsPrinter()
IF(ValType(GraphicPrinterObj)=="O")
GraphicPrinterObj:Eject()
GraphicPrinterObj:Destroy()
GraphicPrinterObj := NIL
ENDIF
*RETURN(NIL)
RETURN(MAIN)
// $ALASKA
// Der nachfolgende Code geht so nicht,
// fuer eine L”sung siehe Methode RunReport
//
// Hinweis:
// Statt Code auszukommentieren wird Code
// durch einen #if 0 bis #endif einfach
// fuer den compiler unsichtbar. Mit #if 1
// wird der code fuer den compiler wieder sichtbar.
//
#if 0
IF ENGJA := .T.
#define PAGE_WIDTH 94
* #define PAGE_WIDTH 115
else
#define PAGE_WIDTH 78
endif
#endif
#define PAGE_WIDTH 78
#define LINES_PER_PAGE ZEILENDE // ist Public-Variable "Zeilende" aus Programm Main Global oder SKATPRog.PRG
// 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
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 DrawImage()
CLASS METHOD RunReport()
CLASS METHOD Destroy()
CLASS METHOD SetPrinter()
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(Main)
// 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
// 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(MAIN)
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 := { 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(MAIN)
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
RETURN(Main)
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(Main)
CLASS METHOD MyPrinter2:QOut( x )
LOCAL nX := 0
LOCAL nY := 0
LOCAL nLen
nLen := Len( ::aData )
DO WHILE nLen > 0
IF ::aData[nLen][1] == TEXT_DATA
nY := ::aData[nLen][2] +1
// EXIT
RETURN(Main)
ENDIF
nLen--
ENDDO
AAdd( ::aData , {TEXT_DATA, nY,nX, Var2Char(x)} )
*RETURN
RETURN(MAIN)
CLASS METHOD MyPrinter2:QQOut( x )
LOCAL nX := 0
LOCAL nY := 0
LOCAL nLen
IF x == Chr(12)
RETURN ::Eject()
ENDIF
nLen := Len( ::aData )
DO WHILE nLen > 0
IF ::aData[nLen][1] == TEXT_DATA
nX := ::aData[nLen][3]
nY := ::aData[nLen][2]
ENDIF
nLen--
ENDDO
AAdd( ::aData , {TEXT_DATA,nY,nX, Var2Char(x)} )
RETURN
CLASS METHOD MyPrinter2:PrintEsc( c )
LOCAL oFont := GraSetFont( ::oPS )
// reset font
oFont:Width := 0
oFont:Height := 0
oFont:weightClass := XBPFONT_WEIGHT_DONT_CARE
// reset attributes set by previous esc sequence
oFont:bold := .F.
oFont:italic := .F.
oFont:nominalpointSize :=12
// process escaped character and select appropriate
// font attributes
//
// new escape sequences could be added here by
// expanding the following case structure
DO CASE
CASE c == Chr(70)
// Reset attributes
CASE c == Chr(52)
// italic Kursiv
oFont:italic := .T.
CASE c == Chr(53)
// italic kursiv
oFont:italic := .T.
// bold = Fett
oFont:bold := .T.
CASE c == Chr(69)
// bold = Fett
oFont:bold := .T.
CASE c == Chr(91)
// condensed, 10 pt, bold Engschrift 94 Punkte 10 und Fettschrift
oFont:nominalpointSize := 10
// Bold = Fett
oFont:bold := .T.
CASE c == Chr(110)
// condensed, 10 pt Engschrift 94 Punkte 10
oFont:nominalpointSize := 10
CASE c == Chr(109)
// condensed, 9 pt Engschrift 109 Punkte 9
oFont:nominalpointSize := 9
CASE c == Chr(108)
// condensed, 8 pt Engschrift 108 Punkte 8
oFont:nominalpointSize := 8
CASE c == Chr(114)
// enlarged, 14 pt Groáschrift Ueberschrift Punkte 14
oFont:nominalpointSize := 14
CASE c == Chr(115)
// enlarged, 14 pt, bold Groáschrift Ueberschrift Punkte 14 und Fettschrift
oFont:nominalpointSize := 14
// Bold = Fett
oFont:bold := .T.
CASE c == Chr(116)
// enlarged, 16 pt Groáschrift Ueberschrift Punkte 16
oFont:nominalpointSize := 16
CASE c == Chr(117)
// enlarged, 16 pt, bold Groáschrift Ueberschrift Punkte 16 und Fettschrift
oFont:nominalpointSize := 16
// Bold = Fett
oFont:bold := .T.
CASE c == Chr(120)
// enlarged, 20 pt Groáschrift Ueberschrift Punkte 20
oFont:nominalpointSize := 20
CASE c == Chr(121)
// enlarged, 20 pt, bold Groáschrift Ueberschrift Punkte 20 und Fettschrift
oFont:nominalpointSize := 20
// Bold = Fett
oFont:bold := .T.
CASE c == Chr(122)
// enlarged, 20 pt, italic Groáschrift Ueberschrift Punkte 20 Kursiv
oFont:nominalpointSize := 20
// Kursiv
oFont:italic := .T.
CASE c == Chr(123)
// enlarged, 20 pt, italic, bold Groáschrift Ueberschrift Punkte 20 Kursiv und Fettschrift
oFont:nominalpointSize := 20
// Bold = Fett
oFont:bold := .T.
// Kursiv
oFont:italic := .T.
END CASE
oFont:configure()
GraSetFont( ::oPs, oFont )
RETURN self
CLASS METHOD MyPrinter2:DrawImage( cFile, nTop, nLeft, nBottom, nRight )
LOCAL oBmp
IF ValType(cFile) != "C" .OR. ValType(nTop) != "N" .OR.;
ValType(nLeft) != "N"
XbpException():RaiseParameterType( {cFile,nTop,nLeft,nBottom,nRight} )
ENDIF
oBmp := XbpBitmap():New():Create()
oBmp:LoadFile( cFile )
IF oBmp:XSize == 0
XbpException():RaiseParameterType( {cFile,nTop,nLeft,nBottom,nRight} )
ENDIF
nLeft := nLeft * ::nDX
nTop := ::aSize[2] - (nTop * ::nDY)
IF ValType(nRight) != "N"
nRight := oBmp:XSize + nLeft
ELSE
nRight *= ::nDX
ENDIF
IF ValType(nBottom) != "N"
nBottom := nTop - oBmp:YSize
ELSE
nBottom := ::aSize[2] - (nBottom * ::nDY)
ENDIF
AAdd( ::aData, {IMAGE_DATA, {nLeft,nBottom,nRight,nTop}, oBmp} )
RETURN
CLASS METHOD MyPrinter2:GetMaxCol()
RETURN (::aSize[1] / ::nDX)-2
CLASS METHOD MyPrinter2:GetMaxRow()
RETURN (::aSize[2] / ::nDY)-2
CLASS METHOD MyPrinter2:GetFont()
RETURN ::oPS:SetFont()
CLASS METHOD MyPrinter2:RunReport()
GraphicPrinterObj := MyPrinter2():New()
// $ALASKA
// Es wird hier das Graphics Printer Object
// mit einem Default Ausgabe Font versehen.
// Somit kann hier entsprechend der Variable
// der ENGJA der Font gew„hlt werden!
// Set default font, which can be controlled
// via a PUBLIC variable "PICAMODE" to select
// smaller type
do case
case ENG132 = .t.
GraphicPrinterObj:setFont("10.Times New Roman")
case ENGJA = .T.
GraphicPrinterObj:setFont("10.Courier")
case ENGJ11 = .T.
GraphicPrinterObj:setFont("11.Courier")
otherwise
IF( IsMemVar("PICAMODE") == .T. .AND. PICAMODE == .T.)
GraphicPrinterObj:setFont("10.Courier")
ELSE
GraphicPrinterObj:setFont("12.Courier")
ENDIF
ENDCASE
// oben bei otherwise eingebunden
// IF( IsMemVar("PICAMODE") == .T. .AND. PICAMODE == .T.)
// GraphicPrinterObj:setFont("10.Courier")
// ELSE
// GraphicPrinterObj:setFont("12.Courier")
// ENDIF
RETURN
// hinzugefgt aus bisherige Migrate *******************************
FUNCTION IsDriveReady( cDrive ) // Ist Laufwerk bereit ?
LOCAL nReturn := 0
LOCAL cOldDrive := CurDrive() // Aktuelles Laufwerk merken
LOCAL bError := ErrorBlock( {|e| Break(e) } )
LOCAL oError
BEGIN SEQUENCE
CurDrive( cDrive ) // Laufwerk „ndern
CurDir( cDrive ) // Verzeichnis abfragen
RECOVER USING oError // Fehler ist aufgetreten
IF oError:osCode == DRIVE_NOT_READY
nReturn := -1 // Laufwerk nicht bereit
ELSE
nReturn := -2 // Laufwerk nicht vorhanden
ENDIF
ENDSEQUENCE
ErrorBlock( bError ) // Fehler-Codeblock und
CurDrive( cOldDrive ) // Laufwerk zurcksetzen
RETURN nReturn
PROCEDURE BofTone()
Tone(800)
RETURN
PROCEDURE EofTone()
Tone(500)
RETURN
PROCEDURE ErrorTone()
Tone(1000,3)
RETURN
PROCEDURE DoneTone()
Tone(100,3)
Tone(200,3)
Tone(300,3)
Tone(500,6)
return
Vielen Dank für Eure Hilfe!
glg Micha