Download text file
$IF 0
---------------------------- PowerBASIC/cc v1.0
---| DASoft |------------------------------------------
---------------------------- Copyright 1999 DATE: 1999-06-12
| FILE NAME PBccPRNT.bas | by
| DIRECTORY | Don Schullian, Jr.
---------------------------- Lance Edmonds
This code is released into the Public Domain
Note, please, that Lance Edmonds's (amongst many other's) input has made
the core of this code. All I've done, in effect, is gather all the info
and build functions around it.
-------------------------------------------------------------------------
PURPOSE: Print to the user chosen printer using Windows' print spooler
and fonts found on the user's system.
-------------------------------------------------------------------------
Well, I was going to remark the code but there just isn't much to say about
it! All in all it's pretty simple once you understand all the Windows calls
so I'll confine myself to this discussion.
The PrinterInfoTYPE has MUCH more information in it that would be required
under normal non-proportional printing but I left it in 'cause it's easier
to remove something than it is to add it. Which brings up an important point
about this code: assuming that you're working in PB/cc I'd suggest using the
code below to build a customized print driver for your program. It would,
most likely, be easier in the long run.
The biggest headache when printing using Windows' routines is that you NEED
to keep track of the X/Y position of the 'print head' on a pixel level.
There ain't no rows and columns so TAB and SPC are out of the question. If
you find yourself requiring a lot of that then you'll want to obtain the
average height and width of the character set (for non-proportional) or
set up your own array of pixel values to the offsets you want to hit. To
put in a blank row is as simple as bumping the current .Ypos value by the
height of a row! When you get a bit of practice under your belt it REALLY
is an easy way to print. You know, label #6 starts at Xoffset/Yoffset and
you can "print" label 6's data first, last, in order, whenever and end up
with the same results when the page pops out!
Anyhow, there is some code in PBmain to get you started. Notice that I'm
printing the ASCii values in order (0 -> 255) but that they will be displayed
on the page in 3 columns with the numbers moving down the columns. Then, when
that's done I print in the upper left and bottom right corners of the page
totally out of any 'order'.
Ah.... got questions? Ask Lance, I don't have a clue! d;)
BTW, I've tested these routines on 2 kinds of H/Ps and my Epson Stylus pro
all under Windows 95. If anyone has any trouble with their printer let me
know, please.
If any of you have Win98 or NT and this code WORKS, let me know. Just for
my peace of mind, you understand.
Thanks,
Don Schullian
d83@DASoftVSS.com
$ENDIF
'
'-------------------------------------------------------------------------------
'-------------------------------------------------------------------------------
'
$INCLUDE "..\WIN32API.INC" ' you'll need to add any required path
$INCLUDE "..\COMDLG32.INC" ' info for these two files
TYPE PrinterInfoTYPE ' some (most?) of these members aren't necessary all the time
hDC AS LONG ' handle for Device Controller
'-------------------------------' page dimensions & info
Xtotal AS INTEGER ' total width (in pixels) of the page
Ytotal AS INTEGER ' total length (in pixels) of the page
XperPage AS INTEGER ' total usable horizontal units per page
YperPage AS INTEGER ' total usable vertical units per page
XperInch AS INTEGER ' horizontal units per inch
YperInch AS INTEGER ' vertical units per inch
X1offset AS INTEGER ' left offset (in pixels) to printable area
Y1offset AS INTEGER ' top offset (in pixels) to printagle area
X2offset AS INTEGER ' right offset (in pixels) to printable area
Y2offset AS INTEGER ' bottom offset (in pixels) to printagle area
Graphics AS LONG ' TRUE if printer capable of graphics
WidthMM AS INTEGER ' page width in millimeters
HeigthMM AS INTEGER ' page height in millimeters
tDI AS DocInfo ' current document information
'-------------------------------' computed & temporary variables
JobNbr AS INTEGER ' <> 0 indicates that a document is open
PageOpen AS INTEGER ' <> 0 indicates that a page is open
PageNbr AS INTEGER ' current page number (manual)
MarginLeft AS INTEGER ' left/right margins
MarginTop AS INTEGER ' top/bottom margins
MarginBottom AS INTEGER '
MarginRight AS INTEGER '
Xpos AS INTEGER ' current X position of print on line
Ypos AS INTEGER ' current Y position of print on page
hFont AS LONG ' current font handle
hOldFont AS LONG ' previous font handle
DocName AS ASCIIz * 256 ' current document name
tM AS TextMetric ' all kinds of goodies about current font
END TYPE
GLOBAL g_tFont() AS LOGFONT
GLOBAL g_FontCount AS LONG
GLOBAL g_FontMask AS LONG
GLOBAL g_tPI AS PrinterInfoTYPE
DECLARE FUNCTION fPrintJobOpen (BYVAL DocumentName AS STRING) AS LONG
DECLARE SUB PrintJobClose ()
DECLARE SUB PrintJobCancel ()
DECLARE SUB PrintJobEndPage ()
DECLARE SUB PrintJobNewPage ()
DECLARE SUB PrintJobSetFont (BYVAL FontNo AS LONG,BYVAL Pts AS SINGLE,BYVAL LinesPerInch AS LONG,BYVAL CharPerInch AS LONG,BYVAL Wgt AS LONG,BYVAL Q AS BYTE,BYVAL W AS BYTE, BYVAL U AS BYTE, BYVAL S AS BYTE)
DECLARE SUB PrintJobPrint (BYVAL Text AS STRING,BYVAL EoL AS LONG)
DECLARE SUB PrintJobMargins (BYVAL L AS SINGLE,BYVAL T AS SINGLE,BYVAL R AS SINGLE,BYVAL B AS SINGLE)
DECLARE FUNCTION fFontList (BYVAL NonProOnly AS LONG) AS LONG
DECLARE FUNCTION fFontFinder (BYVAL FontName AS STRING) AS LONG
'
'----------------------------------------------------------------------------
'-------- test code
'----------------------------------------------------------------------------
'
FUNCTION PBMAIN() AS LONG
DIM Char AS LOCAL LONG
DIM Col AS LOCAL LONG
DIM FontNo AS LOCAL LONG
DIM Margin AS LOCAL LONG
DIM zText AS LOCAL ASCIIZ * 256
DIM X AS LOCAL LONG
DIM tXY AS LOCAL apiSIZE ' used to be SIZE
fFontList -1
IF g_FontCount = 0 THEN
PRINT "NO NON-PROPORTIONAL FONTS FOUND"
WAITKEY$
EXIT FUNCTION
END IF
PRINT "Pick the letter of the font you desire or to cancel"
PRINT
FOR X = 1 to MIN(20,g_FontCount)
PRINT CHR$(X+64); FORMAT$(g_tFont(X).lfWeight," ### "); g_tFont(X).lfFaceName
NEXT
zText = UCASE$(WAITKEY$)
FontNo = ASC(zText) - 64
IF FontNo < 1 OR FontNo > g_FontCount THEN EXIT FUNCTION
IF ISFALSE(fPrintJobOpen("Test Print")) THEN EXIT FUNCTION
PrintJobSetFont FontNo, 0, 6, 10, %FW_NORMAL, 0, 0, 0, 0 ' pts,lpi,cpi,wgt,qlty,it,ul,so
PrintJobMargins 0.6, 1, 0.6, 1
WHILE g_tPI.PageNbr < 1
PrintJobNewPage
Char = 0
Col = 0
Margin = g_tPI.MarginLeft
FOR X = 1 TO 256
zText = FORMAT$(Char,"000 ") & CHR$(Char)
PrintJobPrint zText, 1
INCR Char
IF (g_tPI.Ypos + g_tPI.tM.tmHeight) > g_tPI.MarginBottom THEN
INCR Col
SELECT CASE Col
CASE 1 : PrintJobSetFont FontNo, 0, 6, 10, %FW_BOLD , 0, 1, 1, 0
CASE 2 : PrintJobSetFont -1, 0, 0, 0, 0, 0, 0, 0, 0
CASE 3 : PrintJobSetFont FontNo, 0, 6, 10, %FW_NORMAL, 0, 0, 0, 1
CASE 4 : PrintJobSetFont FontNo, 0, 6, 05, %FW_NORMAL, 0, 0, 0, 0
END SELECT
PrintJobSetFont FontNo, 0, 6, 10, %FW_BOLD, 0, 0, 0, 0
g_tPI.MarginLeft = g_tPI.MarginLeft + g_tPI.XperInch
g_tPI.Ypos = g_tPI.MarginTop
g_tPI.Xpos = g_tPI.MarginLeft
END IF
NEXT
FontNo = fFontFinder("Courier New")
IF ISFALSE(FontNo) THEN GOTO AllDone
PrintJobSetFont FontNo, 0, 6, 10, %FW_NORMAL, 0, 0, 0, 0
zText = g_tFont(FontNo).lfFaceName
g_tPI.MarginLeft = Margin
TextOut g_tPI.hDC, 0, 0, zText, LEN(zText)
zText = "This is the top right"
GetTextExtentPoint32 g_tPI.hDC, zText, LEN(zText), tXY
tXY.cx = g_tPI.XperPage - tXY.cx
TextOut g_tPI.hDC, tXY.cx, 0, zText, LEN(zText)
zText = "This is the bottom right"
GetTextExtentPoint32 g_tPI.hDC, zText, LEN(zText), tXY
tXY.cx = g_tPI.XperPage - tXY.cx
tXY.cy = g_tPI.YperPage - tXY.cy
TextOut g_tPI.hDC, tXY.cx, tXY.cy, zText, LEN(zText)
zText = FORMAT$(g_tPI.PageNbr, "Page No: #")
GetTextExtentPoint32 g_tPI.hDC, zText, LEN(zText), tXY
tXY.cy = g_tPI.YperPage - tXY.cy
TextOut g_tPI.hDC, 0, tXY.cy, zText, LEN(zText)
WEND
AllDone:
PrintJobClose
PRINT "DONE"
WAITKEY$
END FUNCTION
'
'-------------------------------------------------------------------------------
'
SUB PrintJobSetFont( BYVAL FontNo AS LONG , _
BYVAL Points AS SINGLE, _
BYVAL LinesPerInch AS LONG , _
BYVAL CharPerInch AS LONG , _
BYVAL Weight AS LONG , _
BYVAL Quality AS BYTE , _
BYVAL Italic AS BYTE , _
BYVAL Underline AS BYTE , _
BYVAL StrikeOut AS BYTE )
DIM tF AS LOCAL LOGFONT
IF (FontNo < 1) THEN
IF ISTRUE(g_tPI.hOldFont) THEN
DeleteObject g_tPI.hFont
g_tPI.hFont = SelectObject(g_tPI.hDC, g_tPI.hOldFont)
g_tPI.hOldFont = 0
END IF
ELSEif FontNo > g_FontCount THEN
EXIT SUB
ELSE
LSET tF = g_tFont(FontNo)
IF Points > 0 THEN
tF.lfHeight = -1 * ( (Points * g_tPI.YperInch) \ 72 )
tF.lfWidth = 0
ELSE
IF LinesPerInch > 0 THEN
tF.lfHeight = (g_tPI.YperInch \ LinesPerInch)
tF.lfWidth = 0
END IF
IF CharPerInch > 0 THEN
tF.lfWidth = (g_tPI.XperInch \ CharPerInch)
END IF
END IF
tF.lfWeight = Weight
tF.lfQuality = (Quality AND 3 )
tF.lfUnderline = ISTRUE(Underline)
tF.lfStrikeOut = ISTRUE(StrikeOut)
tF.lfItalic = ISTRUE(Italic )
IF ISTRUE(g_tPI.hOldFont) THEN DeleteObject g_tPI.hOldFont
g_tPI.hFont = CreateFontIndirect(tF)
g_tPI.hOldFont = SelectObject(g_tPI.hDC, g_tPI.hFont)
END IF
GetTextMetrics g_tPI.hDC, g_tPI.tM
END SUB
'
'-------------------------------------------------------------------------------
'
SUB PrintJobPrint( BYVAL Text AS STRING, _
BYVAL EoL AS LONG )
DIM Tlen AS LOCAL INTEGER
DIM tXY AS LOCAL apiSIZE
DIM Tptr AS LOCAL LONG
Tlen = LEN(Text)
IF Tlen = 0 THEN
tXY.cx = 0
tXY.cy = g_tPI.tM.tmHeight
ELSE
Tptr = STRPTR(Text)
TextOut g_tPI.hDC, g_tPI.Xpos, g_tPI.Ypos, BYVAL Tptr, Tlen
GetTextExtentPoint32 g_tPI.hDC, BYVAL Tptr, Tlen, tXY
END IF
IF ISFALSE(EoL) THEN
g_tPI.Xpos = g_tPI.Xpos + tXY.cx
ELSE
g_tPI.Ypos = g_tPI.Ypos + tXY.cy
g_tPI.Xpos = g_tPI.MarginLeft
END IF
END SUB
'
'-------------------------------------------------------------------------------
'
SUB PrintJobEndPage ()
IF ISTRUE(g_tPI.PageOpen) THEN EndPage g_tPI.hDC
g_tPI.PageOpen = 0
END SUB
'
'-------------------------------------------------------------------------------
'
SUB PrintJobNewPage ()
IF ISTRUE (g_tPI.PageOpen) THEN EndPage g_tPI.hDC
StartPage g_tPI.hDC
SelectObject g_tPI.hDC, g_tPI.hFont
g_tPI.Xpos = g_tPI.MarginLeft
g_tPI.Ypos = g_tPI.MarginTop
g_tPI.PageOpen = %TRUE
INCR g_tPI.PageNbr
END SUB
'
'-------------------------------------------------------------------------------
'
SUB PrintJobClose ()
IF ISTRUE(g_tPI.hDC) THEN
IF ISTRUE(g_tPI.PageOpen) THEN EndPage g_tPI.hDC
IF ISTRUE(g_tPI.JobNbr ) THEN EndDoc g_tPI.hDC
END IF
PrintJobCancel
END SUB
'
'-------------------------------------------------------------------------------
'
SUB PrintJobCancel ()
IF ISTRUE(g_tPI.hDC) THEN
IF ISTRUE(g_tPI.hOldFont) THEN DeleteObject g_tPI.hOldFont
IF ISTRUE(g_tPI.hFont ) THEN DeleteObject g_tPI.hFont
DeleteDC g_tPI.hDC
END IF
LSET g_tPI = STRING$(SIZEOF(g_tPI),0)
END SUB
'
'-------------------------------------------------------------------------------
'
SUB PrintJobMargins (BYVAL LeftM AS SINGLE, _
BYVAL TopM AS SINGLE, _
BYVAL RightM AS SINGLE, _
BYVAL BottomM AS SINGLE )
DIM B AS LOCAL LONG
DIM L AS LOCAL LONG
DIM R AS LOCAL LONG
DIM T AS LOCAL LONG
T = (LeftM * g_tPI.XperInch) ' compute pixels requested
L = (LeftM * g_tPI.YperInch) ' for margins
R = (RightM * g_tPI.XperInch)
B = (BottomM * g_tPI.YperInch)
g_tPI.MarginLeft = MAX( g_tPI.X1offset, (T - g_tPI.X1offset) )
g_tPI.MarginTop = MAX( g_tPI.Y1offset, (L - g_tPI.Y1offset) )
g_tPI.MarginRight = MIN( (g_tPI.Xtotal-g_tPI.X2offset), (g_tPI.Xtotal - R) )
g_tPI.MarginBottom = MIN( (g_tPI.Ytotal-g_tPI.Y2offset), (g_tPI.Ytotal - B) )
END SUB
'
'-------------------------------------------------------------------------------
'
FUNCTION fPrintJobOpen (BYVAL DocName AS STRING) AS LONG
DIM Copies AS LOCAL LONG
DIM FromPage AS LOCAL LONG
DIM ToPage AS LOCAL LONG
DIM MinPage AS LOCAL LONG
DIM MaxPage AS LOCAL LONG
DIM hDC AS LOCAL LONG
DIM Mask AS LOCAL LONG
DIM hWnd AS LOCAL LONG
PrintJobClose ' just to make sure & clear g_tPI
Copies = 1
FromPage = 1
ToPage = 1
MinPage = 1
MaxPage = 1
Mask = %PD_RETURNDC OR _ ' gotta have this one
%PD_DISABLEPRINTTOFILE OR _
%PD_NOSELECTION OR _
%PD_NOPAGENUMS
PrinterDialog hWnd, Mask, hDC, Copies, FromPage, ToPage, MinPage, MaxPage
IF ISFALSE(hDC) THEN EXIT FUNCTION
g_tPI.hDC = hDC
g_tPI.Xtotal = GetDeviceCaps(g_tPI.hDC,%PhysicalWidth)
g_tPI.Ytotal = GetDeviceCaps(g_tPI.hDC,%PhysicalHeight)
g_tPI.X1offset = GetDeviceCaps(g_tPI.hDC,%PhysicalOffsetX)
g_tPI.Y1offset = GetDeviceCaps(g_tPI.hDC,%PhysicalOffsetY)
g_tPI.XperPage = GetDeviceCaps(g_tPI.hDC,%HorzRes)
g_tPI.YperPage = GetDeviceCaps(g_tPI.hDC,%VertRes)
g_tPI.WidthMM = GetDeviceCaps(g_tPI.hDC,%HorzSize)
g_tPI.HeigthMM = GetDeviceCaps(g_tPI.hDC,%VertSize)
g_tPI.XperInch = GetDeviceCaps(g_tPI.hDC,%LogPixelsX)
g_tPI.YperInch = GetDeviceCaps(g_tPI.hDC,%LogPixelsY)
g_tPI.Graphics = GetDeviceCaps(g_tPI.hDC,%RasterCaps)
g_tPI.X2offset = g_tPI.Xtotal - g_tPI.X1offset - g_tPI.XperPage
g_tPI.Y2offset = g_tPI.Ytotal - g_tPI.Y1offset - g_tPI.YperPage
g_tPI.MarginRight = g_tPI.XperPage
g_tPI.MarginBottom = g_tPI.YperPage
IF ISTRUE(LEN(DocName)) THEN
g_tPI.DocName = DocName
ELSE
g_tPI.DocName = TIME$
END IF
g_tPI.tDI.cbsize = SIZEOF(g_tPI.tDI)
g_tPI.tDI.lpszDocName = VARPTR(g_tPI.DocName)
' g_tPI.tDI.lpszOutput = 0
' g_tPI.tDI.lpszDatatype = 0
' g_tPI.tDI.fwType = 0
g_tPI.JobNbr = StartDoc(g_tPI.hDC, g_tPI.tDI)
SetTextAlign g_tPI.hDC, %TA_BASELINE OR %TA_NOUPDATECP OR %TA_LEFT
SetBkMode g_tPI.hDC, %TRANSPARENT
FUNCTION = %True
END FUNCTION
'
'-------------------------------------------------------------------------------
'
FUNCTION fFontFinder (BYVAL FontName AS STRING) AS LONG
DIM FontNo AS LOCAL LONG
DIM Temp AS LOCAL STRING
DIM X AS LOCAL LONG
IF ISFALSE(g_FontCount) THEN
IF ISFALSE(fFontList(-1)) THEN EXIT FUNCTION
END IF
FontName = UCASE$(FontName)
FOR FontNo = g_FontCount TO 1 STEP -1
Temp = UCASE$(g_tFont(FontNo).lfFaceName)
IF Temp = FontName THEN EXIT FOR
IF ISTRUE(INSTR(Temp,FontName)) THEN X = FontNo
NEXT
IF ISTRUE(FontNo) THEN
FUNCTION = FontNo
ELSE
FUNCTION = X
END IF
END FUNCTION
'
'-------------------------------------------------------------------------------
'
FUNCTION fFontList (BYVAL NonProOnly AS LONG) AS LONG
DIM hDC AS LOCAL LONG
DIM Printer AS LOCAL ASCIIz * 256
REDIM g_tFont(10)
g_FontCount = 0
hDC = GetProfileString("WINDOWS", "DEVICE", ",,,", BYVAL VARPTR(Printer), 256)
IF ISFALSE(hDC) THEN EXIT FUNCTION
Printer = EXTRACT$(Printer,",")
hDC = CreateDC(BYVAL 0, BYVAL VARPTR(Printer), BYVAL 0, BYVAL 0)
IF ISFALSE(hDC) THEN EXIT FUNCTION
IF ISTRUE(NonProOnly) THEN
g_FontMask = ( %VARIABLE_PITCH OR %SYMBOL_CHARSET)
ELSE
g_FontMask = 0
END IF
EnumFontFamilies hDC, BYVAL 0, CODEPTR(Enum_Fonts), -1
DeleteDC hDC
ARRAY SORT g_tFont(1) FOR g_FontCount, FROM 29 TO 60, COLLATE UCASE
FUNCTION = %True
END FUNCTION
'
'----------- call-back routine for Windows -------------------------------------
'
FUNCTION Enum_Fonts( tLF AS LOGFONT , _
tTM AS TextMetric, _
BYVAL dwType AS LONG , _
BYVAL lParam AS LONG ) AS LONG
IF ISFALSE(tLF.lfPitchAndFamily AND g_FontMask) THEN
IF g_FontCount = UBOUND(g_tFont(1)) THEN
REDIM PRESERVE g_tFont(g_FontCount+10)
END IF
INCR g_FontCount
LSET g_tFont(g_FontCount) = tLF
IF (tLF.lfCharSet AND %DEFAULT_CHARSET) THEN
LSET g_tFont(0) = tLF
END IF
END IF
FUNCTION = %TRUE
END FUNCTION