/*
* $Id: testprn.prg 13647 2010-01-19 22:19:54Z vszakats $
*/
#include "common.ch"
#include "hbwin.ch"
PROCEDURE Main( cPar1 )
LOCAL nPrn := 1
LOCAL cBMPFile := Space( 40 )
LOCAL aPrn := WIN_PRINTERLIST()
LOCAL GetList := {}
CLS
IF Empty( aPrn )
Alert("No printers installed - Cannot continue")
QUIT
ENDIF
DO WHILE nPrn != 0
CLS
@ 0, 0 SAY "Win_Prn() Class test program. Choose a printer to test"
@ 1, 0 SAY "Bitmap file name" GET cBMPFile PICT "@K"
READ
@ 2, 0 TO MaxRow(), MaxCol()
nPrn := AChoice( 3, 1, MaxRow() - 1, MaxCol() - 1, aPrn, .T.,, nPrn )
IF nPrn != 0
PrnTest( aPrn[ nPrn ], cBMPFile, iif( ISCHARACTER( cPar1 )
.AND. Lower( cPar1 ) == "ask", .T., NIL ) )
ENDIF
ENDDO
RETURN
STATIC PROCEDURE PrnTest( cPrinter, cBMPFile, lAsk )
LOCAL oPrinter := Win_Prn():New( cPrinter )
LOCAL aFonts
LOCAL x
LOCAL nColFixed
LOCAL nColTTF
LOCAL nColCharSet
oPrinter:Landscape := .F.
oPrinter:FormType := WIN_DMPAPER_A4
oPrinter:Copies := 1
IF ISLOGICAL( lAsk )
oPrinter:AskProperties := lAsk
ENDIF
IF ! oPrinter:Create()
Alert( "Cannot Create Printer" )
ELSE
IF ! oPrinter:startDoc( "Win_Prn(Doc name in Printer Properties)" )
Alert( "StartDoc() failed" )
ELSE
oPrinter:SetPen( WIN_PS_SOLID, 1, HB_WIN_RGB_RED )
oPrinter:Bold( WIN_FW_EXTRABOLD )
oPrinter:TextOut( oPrinter:PrinterName + ": MaxRow() = " +
Str( oPrinter:MaxRow(), 4 ) + " MaxCol() = " + Str(
oPrinter:MaxCol(), 4 ) )
oPrinter:Bold( WIN_FW_DONTCARE )
oPrinter:NewLine()
oPrinter:TextOut(" Partial list of available fonts that are
available for OEM_")
oPrinter:NewLine()
oPrinter:UnderLine( .T. )
oPrinter:Italic( .T. )
// oPrinter:SetFont( "Courier New", 7, { 3, -50 } ) // Compressed print
nColFixed := 40 * oPrinter:CharWidth
nColTTF := 48 * oPrinter:CharWidth
nColCharSet := 60 * oPrinter:CharWidth
oPrinter:TextOut( "FontName" )
oPrinter:SetPos( nColFixed )
oPrinter:TextOut( "Fixed?" )
oPrinter:SetPos( nColTTF )
oPrinter:TextOut( "TrueType?" )
oPrinter:SetPos( nColCharset )
oPrinter:TextOut( "CharSet#", .T. )
oPrinter:NewLine()
oPrinter:Italic( .F. )
oPrinter:UnderLine( .F. )
aFonts := oPrinter:GetFonts()
oPrinter:NewLine()
FOR x:= 1 TO Len( aFonts ) STEP 2
oPrinter:CharSet( aFonts[ x, 4 ] )
IF oPrinter:SetFont( aFonts[ x, 1 ] ) // Could use
"IF oPrinter:SetFontOk" after call to oPrinter:SetFont()
IF oPrinter:FontName == aFonts[ x, 1 ] // Make sure
Windows didn't pick a different font
oPrinter:TextOut( aFonts[ x, 1 ] )
oPrinter:SetPos( nColFixed )
oPrinter:TextOut( iif( aFonts[ x, 2 ], "Yes", "No" ) )
oPrinter:SetPos( nColTTF )
oPrinter:TextOut( iif( aFonts[ x, 3 ], "Yes", "No" ) )
oPrinter:SetPos( nColCharSet )
oPrinter:TextOut( Str( aFonts[ x, 4 ], 5 ) )
oPrinter:SetPos( oPrinter:LeftMargin, oPrinter:PosY
+ ( oPrinter:CharHeight * 2 ) )
IF oPrinter:PRow() > oPrinter:MaxRow() - 16 //
Could use "oPrinter:NewPage()" to start a new page
EXIT
ENDIF
ENDIF
ENDIF
oPrinter:Line( 0, oPrinter:PosY + 5, 2000, oPrinter:PosY + 5 )
NEXT
oPrinter:SetFont( "Lucida Console", 8, { 3, -50 } ) //
Alternative Compressed print
oPrinter:CharSet( 0 ) // Reset default charset
oPrinter:Bold( WIN_FW_EXTRABOLD )
oPrinter:NewLine()
oPrinter:TextOut( "This is on line" + Str( oPrinter:Prow(), 4
) + ", Printed bold, " )
oPrinter:TextOut( " finishing at Column: " )
oPrinter:TextOut( Str( oPrinter:Pcol(), 4 ) )
oPrinter:SetPrc( oPrinter:Prow() + 3, 0 )
oPrinter:Bold( WIN_FW_DONTCARE )
oPrinter:TextOut( "Notice: UNDERLINE only prints correctly if
there is a blank line after", .T. )
oPrinter:TextOut( " it. This is because of :LineHeight
and the next line", .T. )
oPrinter:TextOut( " printing over top of the
underline. To avoid this happening", .T. )
oPrinter:TextOut( " you can to alter :LineHeight or
use a smaller font, or use :SetBkMode( WIN_TRANSPARENT )" )
oPrinter:NewLine()
oPrinter:NewLine()
oPrinter:SetFont( "Lucida Console", 18, 0 ) // Large print
oPrinter:SetColor( HB_WIN_RGB_GREEN )
oPrinter:TextOut( "Finally some larger print" )
oPrinter:Box( 0, oPrinter:PosY + 100, 100, oPrinter:PosY + 200 )
oPrinter:Arc( 200, oPrinter:PosY + 100, 300, oPrinter:PosY + 200 )
oPrinter:Ellipse( 400, oPrinter:PosY + 100, 500, oPrinter:PosY + 200 )
oPrinter:FillRect( 600, oPrinter:PosY + 100, 700,
oPrinter:PosY + 200, HB_WIN_RGB_RED )
// To print a barcode;
// Replace 'BCod39HN' with your own bar code font or any other font
// oPrinter:TextAtFont( oPrinter:MM_TO_POSX( 30 ),
oPrinter:MM_TO_POSY( 60 ), "1234567890", "BCod39HN", 24, 0 )
//
PrintBitMap( oPrinter, cBMPFile )
oPrinter:EndDoc()
ENDIF
oPrinter:Destroy()
ENDIF
RETURN
STATIC PROCEDURE PrintBitMap( oPrn, cBitFile )
LOCAL oBMP
IF Empty( cBitFile )
*
ELSEIF ! hb_FileExists( cBitFile )
Alert( cBitFile + " not found " )
ELSE
oBMP := Win_BMP():New()
IF oBmp:loadFile( cBitFile )
oBmp:Draw( oPrn, { 200, 200, 2000, 1500 } )
// Note: Can also use this method to print bitmap
// oBmp:Rect := { 200, 200, 2000, 1500 }
// oPrn:DrawBitMap( oBmp )
ENDIF
oBMP:Destroy()
ENDIF
RETURN
