Code:
'=================================================================================== 'Text Print Class - requires PBWin90 'by Charles Dietz (03-27-09) '[email protected] '----------------------------------------------------------------------------------- 'Using the Text Print class: ' ' LOCAL oTPrint AS iTPrint ' LET oTPrint = CLASS "cTPrint" ' ' printerName = oTPrint.choosePrinter ' printerName = oTPrint.defaultPrinter ' hdc = oTPrint.hdc ' oTPrint.orientPrint(2) ' oTPrint.duplexPrint(2) ' numLines = oTPrint.getLines ' oTPrint.setMargins(.75, .50, .75, 1.00) ' oTPrint.beginDoc("Job name") ' oTPrint.beginPage ' oTPrint.getPageSize(wi, ht) ' oTPrint.newFont("MS Sans Serif", 10, "bui") ' oTPrint.getCharSize(wi, ht) ' wi = oTPrint.getTextWidth(sText) ' sText = oTPrint.truncate(sText, 2.50) ' oTPrint.setPos(2.00, 1.00) ' oTPrint.printText(sText, 2.00, 1.00) ' oTPrint.printText(sText) ' oTPrint.closePage ' oTPrint.closeDoc ' 'Note: ' - Define a TPrint object with: ' LOCAL oTPrint AS iTPrint ' LET oTPrint = CLASS "cTPrint" ' - The first command after the TPrint object is defined must either ' be choosePrinter() or defaultPrinter() ' - Printing will not occur until closePage and closeDoc are executed ' - closeDoc() cleans up in order to prevent resource leaks ' - beginDoc() should be placed after defining orient, duplex, font, ... ' '=================================================================================== '... these two include statements not needed if InClean optimizer is used #INCLUDE ONCE "WIN32API.INC" #INCLUDE ONCE "ComDlg32.Inc" CLASS cTPrint INSTANCE hdc AS LONG 'handle of a display device context INSTANCE hFont AS LONG 'handle of current font INSTANCE hOrigFont AS LONG 'handle of original font INSTANCE charHt AS DOUBLE 'character height INSTANCE leftMargin AS DOUBLE 'left margin INSTANCE rightMargin AS DOUBLE 'right margin INSTANCE topMargin AS DOUBLE 'top margin INSTANCE bottomMargin AS DOUBLE 'bottom margin INSTANCE printerName AS STRING 'name of printer INSTANCE hDevMode AS LONG 'handle to DEVMODE structure INSTANCE origDuplex AS LONG 'original duplex mode INSTANCE origOrient AS LONG 'original orientation mode INSTANCE xPos, yPos AS DOUBLE 'default position for text print CLASS METHOD reportError(OPT BYVAL n AS LONG) LOCAL s AS STRING IF n = 1 THEN s = "Document printing error" ELSEIF n = 2 THEN s = "Page printing error" ELSE s = "Unspecified printer error" END IF MSGBOX s, %MB_ICONERROR, "Printer Error" END METHOD INTERFACE iTPrint INHERIT IUNKNOWN PROPERTY GET hdc() AS LONG PROPERTY = hdc END PROPERTY METHOD defaultPrinter() AS STRING 'determine default printer and device context handle LOCAL hPrinter, dwNeeded, n AS LONG LOCAL tm AS TEXTMETRIC, sz AS ASCIIZ*128 LOCAL pDevMode AS DEVMODE PTR GetProfileString "WINDOWS", "DEVICE", "", sz, 127 sz = TRIM$(PARSE$(sz, ",", 1)): printerName = sz OpenPrinter(sz, hPrinter, BYVAL %NULL) 'to obtain hPrinter dwNeeded = DocumentProperties(0, hPrinter, sz, BYVAL %NULL, BYVAL %NULL, 0) hDevMode = GlobalAlloc(%GHND, dwNeeded) pDevMode = GlobalLock(hDevMode) DocumentProperties 0, hPrinter, sz, BYVAL pDevMode, BYVAL %NULL, %DM_OUT_BUFFER hdc = CreateDC("WINSPOOL", sz, BYVAL %NULL, BYVAL pDevMode) GetTextMetrics hdc, tm n = tm.tmHeight + tm.tmExternalLeading charHt = n / GetDeviceCaps(hDC, %LOGPIXELSY) METHOD = printerName END METHOD METHOD choosePrinter() AS STRING 'choose printer and determine device context handle LOCAL n AS LONG LOCAL pd AS PRINTDLGAPI, pDevNames AS DEVNAMES PTR LOCAL tm AS TEXTMETRIC, psz AS ASCIIZ PTR pd.lStructSize = SIZEOF(pd) pd.Flags = %PD_RETURNDC OR %PD_HIDEPRINTTOFILE pd.Flags = pd.Flags OR %PD_ALLPAGES OR %PD_NOSELECTION OR %PD_NOPAGENUMS IF PrintDlg(pd) THEN 'call print dialog to select printer pDevNames = GlobalLock(pd.hDevNames) psz = pDevNames + @pDevNames.wDeviceOffset: printerName = @psz GlobalUnlock pd.hDevnames: hdc = pd.hDC END IF METHOD = printerName GetTextMetrics hdc, tm n = tm.tmHeight + tm.tmExternalLeading charHt = n / GetDeviceCaps(hDC, %LOGPIXELSY) hDevMode = pd.hDevMode END METHOD METHOD newFont(fName AS STRING, fSize AS LONG, OPT BYVAL fAttr AS STRING) AS LONG 'define a new font using a font name, font size in points, and font attributes 'combine attributes: "b" for bold, "u" for underline, "i" for italic LOCAL yppi, charSize, n AS LONG LOCAL wt, nBold, underline, italic AS DWORD, s AS STRING LOCAL tm AS TEXTMETRIC IF hFont THEN DeleteObject hFont IF hdc = 0 THEN ME.defaultPrinter IF LEN(fAttr) THEN nBold = SGN(INSTR(fAttr, "b"))*300 underline = INSTR(fAttr,"u") italic = INSTR(fAttr,"i") END IF yppi = GetDeviceCaps(hDC, %LOGPIXELSY) charSize = (fSize * yppi) \ 72 wt = %FW_NORMAL + nBold hFont = CreateFont(-charSize, 0, 0, 0, wt, italic, underline, 0, _ %ANSI_CHARSET, %OUT_TT_PRECIS, %CLIP_DEFAULT_PRECIS, _ %DEFAULT_QUALITY, %FF_DONTCARE, BYCOPY fName) n = SelectObject(hdc, hFont) IF hOrigFont = 0 THEN hOrigFont = n GetTextMetrics hdc, tm n = tm.tmHeight + tm.tmExternalLeading charHt = n / GetDeviceCaps(hDC, %LOGPIXELSY) END METHOD METHOD getTextWidth(txt AS STRING) AS DOUBLE 'get the text width in inches LOCAL cSize AS SIZEL IF hdc = 0 THEN ME.defaultPrinter GetTextExtentPoint32 hdc, BYVAL STRPTR(txt), LEN(txt), cSize METHOD = cSize.cx/GetDeviceCaps(hdc, %LOGPIXELSX) END METHOD METHOD truncate(s AS STRING, BYVAL wi AS DOUBLE) AS STRING 'truncate the text to a specified width, in inches 'if wi > 0, truncate the back end, else truncate the front end LOCAL nFit AS LONG, cSize AS SIZEL, ss AS STRING IF hdc = 0 THEN ME.defaultPrinter wi = GetDeviceCaps(hdc, %LOGPIXELSX) * wi 'width in pixels (logical units) IF wi > 0 THEN ss = s GetTextExtentExPoint hdc, BYVAL STRPTR(ss), LEN(ss), wi, nFit, BYVAL %NULL, cSize METHOD = LEFT$(ss, nFit) ELSEIF wi < 0 THEN wi = ABS(wi): ss = STRREVERSE$(s) GetTextExtentExPoint hdc, BYVAL STRPTR(ss), LEN(ss), wi, nFit, BYVAL %NULL, cSize METHOD = STRREVERSE$(LEFT$(ss, nFit)) END IF END METHOD METHOD setMargins(nLeft AS DOUBLE, nRight AS DOUBLE, nTop AS DOUBLE, nBottom AS DOUBLE) 'set page margins leftMargin = nLeft: rightMargin = nRight: topMargin = nTop: bottomMargin = nBottom END METHOD METHOD getPageSize(wi AS DOUBLE, ht AS DOUBLE) 'total size of the host printer page in inches IF hdc = 0 THEN ME.defaultPrinter wi = GetDeviceCaps(hdc, %PHYSICALWIDTH)/GetDeviceCaps(hdc, %LOGPIXELSX) ht = GetDeviceCaps(hdc, %PHYSICALHEIGHT)/GetDeviceCaps(hdc, %LOGPIXELSY) END METHOD METHOD getCharSize(wi AS DOUBLE, ht AS DOUBLE) 'character width and height in inches 'average character width if proportional font LOCAL tm AS TEXTMETRIC IF hdc = 0 THEN ME.defaultPrinter GetTextMetrics hdc, tm wi = tm.tmAveCharWidth/GetDeviceCaps(hdc, %LOGPIXELSX) ht = charHt END METHOD METHOD getLines(OPT BYVAL y AS DOUBLE) AS LONG 'determine number of remaining lines from y to bottom margin LOCAL yppi, paperHt, topNoPrn, bottomNoPrn AS LONG LOCAL yn AS DOUBLE IF hdc = 0 THEN ME.defaultPrinter yppi = GetDeviceCaps(hdc, %LOGPIXELSY) paperHt = GetDeviceCaps(hdc, %PHYSICALHEIGHT) topNoPrn = GetDeviceCaps(hdc, %PHYSICALOFFSETY) bottomNoPrn = paperHt - topNoPrn - GetDeviceCaps(hdc, %VERTRES) y = MAX(topMargin, topNoPrn\yppi, y) yn = paperHt/yppi - MAX(bottomMargin, bottomNoPrn/yppi) - y METHOD = INT(yn / charHt) END METHOD METHOD duplexPrint(n AS LONG) 'n = 1 Simplex 'n = 2 Horizontal 'n = 3 Vertical '------------------------------------------------- LOCAL pDevMode AS DEVMODE PTR IF hDevMode = 0 OR n = 0 THEN EXIT METHOD pDevMode = GlobalLock(hDevMode) IF origDuplex = 0 THEN origDuplex = @pDevMode.dmDuplex IF @pDevMode.dmFields AND %DM_DUPLEX THEN @pDevMode.dmDuplex = n @pDevMode.dmFields = @pDevMode.dmFields OR %DM_DUPLEX ResetDC hDC, @pDevMode GlobalUnlock hDevMode END IF END METHOD METHOD orientPrint(n AS LONG) 'n = 1 Portrait 'n = 2 Landscape '------------------------------------------------- LOCAL pDevMode AS DEVMODE PTR IF hDevMode = 0 THEN EXIT METHOD pDevMode = GlobalLock(hDevMode) IF origOrient = 0 THEN origOrient = @pDevMode.dmOrientation IF n AND @pDevMode.dmFields AND %DM_ORIENTATION THEN IF n THEN @pDevMode.dmOrientation = n @pDevMode.dmFields = @pDevMode.dmFields OR %DM_ORIENTATION ResetDC hDC, @pDevMode GlobalUnlock hDevMode END IF END METHOD METHOD setPos(x AS DOUBLE, y AS DOUBLE) xPos = x: yPos = y END METHOD METHOD printText(OPT BYVAL txt AS STRING, BYVAL x AS DOUBLE, BYVAL y AS DOUBLE) 'x, y are measured from the left and top edges of the paper 'if x or y are omitted then last valuew, xLast, yLast are used LOCAL xc, yc, xm, leftNoPrn, rightNoPrn, topNoPrn, bottomNoPrn AS LONG LOCAL paperWi, paperHt, xMax, yMax, xppi, yppi AS LONG LOCAL s AS STRING, sWidth AS DOUBLE, cSize AS SIZEL s = txt: IF x THEN xPos = x ELSE x = xPos IF y THEN yPos = y ELSE y = yPos + charHt: yPos = y IF hdc = 0 THEN ME.defaultPrinter paperWi = GetDeviceCaps(hdc, %PHYSICALWIDTH) paperHt = GetDeviceCaps(hdc, %PHYSICALHEIGHT) leftNoPrn = GetDeviceCaps(hdc, %PHYSICALOFFSETX) rightNoPrn = paperWi - leftNoPrn - GetDeviceCaps(hdc, %HORZRES) topNoPrn = GetDeviceCaps(hdc, %PHYSICALOFFSETY) bottomNoPrn = paperHt - topNoPrn - GetDeviceCaps(hdc, %VERTRES) GetTextExtentPoint32 hdc, BYVAL STRPTR(s), LEN(s), cSize xppi = GetDeviceCaps(hdc, %LOGPIXELSX): yppi = GetDeviceCaps(hdc, %LOGPIXELSY) xMax = paperWi - leftNoPrn - xppi * rightMargin yMax = paperHt - topNoPrn - yppi * bottomMargin xc = MAX(xppi * x - leftNoPrn, 0) yc = MAX(yppi * y - topNoPrn, 0) xm = MAX(xppi * leftMargin - leftNoPrn, 0) IF x < leftMargin THEN 'text overlaps left margin sWidth = ME.getTextWidth(s) s = ME.truncate(s, -(sWidth + x - leftMargin)): xc = xm END IF IF xc + cSize.cx > xMax THEN 'text overlaps right margin s = ME.truncate(s, (xMax - xc)/xppi) END IF IF y < topMargin THEN EXIT METHOD 'text overlaps top margin IF yc + yppi * charHt > yMax THEN EXIT METHOD 'text overlaps bottom margin TextOut(hdc, xc, yc, BYVAL STRPTR(s), LEN(s)) END METHOD METHOD beginDoc(s AS STRING) LOCAL nErr AS LONG, sz AS ASCIIZ*64 LOCAL di AS DOCINFO IF hdc = 0 THEN ME.defaultPrinter sz = s di.cbSize = SIZEOF(di) di.lpszDocName = VARPTR(sz) nErr = StartDoc(hdc, di) IF nErr <= 0 THEN ME.reportError(1) END METHOD METHOD beginPage LOCAL nErr AS LONG nErr = StartPage(hdc) IF nErr <= 0 THEN ME.reportError(2) END METHOD METHOD closePage EndPage(hdc) END METHOD METHOD closeDoc EndDoc(hdc) SelectObject hdc, hOrigFont DeleteObject hFont deleteDC hdc origDuplex = 0 origOrient = 0 hOrigFont = 0 END METHOD END INTERFACE END CLASS
Leave a comment: