FiveTech Software tech support forums

by **russimicro** » Thu Apr 11, 2024 4:56 am

Buena noche..

Uso este código, para convertir archivo texto(esc) en formato grafico (+pdfcreator) , genero un PDF

Necesito obtener el archivo grafico resultante, y poder salvarlo...

Los métodos de manipulación del archivo de salida están en C++

La function es PSPRINTFILE(...)
FUNCTION PSPrintFile(cFileName, lDelete, nPrinter, cTitle, nOrientation, ;
nCopies, cFont, nNroImp, cNroLog, cCodCia,nNroFor, ;
nNueTam,FormType,cNomFil )

Link para descargar fuete

http://www.down.russoft.net/actualiz/PSC_C.rar

Gracias
JONSSON RUSSI

by **Antonio Linares** » Thu Apr 11, 2024 6:47 am

Estimado Jonsson,

Copio aqui su contenido: (primera parte)

Code: Select all Expand view RUN: /* File......: PSC.PRG * Author....: Leo Letendre */ /* This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2, or (at your option ) * any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this software; see the file COPYING. If not, write to * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/ ). * * As a special exception, I give permission for * additional uses of the text contained. * * The exception is that, if you link this code with other * files to produce an executable, this does not by itself cause the * resulting executable to be covered by the GNU General Public License. * Your use of that executable is in no way restricted on account of * linking the Harbour library code into it. * * This exception does not however invalidate any other reasons why * the executable file might be covered by the GNU General Public License. * * This exception applies only to this code. If you copy code from other * Free Software Foundation releases into a copy of * this code, as the General Public License permits, the exception does * not apply to the code that you add in this way. To avoid misleading * anyone as to the status of such modified files, you must delete * this exception notice from them. * * If you write modifications of your own to this code, it is your choice * whether to permit this exception to apply to your modifications. * If you do not wish that, delete this exception notice. */ /* 6 point = 20 cpi for courier 14.6 cpi for arial 7 point = 17.1 cpi 12.8 cpi 8 point = 15 cpi 11 cpi 9 point = 13.2 cpi 9.9 cpi 10 point = 12 cpi 8.8 cpi 11 point = 10.9 cpi 8 cpi 12 point = 10 cpi 7.2 cpi 13 point = 9.2 cpi 6.7 cpi 14 point = 8.5 cpi 6.2 cpi */ #include "wingdi.ch" #include "pstrans.ch" // "\DESARRO\ZERUSGES\PLUSCAJA\PRINTSCRIPT\pstrans.ch" #include "WINTEN.h" // "\DESARRO\ZERUSGES\PLUSCAJA\PRINTSCRIPT\WINTEN.h" #translate RGB(<nRed>, <nGreen>, <nBlue>) ; ; => (<nRed> + (<nGreen> * 256) + (<nBlue> * 65536)) * The logical units used in these routines is pixels. #translate PointsToLU(<nPoints>) => INT(<nPoints>*nPtsPerLU) * PageScript defined colors translated to RGB #define PBLACK 0 #define PBLUE 8716288 #define PGREEN 34048 #define PCYAN 8750336 #define PRED 133 #define PMAGENTA 8716421 #define PBROWN 34181 #define PWHITE 126322256 #define PLIGHT_GRAY 6316128 #define PBRIGHT_BLUE 16711680 #define PBRIGHT_GREEN 6356832 #define PBRIGHT_CYAN 16777056 #define PBRIGHT_RED 2490616 #define PBRIGHT_MAGENTA 16736511 #define PYELLOW 65535 #define PBRIGHT_WHITE 16777215 //STATIC oPrintJob // printer job object STATIC nAddressMode // addressing mode STATIC aPrinters // list of printers STATIC cDefaultPrinter // name of default printer STATIC nNumberofPrinters:=0 // number of printers STATIC nCurPrinter:=0 // number of current printer STATIC lInited:=.F. // state of the routines STATIC lSaveUnderline:=.F. // underlined font in use STATIC lSetRowCol:=.F. // change rows/cols STATIC aSaveRowCol // values to use when we need to change STATIC lSetFont:=.F. STATIC aSaveFont STATIC lSetPage:=.F. STATIC nDefThick:=1 // default thickness STATIC nDefColor:=0 // default color black STATIC lSetBin:=.F. STATIC nSaveBin STATIC lSetJustify:=.F. STATIC nSaveJustify:=0 STATIC nDefJustify:=0 STATIC lPageActive:=.F. // something is printing on page STATIC lWaterMarkFirst:=.F. STATIC lWaterMarkLast:=.F. STATIC bWaterMark:=NIL STATIC lBackWater:=.F. STATIC lConvertAscii:=.T. STATIC nSaveOrientation:=-1 STATIC nSavePageSize1 STATIC nSavePageSize2 STATIC aColors:={PBLACK, PBLUE, PGREEN, PCYAN, PRED, PMAGENTA, PBROWN, PWHITE, ; PLIGHT_GRAY, PBRIGHT_BLUE, PBRIGHT_GREEN, PBRIGHT_CYAN, ; PBRIGHT_RED, PBRIGHT_MAGENTA, PYELLOW, PBRIGHT_WHITE} STATIC nPtsPerLU STATIC nCurBorder:=1 // default line width STATIC nBorderColor:=0 // default line color STATIC cDefDecimal:='.' // default decimal separator STATIC nFillColor:=APS_NONE // default fill in color STATIC nFillPattern:=BS_SOLID // default pattern STATIC aFilesToDelete:={} // list of bit map files to delete STATIC DevMode := NIL // save devmode structure STATIC DevModeSize := NIL // length of devmode structure STATIC DevNames := NIL // Saved devnames structure STATIC DevNamesSize := NIL // Saved devnames structure length STATIC SaveDevMode := NIL STATIC SaveDevModeSize:= NIL STATIC cRawPrintJob // name of the raw printer job STATIC cRawFile // name of temp file for raw printing STATIC nLeftMargin :=0 // additional margin control for TEXT based STATIC nTopMargin :=0 // addressing STATIC nRightMargin :=0 STATIC nBottomMargin :=0 STATIC aSaveNewMargins := NIL // place to save above until initialized /* C STRUCTURE cDevMode Align 1 Member dmDeviceName[CCHDEVICENAME] IS CTYPE_UNSIGNED_CHAR // BCHAR Member dmSpecVersion IS CTYPE_UNSIGNED_SHORT // WORD Member dmDriverVersion IS CTYPE_UNSIGNED_SHORT // WORD Member dmSize IS CTYPE_UNSIGNED_SHORT // WORD Member dmDriverExtra IS CTYPE_UNSIGNED_SHORT // WORD Member dmFields IS CTYPE_UNSIGNED_LONG // DWORD Member dmOrientation IS CTYPE_SHORT Member dmPaperSize IS CTYPE_SHORT Member dmPaperLength IS CTYPE_SHORT Member dmPaperWidth IS CTYPE_SHORT Member dmScale IS CTYPE_SHORT Member dmCopies IS CTYPE_SHORT Member dmDefaultSource IS CTYPE_SHORT Member dmPrintQuality IS CTYPE_SHORT Member dmColor IS CTYPE_SHORT Member dmDuplex IS CTYPE_SHORT Member dmYResolution IS CTYPE_SHORT Member dmTTOption IS CTYPE_SHORT Member dmCollate IS CTYPE_SHORT Member dmFormName[CCHFORMNAME] IS CTYPE_CHAR Member dmLogPixels IS CTYPE_UNSIGNED_SHORT Member dmBitsPerPel IS CTYPE_UNSIGNED_LONG Member dmPelsWidth IS CTYPE_UNSIGNED_LONG Member dmPelsHeight IS CTYPE_UNSIGNED_LONG Member dmDisplayFlags IS CTYPE_UNSIGNED_LONG Member dmDisplayFrequency IS CTYPE_UNSIGNED_LONG Member dmICMMethod IS CTYPE_UNSIGNED_LONG Member dmICMIntent IS CTYPE_UNSIGNED_LONG Member dmMediaType IS CTYPE_UNSIGNED_LONG Member dmDitherType IS CTYPE_UNSIGNED_LONG Member dmReserved1 IS CTYPE_UNSIGNED_LONG Member dmReserved2 IS CTYPE_UNSIGNED_LONG Member dmPanningWidth IS CTYPE_UNSIGNED_LONG Member dmPanningHeight IS CTYPE_UNSIGNED_LONG END C STRUCTURE */ /* !!! Print job functions */ /* -----------------------------------------------------*/ function PSInit() /* $DOC$ * $FUNCNAME$ * PSInit * $CATEGORY$ * Printing * $ONELINER$ * Initialize the printing system * $SYNTAX$ * PSInit() * $ARGUMENTS$ * None - Not needed in this implementation * $RETURNS$ * 0 * $DESCRIPTION$ * * Initializes the printing system * * * $EXAMPLES$ * * IF PSInit() = 0 * PSBeginDoc() * ... * PSFrame(2,2,8,10,5,APS_BLACK,APS_GREEN,APS_SOLID) * PSEndDoc() * ENDIF * $SEEALSO$ * * $INCLUDE$ * PSTRANS.CH * $END$ */ //PUBLIC oPrintJob // printer job object * PUBLIC sDevModeSmall is cDevMode * Not much to do here - get printers and set defaults PSGetPrinters() nDefThick=1 // 1 point nDefColor=0 // black lPageActive=.F. RETURN 0 /* -----------------------------------------------------*/ function PSEndDoc() /* $DOC$ * $FUNCNAME$ * PSEndDoc * $CATEGORY$ * Printing * $ONELINER$ * Complete a printjob and send it to the printer * $SYNTAX$ * PSEndDoc() * $ARGUMENTS$ * None * $RETURNS$ * NIL * $DESCRIPTION$ * Complete the printer job * * * * $EXAMPLES$ * IF PSInit() = 0 * PSBeginDoc() * ... * PSEndDoc() * ENDIF * * $SEEALSO$ * * $INCLUDE$ * PSTRANS.CH * $END$ */ LOCAL nLen LOCAL I * Send out watermark IF lInited.AND.lPageActive.AND.lWaterMarkLast DoWaterMark() ENDIF * finish and reset state variables IF lInited oPrintJob:EndDoc(.F.) lInited:=.F. // state of the routines lSaveUnderline:=.F. // underlined font in use lSetRowCol:=.F. // change rows/cols lSetFont:=.F. lSetPage:=.F. lSetBin=.F. lSetJustify:=.F. lPageActive=.F. lWaterMarkFirst:=.F. lWaterMarkLast:=.F. aSaveNewMargins:=NIL nLeftMargin :=0 // additional margin control for TEXT based nTopMargin :=0 // addressing nRightMargin :=0 nBottomMargin :=0 nCurPrinter :=0 nSaveOrientation :=-1 * Delete bitmap files as requested. nLen=LEN(aFilesToDelete) FOR I = 1 to nLen IF FILE(aFilesToDelete[I]) DELETE FILE (aFilesToDelete[I]) ENDIF NEXT ENDIF //RELEASE oPrintJob RETURN NIL * End of PSEndDoc /* -----------------------------------------------------*/ function PSBeginDoc(nPrinter,cTitle,nOrientation,nCopies,FormType,cNomFil) /* $DOC$ * $FUNCNAME$ * PSBeginDoc * $CATEGORY$ * Printing * $ONELINER$ * Start a print job * $SYNTAX$ * PSBeginDoc([<nPrinter>, <cTitle>, <nOrientation>, <nCopies>]) * $ARGUMENTS$ * <nPrinter> Printer number in the array returned by the PSGetPrinters() * function; * * 0 selects the default windows printer. If omited, it defaults * to zero. * -1 indicates that the standard windows print dialog should be * used to determine the user's selection of printers * * <cTitle> Title of the report in the print spooler. Defaults to * program name * <nOrientation> Paper orientation. APS_PORTRAIT (0) or APS_LANDSCAPE (1) * * <nCopies> Specify the number of copies. Default = 1 * * $RETURNS$ * 0 for success. 1 for error. * $DESCRIPTION$ * Initiates a print job with the specified parameters. If the user is * prompted for the printer selection, if the user hits cancel, an error * is returned. The user can select multiple copies if the drive supports * it. In this case, the driver provides the multiple copies. * * $EXAMPLES$ * * IF PSInit() = 0 * PSBeginDoc(-1, "Nice Job", 0, 1) * ... * PSEndDoc() * ENDIF * $SEEALSO$ * * $INCLUDE$ * PSTRANS.CH * $END$ */ LOCAL lReturn:=.F. //* Not Pagescript behavour but this should work IF !lInited PSINIT() ENDIF * If we haven't gotten the printers do so IF nNumberofPrinters=0 PSGetPrinters() ENDIF * Input must be less than the number of printers and if less than 0 * then will use the windows print dialog IF nPrinter=NIL.OR.nPrinter>nNumberofPrinters nPrinter=0 ENDIF * 0 indicates use the default printer IF nPrinter=0 nCurPrinter=PSGetDefPrinter() ELSE nCurPrinter=nPrinter ENDIF //* Create the object oPrintJob := WinPrn32():New(IIF(nPrinter>0,aPrinters[nPrinter],; IIF(nPrinter<0,nPrinter,GetDefaultPrinter())),FormType) //* Now set the number of copies - note if the dialog box has been called //* the user has the option to change the number of copies and we won't know //* about it since the drive still tells us to print one and it does the //* copying. IF VALTYPE(nCopies)='N'.AND. nCopies>0 oPrintJob:Copies=nCopies ELSE oPrintJob:Copies=1 ENDIF //* Orientation IF VALTYPE(nOrientation)='N' oPrintJob:Landscape:= (nOrientation=APS_LANDSCAPE) ELSEIF nSaveOrientation>-1 oPrintJob:LandScape:= (nSaveOrientation=APS_LANDSCAPE) ELSE oPrintJob:LandScape=.F. ENDIF //* Create the complete object using the mode that addresses the page as pixels lReturn=oPrintJob:Create(MM_TEXT) IF lReturn lInited=.T. lPageActive=.F. aFilesToDelete={} //* If the call was made to the windows dialog, then figure out which printer //* we really have IF nPrinter<0 nCurPrinter=PS_PrinterNumber() ENDIF /* do any changes stored up before we started */ IF lSetRowCol PSSetRowCol(aSaveRowCol[1],aSaveRowCol[2]) lSetRowCol=.F. ELSE PSSetRowCol(60,80) ENDIF IF lSetFont PSSetFont(aSaveFont[1],aSaveFont[2],aSaveFont[3],aSaveFont[4],aSaveFont[5],; aSaveFont[6],aSaveFont[7]) lSetFont:=.F. ENDIF IF lSetPage lSetPage:=.F. PSSetPageSize(nSavePageSize1,nSavePageSize2) ELSE PSSetPageSize(oPrintJob:FormType) ENDIF IF lSetBin lSetBin=.F. PSSetBin(nSaveBin) ENDIF IF lSetJustify lSetJustify=.F. PSSetJustify(nSaveJustify) ENDIF IF aSaveNewMargins!=NIL PS_PageMargins(aSaveNewMargins[1],aSaveNewMargins[2],aSaveNewMargins[3]; ,aSaveNewMargins[4],aSaveNewMargins[5]) ENDIF //* Text has a transparent background oPrintJob:SetBkMode(TRANSPARENT) //* Get ready to print oPrintJob:StartDoc(cNomFil) //* Calculate a translation value nPtsPerLU=oPrintJob:PixelsPerInchX/72 ENDIF //* Page script compatable return RETURN (IIF(lReturn,0,1)) //* End of PSBeginDoc /* -----------------------------------------------------*/ FUNCTION PSSetOrientation(nMode) /* $DOC$ * $FUNCNAME$ * PSSetOrientation * $CATEGORY$ * Printing * $ONELINER$ * Sets the page orientation to portrait or landscape * $SYNTAX$ * PSSetOrientation(<nMode>) * $ARGUMENTS$ * nMode - Either APS_PORTRAIT or APS_LANDSCAPE * $RETURNS$ * Nothing * $DESCRIPTION$ * * This routine selects the page orientation. * * Constant Value Description * APS_PORTRAIT 0 Portrait mode * APS_LANDSCAPE 1 Landscape mode * * This routine can be call prior to calling PSBeginDoc() to set the mode * * In addition (AND AS A SUPERSET OF PageScript), this routine can be * called during the print job to change the orientation of the NEXT page. * * $EXAMPLES$ * * $SEEALSO$ * * $INCLUDE$ * PSTRANS.CH * $END$ */ IF lInited IF VALTYPE(nMode)='N' oPrintJob:Landscape:=(nMode=APS_LANDSCAPE) ENDIF ELSE nSaveOrientation=nMode ENDIF RETURN NIL * End of PSSetOrientation FUNCTION PSGetOrientation(nMode) /* $DOC$ * $FUNCNAME$ * PSGetOrientation * $CATEGORY$ * Printing * $ONELINER$ * Returns the currentpage orientation to portrait or landscape * $SYNTAX$ * PSGetOrientation() * $ARGUMENTS$ * None * $RETURNS$ * nOrientation - current value * $DESCRIPTION$ * * This routine returns the page orientation. * * Constant Value Description * APS_PORTRAIT 0 Portrait mode * APS_LANDSCAPE 1 Landscape mode * * This routine returns the value currently in effect. If you have * called PSSetOrientation, the value just set will be returned even * if the current page is not being printed in this manner. It will * return the orientation of the next page to be printed (assuming * that you do not change it before it starts printing.) * * $EXAMPLES$ * * $SEEALSO$ * * $INCLUDE$ * PSTRANS.CH * $END$ */ LOCAL nReturn IF lInited nReturn=IIF(oPrintJob:LandScape,APS_LANDSCAPE,APS_PORTRAIT) ELSEIF nSaveOrientation>-1 nReturn=nSaveOrientation ELSE nReturn=APS_PORTRAIT ENDIF RETURN nReturn * End of GetOrientation function PSSetUnit(nMode) /* $DOC$ * $FUNCNAME$ * PSSetUnit * $CATEGORY$ * Printing * $ONELINER$ * Sets the address mode for all output * $SYNTAX$ * PSSetUnit(<nUnit>) * $ARGUMENTS$ * nUnit - contstant defining the addressing mode * $RETURNS$ * nOldUnit - Previous setting * $DESCRIPTION$ * * This routine selects the method of addressing the printing. Legal values are: * * Constant Value Description * APS_TEXT 0 Unit is text coordinates (Row, Col) * APS_MILL 1 Unit is millimeters * APS_CENT 2 Unit is centimeters * APS_INCH 3 Unit is inches * APS_PIXEL 4 Unit is pixels * * All modes except APS_TEXT are relative to the edge of the paper. APS_TEXT mode references the printable * portion of the page. * * $EXAMPLES$ * * $SEEALSO$ * * $INCLUDE$ * PSTRANS.CH * $END$ */ LOCAL nReturn:=nAddressMode IF VALTYPE(nMode)='N'.AND.nMode>=APS_TEXT.AND.nMode<=APS_PIXEL nAddressMode=nMode ENDIF RETURN nReturn * End of PSSetUnit /* -----------------------------------------------------*/ function PSNewPage() /* $DOC$ * $FUNCNAME$ * PSNewPage * $CATEGORY$ * Printing * $ONELINER$ * Completes the current page and begins a new one * $SYNTAX$ * PSNewPage() * $ARGUMENTS$ * None * $RETURNS$ * NIL * $DESCRIPTION$ * * Completes the current page and then initializes a new page. * * * $EXAMPLES$ * * * * * * $SEEALSO$ * * $INCLUDE$ * PSTRANS.CH * $END$ */ * If we need to send out watermark, do so IF lInited.AND.lWaterMarkLast.AND.lPageActive DoWaterMark() ENDIF IF lInited oPrintJob:NewPage() lPageActive=.F. ENDIF RETURN NIL * End of PSNewPage /* -----------------------------------------------------*/ function PSAbort() /* $DOC$ * $FUNCNAME$ * PSAbort * $CATEGORY$ * Printing * $ONELINER$ * Aborts a print job * $SYNTAX$ * PSAbort() * $ARGUMENTS$ * None * $RETURNS$ * NIL * $DESCRIPTION$ * * Aborts a print job started by PSBeginJob with no output created * * $EXAMPLES$ * * IF PSInit() * * DO WHILE Printing * ... * IF INKEY() = K_ESC * PSAbort() * QUIT * ENDIF * ENDDO * ENDIF * * $SEEALSO$ * PSBeginDoc PSEndDoc * $INCLUDE$ * PSTRANS.CH * $END$ */ * Kill the job IF lInited oPrintJob:EndDoc(.T.) ENDIF * Reset state variables lInited:=.F. // state of the routines lSaveUnderline:=.F. // underlined font in use lSetRowCol:=.F. // change rows/cols lSetFont:=.F. lSetPage:=.F. lSetBin=.F. lSetJustify=.F. lPageActive=.F. aSaveNewMargins=NIL nLeftMargin :=0 // additional margin control for TEXT based nTopMargin :=0 // addressing nRightMargin :=0 nBottomMargin :=0 nCurPrinter :=0 nSaveOrientation :=-1 RETURN NIL * End of PSAbort /* -----------------------------------------------------*/ function PSSetPageSize(nPaperSize,nWidth) /* $DOC$ * $FUNCNAME$ * PSSetPageSize * $CATEGORY$ * Printing * $ONELINER$ * Set the page size for the upcomming print job * $SYNTAX$ * PSSetPageSize(<nLength|nPredefinedPageSize, [nWidth]>) * $ARGUMENTS$ * * <nLength | nPredefinedPageSize> Length of the user defined paper size or one of the predefined paper * size constants. * <nWidth> Width of the user defined paper size. * * $RETURNS$ * NIL * $DESCRIPTION$ * * Set the paper size of your document. Arguments may one of the predefined paper sizes (see wingdi.h) * or a user defined size. The user defined size contains the paper length and width, in units of tenths * of millimeters. * * * $EXAMPLES$ * * $SEEALSO$ * * $INCLUDE$ * PSTRANS.CH * $END$ */ /* NOTE: Only deals with predefined paper sizes right now */ IF lInited IF !EMPTY(nWidth) oPrintJob:SetPageSize({nPaperSize,nWidth}) ELSE oPrintJob:SetPageSize(nPaperSize) ENDIF ELSE lSetPage=.T. nSavePageSize1=nPaperSize nSavePageSize2=nWidth ENDIF RETURN NIL * End of PSSetPageSize FUNCTION PSWaterMark(bFunction,lBackground) LOCAL aOldSetting:={bWaterMark,lBackWater} IF VALTYPE(bFunction)='B'.AND.VALTYPE(lBackWater)='L' bWaterMark=bFunction lBackWater=lBackGround IF lBackground lWaterMarkFirst=.T. lWaterMarkLast=.F. ELSE lWaterMarkFirst=.F. lWaterMarkLast=.T. ENDIF ENDIF RETURN aOldSetting /* -----------------------------------------------------*/ /* !!! Utility function */ STATIC FUNCTION PSTransformCoord(nRow,nCol) /* Transform from the mode used by user to pixels */ LOCAL nX,nY IF nAddressMode=APS_TEXT * if we are in text mode, then we are actually addressing the printable area * also if we are printing text move the cell down. Lines appear to be * drawn at the top of the cell. nX=nLeftMargin nY=nTopMargin ELSE // I Don't like this but it appears that this is what PageScript does // something like this in an attempt to address relative to the edge of // the paper. nX=-oPrintJob:LeftMarginPixels nY=-oPrintJob:TopMarginPixels ENDIF IF nAddressMode=APS_TEXT // text cooridnates nX+=(oPrintJob:PrintWidthPixels-nRightMargin-nLeftMargin) *nCol/oPrintJob:TextCol nY+=(oPrintJob:PrintHeightPixels-nBottomMargin-nTopMargin) *(nRow)/oPrintJob:TextRow ELSEIF nAddressMode=APS_MILL nX+=oPrintJob:PixelsPerMMX*nCol nY+=oPrintJob:PixelsPerMMY*nRow ELSEIF nAddressMode=APS_CENT nX+=oPrintJob:PixelsPerMMX*nCol/10 nY+=oPrintJob:PixelsPerMMY*nRow/10 ELSEIF nAddressMode=APS_INCH nX+=oPrintJob:PixelsPerInchX*nCol nY+=oPrintJob:PixelsPerInchY*nRow ELSEIF nAddressMode=APS_PIXEL nX+=nCol nY+=nRow ENDIF RETURN {INT(nX),INT(nY)} * End of PSTransformCoord FUNCTION PS_GetPrintObject /* $DOC$ * $FUNCNAME$ * PS_GetPrintObject * $CATEGORY$ * Printing * $ONELINER$ * Returns the print job object * $SYNTAX$ * PS_GetPrintObject * $ARGUMENTS$ * None * $RETURNS$ * oPrintJob - a print job object * $DESCRIPTION$ * * A print object is created within the Print Script system to handle * printing. This routine returns the object used to run the system. * One can use this object to examine a number of variables within the * object. These include: * * PrinterName Printer name * Printing Output has been sent to the printer * hPrinterDc Printer handle * FormType Paper type * BinNumber Bin Number * Landscape Logical indicating landscape orientation * Copies Number of copies. Note: When using printer dialog, * the user may select multiple copies and it is NOT * reflected here if the driver supports its own copying. * * FontName Current font name * FontPointSize Point size for font * FontWidth {Mul, Div} Calc width: nWidth * fBold font darkness weight ( Bold). See wingdi.h * fUnderLine Logical UnderLine is on or off * fItalic Logical Italic is on or off * StrikeThrough Logical strikethrough on/off * FontAngle text angle * * PixelsPerInchY Pixels per inch in the Y direction (long side * in Portrait mode) * PixelsPerInchX Pixels per inch in the X direction * PixelsPerMMX Pixels per mm in the X direction * PixelsPerMMY Pixels per mm in the Y direction * * PageHeightPixels Page height in pixels * PageWidthPixels Page Width in pixels * TopMarginPixels Top Margin in pixels * BottomMarginPixels Bottom margin in pixels * LeftMarginPixels Left Margin in Pixels * RightMarginPixels Right margin in pixels * PrintWidthPixels Printing area width in pixels * PrintHeightPixels Printing area height in pixels * * PageWidthMM Page height in mm * PageHeightMM Page Width in mm * LeftMarginMM left margin in mm * RightMarginMM right margin in mm * TopMarginMM top margin in mm * BottomMarginMM bottom margin in mm * PrintWidthMM printing area width in mm * PrintHeightMM printing area height in mm * * BitmapsOk Diver supports bit maps * NumColors number of colors supported by driver * PosX current position in pixels - X direction * PosY current position in pixels - Y direction * TextColor current text color * BkColor current text background color * TextAlign current text alignment * BkMode current background mode * PenStyle current pen style * PenWidth current pen width - pixels * PenColor current pen color * * $EXAMPLES$ * @ 1,1 SAY PS_GetPrintObject():PenColor+' currently being used' * * $SEEALSO$ * * $INCLUDE$ * PSTRANS.CH * $END$ */ RETURN oPrintJob *End of PS_GetPrintJob STATIC FUNCTION DoWaterMark IF lInited.AND.lPageActive EVAL(bWaterMark) ENDIF RETURN NIL * End of DoWaterMark FUNCTION PS_TextLength(cString) /* $DOC$ * $FUNCNAME$ * PS_TextLength * $CATEGORY$ * Printing * $ONELINER$ * Returns length of a printed text string using current font settings * $SYNTAX$ * PS_TextLength(cString) * $ARGUMENTS$ * cString - the text string of interest * $RETURNS$ * nLength - length of string in the currently used units (text, * inches, etc) * $DESCRIPTION$ * * Return the print drives determination of the printed length of the * passed string using the currently set font settings * * Same as PSGetTextLength - remains for compatability * * $EXAMPLES$ * * PSSetUnits(APS_TEXT) * PSBeginDoc(1,'Test') * PSSetFont(APS_COURIER,12) * nTextLength=PS_TextLength('This is a test') * * $SEEALSO$ * * $INCLUDE$ * PSTRANS.CH * $END$ */ /* returns the length of a printed text string using the current font settings in the units currently in effect*/ LOCAL nLength:=0 * Get the length in pixels IF lInited nLength= oPrintJob:GetTextWidth(cString) * Convert to current units IF nAddressMode=APS_TEXT // text cooridnates nLength=oPrintJob:TextCol*nLength/oPrintJob:PrintWidthPixels ELSEIF nAddressMode=APS_MILL nLength = nLength/oPrintJob:PixelsPerMMX ELSEIF nAddressMode=APS_CENT nLength = nLength/oPrintJob:PixelsPerMMX/10 ELSEIF nAddressMode=APS_INCH nLength=nLength/oPrintJob:PixelsPerInchX ENDIF ENDIF RETURN nLength * End of PS_TextLength FUNCTION PSGetTextLength(cString) /* $DOC$ * $FUNCNAME$ * PSGetTextLength * $CATEGORY$ * Printing * $ONELINER$ * Returns length of a printed text string using current font settings * $SYNTAX$ * PSGetTextLength(cString) * $ARGUMENTS$ * cString - the text string of interest * $RETURNS$ * nLength - length of string in the currently used units (text, * inches, etc) * $DESCRIPTION$ * * Return the print driver's determination of the printed length of the * passed string using the currently set font settings * * * $EXAMPLES$ * * PSSetUnits(APS_TEXT) * PSBeginDoc(1,'Test') * PSSetFont(APS_COURIER,12) * nTextLength=PSGetTextLength('This is a test') * * $SEEALSO$ * * $INCLUDE$ * PSTRANS.CH * $END$ */ RETURN PS_TextLength(cString) * End of PSGetTextLength FUNCTION PS_TextHeight(cString) /* $DOC$ * $FUNCNAME$ * PS_TextHeight * $CATEGORY$ * Printing * $ONELINER$ * Returns height of a printed text string using current font settings * $SYNTAX$ * PS_TextHeight(cString) * $ARGUMENTS$ * cString - the text string of interest * $RETURNS$ * nHeight - Height of string in the currently used units (text, * inches, etc) * $DESCRIPTION$ * * Return the print driver's determination of the printed height of the * passed string using the currently set font settings * * Same as PSGetTextHeight - remains for compatability * * $EXAMPLES$ * * PSSetUnits(APS_TEXT) * PSBeginDoc(1,'Test') * PSSetFont(APS_COURIER,12) * nTextHeight=PS_TextHeight('This is a test') * * $SEEALSO$ * * $INCLUDE$ * PSTRANS.CH * $END$ */ /* returns the length of a printed text string using the current font settings in the units currently in effect*/ LOCAL nHeight:=0 * Get the length in pixels IF lInited nHeight= oPrintJob:GetTextHeight(cString) * Convert to current units IF nAddressMode=APS_TEXT // text cooridnates nHeight=oPrintJob:TextRow*nHeight/oPrintJob:PrintHeightPixels ELSEIF nAddressMode=APS_MILL nHeight = nHeight/oPrintJob:PixelsPerMMY ELSEIF nAddressMode=APS_CENT nHeight = nHeight/oPrintJob:PixelsPerMMY/10 ELSEIF nAddressMode=APS_INCH nHeight=nHeight/oPrintJob:PixelsPerInchY ENDIF ENDIF RETURN nHeight * End of PS_TextLength FUNCTION PSGetTextHeight(cString) /* $DOC$ * $FUNCNAME$ * PSGetTextHeight * $CATEGORY$ * Printing * $ONELINER$ * Returns height of a printed text string using current font settings * $SYNTAX$ * PSGetTextHeight(cString) * $ARGUMENTS$ * cString - the text string of interest * $RETURNS$ * nHeight - Height of string in the currently used units (text, * inches, etc) * $DESCRIPTION$ * * Return the print driver's determination of the printed height of the * passed string using the currently set font settings * * * $EXAMPLES$ * * PSSetUnits(APS_TEXT) * PSBeginDoc(1,'Test') * PSSetFont(APS_COURIER,12) * nTextHeight=PSGetTextHeight('This is a test') * * $SEEALSO$ * * $INCLUDE$ * PSTRANS.CH * $END$ */ RETURN PS_TextHeight(cString) * End of PSGetTextHeight FUNCTION PS_CopiesRequested /* $DOC$ * $FUNCNAME$ * PS_CopiesRequested * $CATEGORY$ * Printing * $ONELINER$ * Returns the number of copies the program should produce * $SYNTAX$ * PS_CopiesRequested * $ARGUMENTS$ * None * $RETURNS$ * nCopies - the number of copies the program should produce * * $DESCRIPTION$ * * When the user is presented with the printer dialog box, they can select * a number of copies other than 1. If the printer driver is capable of * of producing these copies, the return value is 1. If the driver cannot * produce the requested copies, then the number of copies the program should * produce is returned. * * $EXAMPLES$ * * PSSetUnits(APS_TEXT) * PSBeginDoc(1,'Test') * nCopies = PS_CopiesRequested() * * FOR I = 1 TO nCopies * PSSetFont(APS_COURIER,12) * nTextLength=PS_TextLength('This is a test') * ... * NEXT * * $SEEALSO$ * * $INCLUDE$ * PSTRANS.CH * $END$ */ RETURN oPrintJob:RequestedCopies * End of PS_CopiesRequested STATIC FUNCTION TransColor(nColor) * Negative numbers mean that the caller is using APS codes * Otherwise assume that it is an RGB value * Does not handle APS_NONE. This must be trapped by caller IF VALTYPE(nColor)='N'.AND.nColor<0 nColor=-nColor IF nColor<17 nColor=aColors[nColor] ELSE nColor=aColors[16] ENDIF ENDIF RETURN nColor STATIC FUNCTION TempFile( cPath, cExt ) Local cString IF VALTYPE(cPath)!='C' cPath=DirTmp() ENDIF IF VALTYPE(cExt)!='C' cExt = 'tmp' ENDIF cString := cPath + strzero(int(hb_random(val(strtran(time(), ":", "")))), 8) + '.' + cExt DO WHILE File( cString ) cString := cPath + strzero(int(hb_random(val(strtran(time(), ":", "")))), 8) + '.' + cExt END Return cString STATIC Function DirTmp() Local xDirectory xDirectory := IIF(Empty(Getenv("TMP")), Getenv("TEMP"), Getenv("TMP")) IF Empty(xDirectory); xDirectory := '.'; END IF ';' $ xDirectory xDirectory := LEFT( xDirectory, AT( ';', xDirectory ) - 1 ) END RETURN xDirectory + IIF( Right(xDirectory, 1) != '\' .and. ! Empty(xDirectory), '\', '' ) /* !!! Drawing functions */ FUNCTION PSLine(nR1,nC1,nR2,nC2,nThick,nColor) /* $DOC$ * $FUNCNAME$ * PSLine * $CATEGORY$ * Printing * $ONELINER$ * Draws a Line * $SYNTAX$ * PSLine(<nR1>, <nC1>, <nR2>, <nC2>, [<nThick>, <nColor>]) * $ARGUMENTS$ * All coordinates are in currently set units Colors can be predefined or RGB colors * * <nR1>, <nC1> Start of the line * * <nR2>, <nC2> End of the line * * <nThick> Thickness of the line in points. Defaults to 1 point * * <nColor> Border color if applicable. You may use one of the predefined color or a RGB color. * If you do not want a border, either enter 0 for thickness or use the APS_NONE color. * * $RETURNS$ * NIL * $DESCRIPTION$ * * Draw a between two points * * * * $EXAMPLES$ * * IF PSInit() = 0 * PSBeginDoc() * ... * PSLine(2,2,8,10,5,APS_BLACK) * PSEndDoc() * ENDIF * * $SEEALSO$ * * $INCLUDE$ * PSTRANS.CH * $END$ */ LOCAL nSaveThick LOCAL nSaveColor LOCAL aCoord1, aCoord2 * If we need to send out watermark, do so IF lInited.AND.lWaterMarkFirst.AND.!lPageActive lPageActive=.T. DoWaterMark() ENDIF IF lInited nSaveThick:=oPrintJob:PenWidth nSaveColor:=oPrintJob:PenColor aCoord1=PSTransformCoord(nR1,nC1,.F.) aCoord2=PSTransformCoord(nR2,nC2,.F.) * Negative numbers mean that the caller is using APS codes * Otherwise assume that it is an RGB value IF VALTYPE(nColor)!='N' nColor=nDefColor ENDIF * Transform the color from APS values if needed nColor=TransColor(nColor) * default values IF VALTYPE(nThick)!='N' nThick=nDefThick ENDIF * Draw the line oPrintJob:SetPen(oPrintJob:FontStyle,PointsToLU(nThick),nColor) oPrintJob:Line(aCoord1[1],aCoord1[2],aCoord2[1],aCoord2[2]) oPrintJob:SetPen(oPrintJob:FontStyle,nSaveThick,nSaveColor) lPageActive=.T. ENDIF RETURN NIL * End of PSLine FUNCTION PSSetBorder(nBorder,nColor) /* $DOC$ * $FUNCNAME$ * PSSetBorder * $CATEGORY$ * Printing * $ONELINER$ * Set default values for borders and colors for those objects having borders * $SYNTAX$ * PSSetBorder([<nThick>, <nColor>]) * $ARGUMENTS$ * * <nThick> Thickness of the border in points. One point equals 1/72 inch. * <nColor> Color of the border. May be a basic color or a RGB color. * See one of the object this applies to for colors. * $RETURNS$ * aOldBorder - array containing old setting {nOldThick, nOldColor} * $DESCRIPTION$ * * Sets the default values for borders and colors for objects like PSFrames, PSEllispe, PSTextBox * * $EXAMPLES$ * * * * * * $SEEALSO$ * * $INCLUDE$ * PSTRANS.CH * $END$ */ LOCAL aReturn:={nDefThick,nDefColor} * Save values nDefThick=nBorder nDefColor=nColor RETURN aReturn * End of PSSetBorder FUNCTION PSBitMap(nR1, nC1, nR2, nC2, cBitMap, nTransColor, lDeleteFile, lKeepRatio,lInMemory) /* $DOC$ * $FUNCNAME$ * PSBitMap * $CATEGORY$ * Printing * $ONELINER$ * Draw a bitmap on a printed page * $SYNTAX$ * PSBitMap(nR1, nC1, nR2, nC2, cBitMap, nTransColor, lDeleteFile; * ,lKeepRatio, lInMemory) * $ARGUMENTS$ * nR1, nC1 - coordinates of top left corner in current units * nR2, nC2 - coordinates of the lower right corner. If NIL, the * bitmap is draw in its original size. Otherwise it is * scaled to fit the box based upon the lKeepRatio parameter * cBitMap - Either a full file name with path pointing to a file * containing the bitmap or the bitmap itself. Only * non-compressed files work. Only one bitmap per file * allowed - no resource files * nTransColor - If you wish to draw a transparent bitmap, this indicates * the color that will be transparent. If NIL, the entire * bitmap is opaque * lDeleteFile - delete the file after printing * lKeepRatio - If .T. the picture is scaled to fit in the box but also * keeps the width to height ratio that of the original. * nR2 and nC2 must be specified if .T. * lInMemory - cBitMap contains the actual bit map in memory * $RETURNS$ * NIL * $DESCRIPTION$ * * This routine draws a bitmap on the page at the given coordinates. * BMP and JPEG (JPG) files are supported. * * $EXAMPLES$ * * * IF PSInit() == 0 * PSBeginDoc(2, "TestBitmap") * PSSetUnits(APS_TEXT) * PSBitmap(10, 10, 20, 40, "C:\My Pictures\test.jpg") * PSBitmap(30, 10, 50, 50, "C:\My Pictures\Test2.BMP",, .t.) // Keep ratio * PSEndDoc() * ENDIF * * $SEEALSO$ * * $INCLUDE$ * PSTRANS.CH * $END$ */ LOCAL oBMP LOCAL lContinue:=.F. LOCAL aCoord1 // cooridnates in pixels of upper left LOCAL aCoord2 // coordinates in pixels of lower right LOCAL nHeight // height of bitmap LOCAL nWidth // width of bitmap LOCAL nHeightRatio // ratio of page space height to bitmap height LOCAL nWidthRatio // ratio of page space width to bitmap width LOCAL nRequestWidth // width of requested coordinates LOCAL nRequestheight // height of requested coordinates IF lInited * If we need to send out watermark, do so IF lWaterMarkFirst.AND.!lPageActive lPageActive=.T. DoWaterMark() ENDIF IF VALTYPE(lInMemory)!='L' lInMemory=.F. ENDIF IF nTransColor!=NIL nTransColor=TransColor(nTransColor) ENDIF IF VALTYPE(lDeleteFile)!='L' lDeleteFile=.F. ENDIF IF VALTYPE(lKeepRatio)!='L'.OR.(nR2=NIL.and.nC2=NIL) lKeepRatio=.F. ENDIF * First get file - check to make sure it is there IF lInMemory.OR.FILE(cBitMap) * Create bit map object oBMP=WINBMP32():NEW() IF lInMemory oBMP:LoadMemory(cBitMap) lContinue=.T. ELSE lContinue=oBMP:LoadFile(cBitMap) ENDIF ENDIF lPageActive=.T. IF lContinue * Get dimensions oBMP:GetDimensions() aCoord1=PSTransformCoord(nR1,nC1,.F.) IF nR2=NIL.AND.nC2=NIL // no scaling nHeight=oBMP:BitMapHeight nWidth=oBMP:BitMapWidth ELSEIF nR2=NIL // Scale based upon the column value aCoord2=PSTransformCoord(0,nC2,.F.) nWidth=aCoord2[1]-aCoord1[1]+1 nHeight=INT(oBMP:BitMapHeight*(nWidth/oBMP:BitMapWidth)) ELSEIF nC2=NIL //Scale based upon second row value aCoord2=PSTransformCoord(nR2,0,.F.) nHeight=aCoord2[2]-aCoord1[2]+1 nWidth=INT(oBMP:BitMapWidth*(nHeight/oBMP:BitMapHeight)) ELSE // Fit into a box aCoord2=PSTransformCoord(nR2,nC2,.F.) nHeight=aCoord2[2]-aCoord1[2]+1 nWidth=aCoord2[1]-aCoord1[1]+1 ENDIF // IF we need to keep the ratio fixed, find the smalles multilier and // then apply it to the other dimension IF lKeepRatio nHeightRatio=nHeight/oBMP:BitMapHeight nWidthRatio=nWidth/oBMP:BitMapWidth IF nHeightRatio<nWidthRatio nWidth=INT(oBMP:BitMapWidth*nHeightRatio) ELSEIF nWidthRatio<nHeightRatio nHeight=INT(oBMP:BitMapHeight*nWidthRatio) ENDIF ENDIF oBMP:Draw(oPrintJob,{aCoord1[1],aCoord1[2],nWidth,nHeight}, nTransColor) IF lDeleteFile.AND.!lInMemory AADD(aFilesToDelete,cBitMap) ENDIF ENDIF ENDIF RETURN NIL * End of PSBitMap FUNCTION PSEllipse(nR1, nC1, nR2, nC2, nThick, nBColor, nFColor, nPattern) /* $DOC$ * $FUNCNAME$ * PSEllipse * $CATEGORY$ * Printing * $ONELINER$ * Draws an ellipse * $SYNTAX$ * PSEllipse(<nR1>, <nC1>, <nR2>, <nC2>, [<nThick>, <nBColor>, <nFColor>, ; <nPattern>]) * $ARGUMENTS$ * All coordinates are in currently set units. * Colors can be predefined or RGB colors. * * <nR1>, <nC1> Top, left coordinates of the ellipse * * <nR2>, <nC2> Bottom,right coordinates of the ellipse * * <nThick> Thickness of the border in points. Enter 0 for no border. * Defaults to 1 point * * <nBColor> Border color if applicable. You may use one of the predefined * color or a RGB color. If you do not want a border, either enter * 0 for thickness or use the APS_NONE color. * * <nFColor> Fill color if applicable. For an empty ellipse, enter APS_NONE. * * <nPattern> Specify which fill pattern to use. 8 different patterns are * available. * * APS_SOLID 0 Solid * APS_CLEAR 1 Clear (no color / transparent) * APS_BDIAGONAL 2 Backward diagonal * APS_FDIAGONAL 3 Forward diagonal * APS_CROSS 4 Cross * APS_DIAGCROSS 5 Diagonal cross * APS_HORIZONTAL 6 Horizontal * APS_VERTICAL 7 Vertical * * $RETURNS$ * NIL * $DESCRIPTION$ * * Draw an ellipse (or circle if delta Row = delta Col) with the attributes * specified * * * * $EXAMPLES$ * * IF PSInit() = 0 * PSBeginDoc() * ... * PSEllipse(2,2,8,10,5,APS_BLACK,APS_GREEN,APS_SOLID) * PSEndDoc() * ENDIF * * $SEEALSO$ * * $INCLUDE$ * PSTRANS.CH * $END$ */ LOCAL aCoord1 // top left LOCAL aCoord2 // bottom right LOCAL lNoFill LOCAL nMode // background mode LOCAL nSaveColor // saved pen color LOCAL nSaveThick // saved pen thickness LOCAL lNoBorder:=.F. // Empty border LOCAL nSaveStyle // save pen style LOCAL nColor // Save Pen color LOCAL lSaveNull // save null brush setting LOCAL lSaveSolid // save solid brush setting LOCAL SaveBrushStyle // brush style value LOCAL SaveBrushColor // brush color value * If we need to send out watermark, do so IF lInited IF lWaterMarkFirst.AND.!lPageActive lPageActive=.T. DoWaterMark() ENDIF * Default values IF VALTYPE(nThick)!='N' nThick=nDefThick ENDIF IF VALTYPE(nBColor)!='N' IF nThick=0 lNoBorder=.T. ENDIF nBColor=RGB(0,0,0) ELSEIF nBColor=APS_NONE.OR.nThick=0 lNoBorder=.T. ELSE nBColor=TransColor(nBColor) ENDIF IF VALTYPE(nFColor)!='N' nFColor=nFillColor ENDIF lNoFill=(nFColor=APS_NONE) nFColor=TransColor(nFColor) IF VALTYPE(nPattern)!='N' nPattern=nFillPattern ENDIF * Set the pen for the border nSaveThick=oPrintJob:PenWidth nSaveColor=oPrintJob:PenColor nSaveStyle=oPrintJob:PenStyle * Save the current status of the brush and pen mode lSaveNull=oPrintJob:lNullBrush lSaveSolid=oPrintJob:lSolidBrush SaveBrushStyle=oPrintJob:BrushStyle SaveBrushColor=oPrintJob:BrushColor nMode=oPrintJob:BkMode nColor=oPrintJob:GetBkColor() * Split based upon need for a border IF lNoBorder oPrintJob:SetPen(PS_NULL,PointsToLU(nThick),nBColor) ELSE oPrintJob:SetPen(nSaveStyle,PointsToLU(nThick),nBColor) ENDIF IF lNoFill * no filling so we have to set the mode to transparent, color to background * and use a hatch brush oPrintJob:SetBkMode(1) oPrintJob:SetBrush(.F.,HS_BDIAGONAL,nColor,.T.) ELSEIF nPattern=APS_SOLID oPrintJob:SetBkMode(1) oPrintJob:SetBrush(.T.,,nFColor) ELSEIF nPattern=APS_CLEAR oPrintJob:SetBrush(.T.,,0) ELSE DO CASE CASE nPattern=APS_BDIAGONAL nPattern=HS_BDIAGONAL CASE nPattern=APS_FDIAGONAL nPattern=HS_FDIAGONAL CASE nPattern=APS_CROSS nPattern=HS_CROSS CASE nPattern=APS_DIAGCROSS nPattern=HS_DIAGCROSS CASE nPattern=APS_HORIZONTAL nPattern=HS_HORIZONTAL CASE nPattern=APS_VERTICAL nPattern=HS_VERTICAL OTHERWISE nPattern=HS_HORIZONTAL ENDCASE // non-solid patern oPrintJob:SetBrush(.F.,nPattern,nFColor) ENDIF * Draw the ellipse aCoord1:=PSTransformCoord(nR1,nC1,.F.) aCoord2:=PSTransformCoord(nR2,nC2,.F.) oPrintJob:Ellipse(aCoord1[1],aCoord1[2],aCoord2[1],aCoord2[2]) * Reset state nMode=oPrintJob:SetBkMode(nMode) oPrintJob:SetBkColor(nColor) oPrintJob:SetPen(nSaveStyle,nSaveThick,nSaveColor) oPrintJob:SetBrush(lSaveSolid, SaveBrushStyle, SaveBrushColor, lSaveNull) lPageActive=.T. ENDIF RETURN NIL * End of PSEllipse FUNCTION PSFrame(nR1, nC1, nR2, nC2, nThick, nBColor, nFColor, nPattern) /* $DOC$ * $FUNCNAME$ * PSFrame * $CATEGORY$ * Printing * $ONELINER$ * Draws a frame (box) * $SYNTAX$ * PSEllipse(<nR1>, <nC1>, <nR2>, <nC2>, [<nThick>, <nBColor>, <nFColor>,; <nPattern>]) * $ARGUMENTS$ * All coordinates are in currently set units. * Colors can be predefined or RGB colors. * * <nR1>, <nC1> Top, left coordinates of the frame * * <nR2>, <nC2> Bottom,right coordinates of the frame * * <nThick> Thickness of the border in points. Enter 0 for no border. * Defaults to 1 point * * <nBColor> Border color if applicable. You may use one of the predefined * color or a RGB color. If you do not want a border, either * enter 0 for thickness or use the APS_NONE color. * * <nFColor> Fill color if applicable. For an empty ellipse, enter APS_NONE. * * <nPattern> Specify which fill pattern to use. 8 different patterns are * available. * * APS_SOLID 0 Solid * APS_CLEAR 1 Clear (no color / transparent) * APS_BDIAGONAL 2 Backward diagonal * APS_FDIAGONAL 3 Forward diagonal * APS_CROSS 4 Cross * APS_DIAGCROSS 5 Diagonal cross * APS_HORIZONTAL 6 Horizontal * APS_VERTICAL 7 Vertical * * $RETURNS$ * NIL * $DESCRIPTION$ * * Draw a box (retangle) with the attributes specified * * * * $EXAMPLES$ * * IF PSInit() = 0 * PSBeginDoc() * ... * PSFrame(2,2,8,10,5,APS_BLACK,APS_GREEN,APS_SOLID) * PSEndDoc() * ENDIF * * $SEEALSO$ * * $INCLUDE$ * PSTRANS.CH * $END$ */ LOCAL aCoord1 // top left :=PSTransformCoord(nR1,nC1,.F.) LOCAL aCoord2 // bottom right :=PSTransformCoord(nR2,nC2,.F.) LOCAL lNoFill LOCAL nMode // background mode LOCAL nSaveColor // saved pen color LOCAL nSaveThick // saved pen thickness LOCAL lNoBorder:=.F. // Empty border LOCAL nSaveStyle LOCAL nColor IF lInited * If we need to send out watermark, do so IF lWaterMarkFirst.AND.!lPageActive lPageActive=.T. DoWaterMark() ENDIF * Default values IF VALTYPE(nThick)!='N' nThick=nDefThick ENDIF IF VALTYPE(nBColor)!='N' IF nThick=0 lNoBorder=.T. ENDIF nBColor=RGB(0,0,0) ELSEIF nBColor=APS_NONE.OR.nThick=0 lNoBorder=.T. ELSE nBColor=TransColor(nBColor) ENDIF IF VALTYPE(nFColor)!='N' nFColor=nFillColor ENDIF lNoFill=(nFColor=APS_NONE.OR.nPattern=APS_CLEAR) nFColor=TransColor(nFColor) IF VALTYPE(nPattern)!='N' nPattern=nFillPattern ENDIF * Set the pen for the border nSaveThick=oPrintJob:PenWidth nSaveColor=oPrintJob:PenColor nSaveStyle=oPrintJob:PenStyle IF lNoBorder oPrintJob:SetPen(PS_NULL,(nThick),nBColor) ELSE oPrintJob:SetPen(nSaveStyle,PointsToLU(nThick),nBColor) ENDIF IF lNoFill * no filling so we have to set the mode to transparent, color to background * and use a hatch brush nMode=oPrintJob:BkMode nColor=oPrintJob:GetBkColor() oPrintJob:SetBkMode(1) oPrintJob:SetBrush(.F.,HS_BDIAGONAL,nColor,.T.) ELSEIF nPattern=APS_SOLID oPrintJob:SetBkMode(1) oPrintJob:SetBrush(.T.,,nFColor) ELSE DO CASE CASE nPattern=APS_BDIAGONAL nPattern=HS_BDIAGONAL CASE nPattern=APS_FDIAGONAL nPattern=HS_FDIAGONAL CASE nPattern=APS_CROSS nPattern=HS_CROSS CASE nPattern=APS_DIAGCROSS nPattern=HS_DIAGCROSS CASE nPattern=APS_HORIZONTAL nPattern=HS_HORIZONTAL CASE nPattern=APS_VERTICAL nPattern=HS_VERTICAL OTHERWISE nPattern=HS_HORIZONTAL ENDCASE // non-solid patern oPrintJob:SetBrush(.F.,nPattern,nFColor) ENDIF aCoord1:=PSTransformCoord(nR1,nC1,.F.) aCoord2:=PSTransformCoord(nR2,nC2,.F.) oPrintJob:Box(aCoord1[1],aCoord1[2],aCoord2[1],aCoord2[2]) IF lNoFill nMode=oPrintJob:SetBkMode(nMode) ENDIF oPrintJob:SetPen(nSaveStyle,nSaveThick,nSaveColor) lPageActive=.T. ENDIF RETURN NIL * End of PSFrame

by **Antonio Linares** » Thu Apr 11, 2024 6:48 am

(segunda parte)

Code: Select all Expand view RUN: FUNCTION PSSetFill(nColor,nPattern) /* $DOC$ * $FUNCNAME$ * PSSetFill * $CATEGORY$ * Printing * $ONELINER$ * Set the default fill pattern for objects that can be filled * $SYNTAX$ * PSSetFill([<nColor>, <nPattern>]) * $ARGUMENTS$ * nColor - the default fill color * nPattern - the default pattern * $RETURNS$ * aOldValues - previous set of values {nOldColor, nOldPattern} * $DESCRIPTION$ * Colors can be predefined or RGB colors * * Set the default fill parameters for routines such as PSFrame, PSEllipse, PSTextBox * * See these routines for values * * $EXAMPLES$ * * $SEEALSO$ * * $INCLUDE$ * PSTRANS.CH * $END$ */ LOCAL aFill:={nFillColor,nFillPattern} nFillColor=nColor nFillPattern=nPattern RETURN aFill * End of PSSetFill FUNCTION PSSetDecimalSep(cSep) /* $DOC$ * $FUNCNAME$ * PSSetDecimalSep * $CATEGORY$ * PRinting * $ONELINER$ * Set the character used as a decimal point * $SYNTAX$ * PSSetDecimalSep(<cDecimalCharacter>) * $ARGUMENTS$ * cDecimalCharacter - the character to use as a decimal point * $RETURNS$ * cOldDecimalCharacter - the previous value of this setting * $DESCRIPTION$ * * Set the character used to print decimal points when printing on decimal aligned text * * $EXAMPLES$ * * * * * * $SEEALSO$ * * $INCLUDE$ * PSTRANS.CH * $END$ */ LOCAL cOldDecimal:=cDefDecimal cDefDecimal=cSep RETURN cOldDecimal * PSSetDecimalSep FUNCTION PSGetBin(nPrinter) /* $DOC$ * $FUNCNAME$ * PSGetBin * $CATEGORY$ * Printing * $ONELINER$ * Get the current default bin number from the printer driver * $SYNTAX$ * PSGetBin([<nPrinter>]) * $ARGUMENTS$ * <nPrinter> Selected printer - defaults to 0 which is the system default printer * $RETURNS$ * NIL * $DESCRIPTION$ * * Returns the bin number of the selecte (or default) printer from the printer driver (not your job) * * * $EXAMPLES$ * * * * * * $SEEALSO$ * * $INCLUDE$ * PSTRANS.CH * $END$ */ LOCAL oTmpPrint LOCAL nBin * Default printer variable or correct for out of range IF VALTYPE(nPrinter)!='N'.OR.nPrinter>nNumberOfPrinters nPrinter=0 ENDIF * Query the printer IF lInited.AND.nPrinter=nCurPrinter.AND.nPrinter>0 nBin:=oPrintJob:GetBin() ELSE * If it isn't the current printer, set up a job and ask that printer IF aPrinters=NIL PSGetPrinters() ENDIF oTmpPrint:=WinPrn32():New(IIF(nPrinter>0,aPrinters[nPrinter],GetDefaultPrinter())) IF oTmpPrint:Create() nBin:=oTmpPrint:GetBin() oTmpPrint:Destroy() ELSE nBin=0 ENDIF ENDIF RETURN nBin * End of PSGetBin FUNCTION PS_GetBKColor() LOCAL nReturn IF lInited nReturn=oPrintJob:GetBKColor() ENDIF RETURN nReturn * End of PS_GetBKColor /* !!! Text functions */ /* -----------------------------------------------------*/ function PSTextOut(nRow,nCol,xValue,cPicture,nJustify,cFont,nStyle,nPoint,nFColor,nBColor,nAngle,nPitch) /* $DOC$ * $FUNCNAME$ * PSTextOut * $CATEGORY$ * Printing * $ONELINER$ * Print text out * $SYNTAX$ * PSTextOut([<nR>, <nC>], <xValue>, [<cPicture>, <nJustify>, ; * <cFont>, <nStyle>, <nPoint>, <nFColor>, <nBColor>, <nAngle>,; * <nPitch>]) * * $ARGUMENTS$ * * <nR>, <nC> Top/left coordinates of the text, expressed in the * currently set unit. If NIL, then text is printed at * the current cursor position set by the last call to * PSTextOut. * <xValue> Value to print. Any valid Clipper type is valid if you * can use it with @SAY. * <cPicture> Defines the formatting control for printing <xValue>. * Uses Transform function. * <nJustify> Justification of the text relative to <nX, nY>. * <cFont> Use one of the predefined fonts in PSTRANS.CH or a font * name as returned by the PSGetFonts() function. * <nStyle> The font style such as bold, italic. * <nPoint> Give the size of the font in point (1/72nd of an inch) * <nFColor> Text foreground color. * <nBColor> Background color if desired APS_NONE. * <nStyle> The style to apply to the font; like bold, italic... * <nAngle> Text rotation angle, in degrees. 0 = Not rotated * <nPitch> Set a fixed spacing between characters rounded to the * nearest 0.1 characters per inch. * * $RETURNS$ * NIL * $DESCRIPTION$ * * Print text starting at the specified coordinates. * Justification values - see PSSetJustify * Fonts - Can be predefined value from PSTRANS.CH or one from the list * obtained from PSGetFOnts() * Style - can be one of: * * Constant Value Description * APS_PLAIN 0 Plain * APS_BOLD 1 Bold * APS_ITALIC 2 Italic * APS_UNDERLINE 4 UnderLine * APS_STRIKEOUT 8 StrikeOut * APS_BOLDITALIC 3 Bold + Italic * * Point size of text is in points! * Foreground and background colors can be predefined or RGB values. * * $EXAMPLES$ * * PSINIT() * PSBeginDoc(2,'Test') * PSSetUnit(APS_INCH) * PSTextOut(0.5,0.5,'This is printed at 0.5,0.5 from the top corner'; * ,,APS_LEFT) * * $SEEALSO$ * * $INCLUDE$ * PSTRANS.CH * $END$ */ LOCAL cString LOCAL aFontSave LOCAL lFont,lStyle,lPoint,lFColor,lBColor, lAngle LOCAL aCoord LOCAL nWidth LOCAL lPitch LOCAL nSep IF lInited * If we need to send out watermark, do so IF lWaterMarkFirst.AND.!lPageActive lPageActive=.T. DoWaterMark() ENDIF /* Adjust coordinates to pixels */ IF nRow=NIL aCoord := {oPrintJob:PosX,oPrintJob:PosY } ELSE aCoord=PSTransformCoord(nRow,nCol,.T.) ENDIF IF !EMPTY(cPicture).AND.VALTYPE(cPicture)='C' cString=TRANSFORM(xValue,cPicture) IF VALTYPE(xValue)='N'.AND.(nSep:=AT('.',cString))>0 cString=STUFF(cString,nSep,1,cDefDecimal) ENDIF ELSEIF VALTYPE(xValue)='C' cString=xValue ELSEIF VALTYPE(xValue)='L' cString=IIF(xValue,'T','F') ELSEIF VALTYPE(xValue)='N' IF INT(xValue)=xValue cString=LTRIM(STR(xValue,10,0)) ELSE cSTRING=LTRIM(STR(xValue,10,1)) ENDIF ELSEIF VALTYPE(xValue)='D' cString=DTOC(xValue) ELSE cString='' ENDIF * Translate color nFColor=TransColor(nFColor) * If the font has changed then we will change the font otherwise skip lFont:=!EMPTY(cFont).AND.cFont!=oPrintJob:FontName lStyle:=!EMPTY(nStyle).AND.nStyle!=oPrintJob:FontStyle lPoint:=!EMPTY(nPoint).AND.nPoint!=oPrintJob:FontPointSize lFColor:=!EMPTY(nFColor).AND.nFColor!=oPrintJob:TextColor lBColor:=!EMPTY(nBColor).AND.nBColor!=oPrintJob:BKColor lAngle:=!EMPTY(nAngle).AND.nAngle!=oPrintJob:FontAngle lPitch:=!EMPTY(nPitch).AND.nPitch!=oPrintJob:Pitch IF lFont.OR.lStyle.OR.lPoint.OR.lFColor.OR.lBColor.OR.lPitch aFontSave=PSSetFont(IIF(lFont,cFont,oPrintJob:FontName),; IIF(lStyle,nStyle,oPrintJob:FontStyle),; IIF(lPoint,nPoint,oPrintJob:FontPointSize),; IIF(lFColor,nFColor,oPrintJob:TextColor),; IIF(lBColor,nBColor,oPrintJob:BKColor),; IIF(lAngle,nAngle,oPrintJob:FontAngle),; IIF(lPitch,nPitch,oPrintJob:Pitch) ) ENDIF IF VALTYPE(nJustify)!='N' nJustify=nDefJustify ENDIF IF lConvertAscii cString=HB_OEMTOANSI(cString) ENDIF IF nJustify!=APS_DECIMAL.OR.AT(cDefDecimal,cString)=0 * Normal text oPrintJob:TextOutAt(aCoord[1],aCoord[2],cString,.F.,.T.,nJustify) /* IF lSaveUnderline oPrintJob:TextOutAt(aCoord[1],aCoord[2],cString,.F.,.T.,nJustify) ELSE oPrintJob:TextOutAt(aCoord[1],aCoord[2],cString,.F.,.T.,nJustify) ENDIF */ ELSE // align on the decimal point // Get the decimal point width nWidth=oPrintJob:GetTextWidth(cDefDecimal) oPrintJob:TextOutAt(aCoord[1]-0.5*nWidth,aCoord[2],LEFT(cString; ,AT(cDefDecimal,cString)-1),.F.,.F.,1) oPrintJob:TextOutAt(aCoord[1],aCoord[2],cDefDecimal,.F.,.F.,2) oPrintJob:TextOutAt(aCoord[1]+0.5*nWidth,aCoord[2],SUBSTR(cString; ,AT(cDefDecimal,cString)+1),.F.,.F.,0) ENDIF * Reset font if we changed it IF lFont.OR.lStyle.OR.lPoint.OR.lFColor.OR.lBcolor.OR.lAngle.OR.lPitch PSSetFont(aFontSave[1],aFontSave[2],aFontSave[3],aFontSave[4],aFontSave[5],; aFontSave[6],aFontSave[7]) ENDIF lPageActive=.T. ENDIF RETURN NIL * End of PSTextOut FUNCTION PSTextBox(nR1, nC1, nR2, nC2, cText, nJustify, cFont, nStyle, ; nPoint, nFColor, nBColor, nThickness,nPitch) /* $DOC$ * $FUNCNAME$ * PSTextBox * $CATEGORY$ * PRinting * $ONELINER$ * Print text in a box * $SYNTAX$ * PSTextBox(<nR1>, <nC1>, <nR2>, <nC2>, <cText>, [<nJustify>, <cFont>, * <nStyle>, <nPoint>, <nFColor>, <nBColor>, <nThickness>,; * <nPitch>]) * $ARGUMENTS$ * * <nR1>, <nC1>, <nR2>, <nC2> Coordinates of the bounding box, expressed * in the currently set unit. * <cText> Character string to print. * <nJustify> Justification of the text relative to <nRn, nCn>. * <cFont> Fonts selection - see PSGetFonts() function. * <nStyle> The font style such as bold, italic. * <nPoint> Give the size of the font in point (1/72nd of an inch) * <nFColor> Text foreground color. * <nBColor> Background color if desired APS_NONE. * <nThickness> Thickness of a bounding box expressed in points. A value of zero means no border. * <nPitch> Set a fixed spacing between characters rounded to the * nearest 0.1 characters per inch. * $RETURNS$ * NIL * $DESCRIPTION$ * * Print text within a box with automatic word breaking. An optional box * can be drawn around the text. * Justification values - see PSSetJustify * Fonts - Can be predefined value from PSTRANS.CH or one from the list * obtained from PSGetFOnts() * Style - can be one of: * * Constant Value Description * APS_PLAIN 0 Plain * APS_BOLD 1 Bold * APS_ITALIC 2 Italic * APS_UNDERLINE 4 UnderLine * APS_STRIKEOUT 8 StrikeOut * APS_BOLDITALIC 3 Bold + Italic * * Point size of text is in points! * Foreground and background colors can be predefined or RGB values. * Background color fills in the frame * * * $EXAMPLES$ * * * * * * $SEEALSO$ * * $INCLUDE$ * PSTRANS.CH * $END$ */ LOCAL aCoord1 // top left :=PSTransformCoord(nR1, nC1,.F.) LOCAL aCoord2 // bottom right :=PSTransformCoord(nR2, nC2,.F.) LOCAL nSaveAddressMode LOCAL aSaveFont //:=PSSetFont(cFont,nStyle,nPoint,nFColor,nBColor,0,nPitch) LOCAL nSideShift //:=INT(oPrintJob:PixelsPerInchX/36) // 2 point buffer inside LOCAL nTopShift //:=INT(oPrintJob:PixelsPerInchY/36) // frame IF lInited aSaveFont:=PSSetFont(cFont,nStyle,nPoint,nFColor,nBColor,0,nPitch) nSideShift:=INT(oPrintJob:PixelsPerInchX/36) // 2 point buffer inside nTopShift:=INT(oPrintJob:PixelsPerInchY/36) // frame * If we need to send out watermark, do so IF lWaterMarkFirst.AND.!lPageActive lPageActive=.T. DoWaterMark() ENDIF lPageActive=.T. * Frame first aCoord1:=PSTransformCoord(nR1,nC1,.F.) aCoord2:=PSTransformCoord(nR2,nC2,.F.) IF VALTYPE(nThickness)='N'.AND.nThickness>0 PSFrame(nR1, nC1, nR2, nC2,nThickness,nFColor,nBColor,APS_SOLID) ELSEIF VALTYPE(nThickness)!='N' nThickness=0 ENDIF IF VALTYPE(nJustify)!='N' nJustify=nDefJustify ENDIF * Set mode to pixel mode since we are moving things over based upon * a fixed number of pixels nSaveAddressMode=nAddressMode nAddressMode=APS_PIXEL * Send out the text nSideShift+=INT((nThickness/72)*oPrintJob:PixelsPerInchX) nTopShift +=INT((nThickness/72)*oPrintJob:PixelsPerInchY) IF lConvertAscii cText=HB_OEMTOANSI(cText) ENDIF oPrintJob:TextBox(cText,aCoord1[1]+nSideShift,aCoord1[2]+nTopShift,; aCoord2[1]-nSideShift,aCoord2[2]-nTopshift,nJustify) nAddressMode=nSaveAddressMode PSSetFont(aSaveFont[1],aSaveFont[2],aSaveFont[3],aSaveFont[4],aSaveFont[5],; aSaveFont[6],aSaveFont[7]) ENDIF RETURN NIL * End of PSTextBox /* -----------------------------------------------------*/ function PSSetFont(cFont,nStyle,nPoint,nFColor,nBColor,nAngle,nPitch) /* $DOC$ * $FUNCNAME$ * PSSetFont * $CATEGORY$ * Printing * $ONELINER$ * Set the default font for subsequent printing using PSTextOut or PSTextBox * $SYNTAX$ * PSSetFont([<cFont>, <nStyle>, <nPoint>, <nFColor>, <nBColor>, <nPitch>]) * $ARGUMENTS$ * * Colors can be predefined or RGB colors * * <cFont> Font to use. May be either a PageScript font constant, a valid font name * or a font name as returned by the PSGetFonts() function. * <nStyle> Styles includes bold, italic and so on. * <nPoint> Size of the font in points. * <nFColor> Text Foreground color. * <nBColor> Text Background color. * <nPitch> Set a fixed spacing between characters rounded to the * nearest 0.1 characters per inch. * * $RETURNS$ * Array containing the previous values {cOldFont, nOldStyle, nOldPoint, nOldFColor, nOldBColor} * * $DESCRIPTION$ * * Set the font for subsequent printing using one of the text printing functions. * See PSTRANS.CH for defined colors. * Styles can also be found in PSTRANS.CH * * * $EXAMPLES$ * * * * * * $SEEALSO$ * * $INCLUDE$ * PSTRANS.CH * $END$ */ // Added nPitch which sets the absolute pitch to the nearest .1 characters // per inch LOCAL aReturn LOCAL nBold:=FW_NORMAL LOCAL lItalic:=.F. LOCAL lUnderline:=.F. LOCAL lStrikeOut:=.F. IF lInited * return the old values aReturn:={oPrintJob:FontName,oPrintJob:FontStyle,oPrintJob:FontPointSize,; oPrintJob:TextColor,oPrintJob:BkColor,oPrintJob:FontAngle,oPrintJob:Pitch} oPrintJob:FontStyle=nStyle * Default out the input if needed IF VALTYPE(nStyle)!='N' nStyle=0 ENDIF * Decipher the style IF nStyle%2=1 nBold:=FW_BOLD ENDIF IF VALTYPE(nPitch)!='N' nPitch=0 ELSE oPrintJob:Pitch=nPitch ENDIF IF nPitch != 0 nPitch={10,INT(10*nPitch)} ENDIF lItalic:=INT(nStyle/2)%2=1 lUnderLine:=INT(nStyle/4)%2=1 lStrikeOut:=INT(nStyle/8)%2=1 oPrintJob:SetFont(cFont,nPoint,nPitch,nBold,lUnderLine,lItalic,lStrikeOut,,nAngle) oPrintJob:SetColor(TransColor(nFColor),TransColor(nBColor)) lSaveUnderline=lUnderline ELSE * Fake return aReturn={'Currier New',0,10,0,0,0} lSetFont=.T. * Save for setting later aSaveFont={cFont,nStyle,nPoint,nFColor,nBColor,nAngle,nPitch} ENDIF RETURN aReturn * End of PSSetFont FUNCTION PSSetCPI(nCPI) /* $DOC$ * $FUNCNAME$ * PSSetCPI * $CATEGORY$ * Printing * $ONELINER$ * Set the font to given CPI as well as set the number of columns * $SYNTAX$ * PSSetCPI(<nCPI>) * $ARGUMENTS$ * <nCPI> Desired characters per inch * $RETURNS$ * nCols - The number of columns on the current page taking into account * margins that may have been set - NOTE: This * is an extension from PageScript. returns 0 if not inited. * $DESCRIPTION$ * Set the number of characters per inch. The current font is used. If * the font is not a constant width font (such as currier new), then the * average character width is used. The number of columns is set so that * if a constant pitch font is used with the unit of measure set to * APS_TEXT, the addressing mode is correct. * * $EXAMPLES$ * * PSSetFont('Courier New',APS_PLAIN,12) * nCols=PSSetCPI(10) * PSTextOut(1,1,'The number of columns = '+STR(nCols,2,0)) * * $SEEALSO$ * * $INCLUDE$ * PSTRANS.CH, WINGDI.CH * $END$ */ LOCAL nCols:=0 // default if not inited LOCAL nPoint // size of the requested font LOCAL nNewPitch // actual pitch LOCAL nWidth // width of the printing area IF lInited nPoint=GetPoint(nCPI,oPrintJob:FontName,.T.) PSSetFont(oPrintJob:FontName,oPrintJob:FontStyle,nPoint,oPrintJob:TextColor,; oPrintJob:Bkcolor,oPrintJob:FontAngle,nCPI) nNewPitch=oPrintJob:PixelsPerInchX/oPrintJob:GetCharWidth() nWidth=(oPrintJob:PrintWidthPixels-nLeftMargin-nRightMargin); /oPrintJob:PixelsPerInchX nCols=INT(nWidth*nNewPitch) oPrintJob:TextCol:=nCols ENDIF RETURN nCols * End of PSSetCPI FUNCTION PSSetLPI(nLPI) /* $DOC$ * $FUNCNAME$ * PSSetLPI * $CATEGORY$ * Printing * $ONELINER$ * Set the LPI for working with APS_TEXT units * $SYNTAX$ * PSSetLPI(<nLPI>) * $ARGUMENTS$ * <nLPI> Desired lines per inch * $RETURNS$ * nRows - The number of rows on the current page taking into account * margins that may have been set - NOTE: This * is an extension from PageScript. returns 0 if not inited. * $DESCRIPTION$ * Set the number of lines per inch. This routine only really makes * sense when using addressing mode APS_TEXT. Still one can get into * a mess if you call PSSetCPI setting the CPI to 1 (ca 72 point font) * and then set the LPI to 6. * * $EXAMPLES$ * * PSSetFont('Courier New',APS_PLAIN,12) * nRows=PSSetLPI(8) * PSTextOut(1,1,'The number of columns = '+STR(nRows,2,0)) * * $SEEALSO$ * * $INCLUDE$ * PSTRANS.CH, WINGDI.CH * $END$ */ LOCAL nRows:=0 // default if not inited LOCAL nHeight // width of the printing area IF lInited nHeight=(oPrintJob:PrintHeightPixels-nTopMargin-nBottomMargin); /oPrintJob:PixelsPerInchY nRows=INT(nHeight*nLPI) oPrintJob:TextRow:=nRows ENDIF RETURN nRows * End of PSSetCPI ********************************************************************************** function PSGetFonts(nPrinter, lLegacy, lTrueType, lFixedPoint, nCharSet, nFamily) /* $DOC$ * $FUNCNAME$ * PSGetFonts * $CATEGORY$ * Printing * $ONELINER$ * Get a list of available fonts * $SYNTAX$ * PSGetFonts([<nPrinter>, <lLegacy>, <lTrueType>, <lFixedPoint>, ; <nCharSet>, <nFamily>]) * $ARGUMENTS$ * <nPrinter> Printer from which the fonts are requested. * Defaults to the current printer. * <lLegacy> Use legacy mode and return only the font name * Defaults to .T. * <lTrueType> Include only TrueType fonts. Defaults to include all * * <lFixedPoint> Include only fixed pitch fonts. Defaults to .F. * * <nCharSet> Included only those of this character set. Values are * defined in wingdi.ch. Defaults to all. * The current values are: * ANSI_CHARSET * BALTIC_CHARSET * CHINESEBIG5_CHARSET * DEFAULT_CHARSET * EASTEUROPE_CHARSET * GB2312_CHARSET * GREEK_CHARSET * HANGUL_CHARSET * MAC_CHARSET * OEM_CHARSET * RUSSIAN_CHARSET * SHIFTJIS_CHARSET * SYMBOL_CHARSET * TURKISH_CHARSET * VIETNAMESE_CHARSET * Most fonts of interest to US and European users are members * of ANS_CHARSET or EASTEUROPE_CHARSET * * <nFamily> Include only those of the specified family. Defaults to all. * Legal values are included in wingdi.ch and are: * * Value Meaning * FF_DECORATIVE Novelty fonts. Old English is an example. * FF_DONTCARE Use default font. * FF_MODERN Fonts with constant stroke width (monospace), * with or without serifs. Monospace fonts are * usually modern. Pica, Elite, and CourierNew * are examples. * FF_ROMAN Fonts with variable stroke width (proportional) * and with serifs. MS Serif is an example. * FF_SCRIPT Fonts designed to look like handwriting. * Script and Cursive are examples. * FF_SWISS Fonts with variable stroke width (proportional) * and without serifs. MS Sans Serif is an example. * $RETURNS$ * aFont - list of fonts by name. If lLegacy=.F. the array contains * the following elements: * { cFontName, lFixedPoint, lTrueType, nCharSet, nFamily } * * $DESCRIPTION$ * Returns the list of fonts available * $EXAMPLES$ * * aFonts = PSGetFonts() * FOR I = 1 TO LEN(aFonts) * QOUT(aFont[i]) * NEXT * * $SEEALSO$ * * $INCLUDE$ * PSTRANS.CH, WINGDI.CH * $END$ */ LOCAL oTmpPrint LOCAL aFonts LOCAL nLen LOCAL I, J IF VALTYPE(nPrinter)!='N'.OR.nPrinter>nNumberOfPrinters nPrinter=nCurPrinter ENDIF IF VALTYPE(lLegacy)!='L' lLegacy=.T. ENDIF IF lInited.AND.nPrinter=nCurPrinter.AND.nPrinter>0 aFonts:=oPrintJob:GetFonts() ELSE IF aPrinters=NIL PSGetPrinters() ENDIF oTmpPrint:=WinPrn32():New(IIF(nPrinter>0,aPrinters[nPrinter],GetDefaultPrinter())) IF oTmpPrint:Create() aFonts:=oTmpPrint:GetFonts() oTmpPrint:Destroy() ELSE aFonts:={} ENDIF ENDIF * Now remove those that don't fit the criteria * Truetype fonts IF lTrueType!=NIL.AND.VALTYPE(lTrueType)='L'.AND.lTrueType I=1 J=LEN(aFonts) DO WHILE I <= J IF !aFonts[I,3] aFonts=ADEL(aFonts,I) J-- ELSE I++ ENDIF ENDDO aFonts=ASIZE(aFonts,J) ENDIF * Fixed point IF lFixedPoint!=NIL.AND.VALTYPE(lFixedPoint)='L'.AND.lFixedPoint I=1 J=LEN(aFonts) DO WHILE I <= J IF !aFonts[I,2] aFonts=ADEL(aFonts,I) J-- ELSE I++ ENDIF ENDDO aFonts=ASIZE(aFonts,J) ENDIF * Character Set IF nCharSet!=NIL.AND.VALTYPE(nCharSet)='N' I=1 J=LEN(aFonts) DO WHILE I <= J IF aFonts[I,4]!=nCharSet aFonts=ADEL(aFonts,I) J-- ELSE I++ ENDIF ENDDO aFonts=ASIZE(aFonts,J) ENDIF * Family Set IF nFamily!=NIL.AND.VALTYPE(nFamily)='N' I=1 J=LEN(aFonts) DO WHILE I <= J IF aFonts[I,5]!=nFamily aFonts=ADEL(aFonts,I) J-- ELSE I++ ENDIF ENDDO aFonts=ASIZE(aFonts,J) ENDIF nLen:=LEN(aFonts) IF lLegacy FOR I = 1 TO nLen aFonts[I]=aFonts[I,1] NEXT ENDIF RETURN aFonts * End of PSGetFonts FUNCTION PSSetRowCol(nRow,nCol) /* $DOC$ * $FUNCNAME$ * PSSetRowCol * $CATEGORY$ * Printing * $ONELINER$ * Set the Text based coordinate system to the given number of rows and columns * $SYNTAX$ * PSSetRowCol(<nRow>,<nCol>) * $ARGUMENTS$ * <nRow> - the number of rows of text available on the printable portion of the page * <nCol> - the number of columns of text available on the printable portion of the page. * $RETURNS$ * aOldRowCol - array containing previous values: {<nOldRow>, <nOldCol>) * $DESCRIPTION$ * * This routine determines the number of address cells on the page. These cells are used to * determine the starting location for any output when in PS_TEXT mode. Note that text printed using * this method, the coordinates are the start of the string. The routines to NOT attempt to put characters * in each cell. So the results will vary if you are not using a mono-spaced font. * * * $EXAMPLES$ * * * * * * $SEEALSO$ * * $INCLUDE$ * PSTRANS.CH * $END$ */ LOCAL aReturn IF lInited aReturn:={oPrintJob:TextRow,oPrintJob:TextCol} oPrintJob:TextRow=nRow oPrintJob:TextCol=nCol ELSE * Fill in default values when not initialized lSetRowCol=.T. aSaveRowCol={nRow,nCol} aReturn={60,80} ENDIF RETURN aReturn * End of PSSetRowCol FUNCTION PSSetJustify(nJustify) /* $DOC$ * $FUNCNAME$ * PSSetJustify * $CATEGORY$ * Printing * $ONELINER$ * Set the default text justification * $SYNTAX$ * PSSetJustify(nJustify) * $ARGUMENTS$ * nJustify - one of the predifined constants indicating desired justification * $RETURNS$ * NIL * $DESCRIPTION$ * * Set the default value for text justification: * * Constant Value Description * * APS_LEFT 0 Text is left justified * APS_RIGHT 1 Text is right justified * APS_CENTER 2 Text is centered * APS_DECIMAL 3 Text is centered on decimal (numbers with decimal point) * * * $EXAMPLES$ * * * $SEEALSO$ * * $INCLUDE$ * PSTRANS.CH * $END$ */ LOCAL nOldJustify:=nDefJustify IF VALTYPE(nJustify)='N'.AND.(nJustify>=0.AND.nJustify<4) nDefJustify = nJustify ENDIF RETURN nOldJustify /* !!! Printer information/setting functions */ /* -----------------------------------------------------*/ function PSPrnChanged() /* $DOC$ * $FUNCNAME$ * PSPrnChanged * $CATEGORY$ * Printing * $ONELINER$ * Determines if the list of printers or the default printer has changed * $SYNTAX$ * PSPrnChanged() * $ARGUMENTS$ * None * $RETURNS$ * lPrinterChanged * $DESCRIPTION$ * * Determines if the list of printers or the system default printer has changed. * * $EXAMPLES$ * * * * * * $SEEALSO$ * * $INCLUDE$ * PSTRANS.CH * $END$ */ LOCAL lPrintChanged LOCAL I LOCAL nLenOld,nLenNew // length of printer array LOCAL aNewPrinters lPrintChanged:=(GetDefaultPrinter()!=cDefaultPrinter) IF !lPrintChanged aNewPrinters:=GetPrinters() nLenNew=LEN(aNewPrinters) lPrintChanged:=(nLenNew!=nNumberofPrinters) ENDIF I=1 DO WHILE !lPrintChanged.AND.I<nLenOld lPrintChanged:=(ASCAN(aNewPrinters,aPrinters[I])=0) i++ ENDDO RETURN lPrintChanged * End of PSPrnChanged /* -----------------------------------------------------*/ function PSRefreshPrinters() /* Not needed as we aren't communicating with a server */ RETURN NIL /* -----------------------------------------------------*/ function PSGetPrinters() /* $DOC$ * $FUNCNAME$ * PSGetPrinters * $CATEGORY$ * Printing * $ONELINER$ * Return a list of printer names * $SYNTAX$ * PSGetPrinters() * $ARGUMENTS$ * None * $RETURNS$ * aPrinters * $DESCRIPTION$ * * Return an array containing the names of the available printers. * * * $EXAMPLES$ * * * aPrinters=PSGetPrinters() * * FOR I = 1 TO LEN(aPrinters) * QOUT(aPrinters[I]) * NEXT * $SEEALSO$ * * $INCLUDE$ * PSTRANS.CH * $END$ */ * fill in printer array and default printer aPrinters:=GETPRINTERS() cDefaultPrinter:=GetDefaultPrinter() nNumberofPrinters=LEN(aPrinters) RETURN aPrinters * End of PSGetPrinters /* -----------------------------------------------------*/ function PSGetCaps(nPrinter,nOrientation) /* $DOC$ * $FUNCNAME$ * PSGetCaps * $CATEGORY$ * Printing * $ONELINER$ * Get the printer capabilities * $SYNTAX$ * PSGetCaps([<nPrinter>, <nOrientation>]) * $ARGUMENTS$ * * <nPrinter> Must be one of the available printer indexes into the array * obtained by PSGetPrinters(). * This parameter is optionnal: defaults to the system printer. * * <nOrientation> Paper orientation. The capabilities will change depending * on this value. * Defaults to APS_PORTRAIT. Valid values are : APS_PORTRAIT and APS_LANDSCAPE. * * Printer capabilities. Each value corresponds to the array element/index. * * Constant Index Description * APC_PAPERWIDTH 1 Paper width * APC_PAPERHEIGHT 2 Paper height * APC_AREAWIDTH 3 Printable area width * APC_AREAHEIGHT 4 Printable area height * APC_TOPMARGIN 5 Top margin * APC_LEFTMARGIN 6 Left margin * APC_HPIXELS 7 Number of horizontal pixels per inch * APC_VPIXELS 8 Number of vertical pixels per inch * APC_BITSPIXEL 9 Number of bits per pixels. * 1 bit = B & W and bits > 1 = color. * * All printer capabilities values are in pixels. * * $RETURNS$ * aPrinterCapabilites * $DESCRIPTION$ * * Return an array containing the above printer parameters * * * $EXAMPLES$ * * aPrintCaps = PSGetCaps(nPrinter, APS_PORTRAIT) * ALERT('Left Margin = '+STR(aPrintCaps[APC_LEFTMARGIN],3,0)+'Pixels') * * * * $SEEALSO$ * * $INCLUDE$ * PSTRANS.CH * $END$ */ LOCAL oTmpPrinter LOCAL lTmp LOCAL lLandScape LOCAL oTmpPrint LOCAL aReturn LOCAL sDevMode LOCAL nDevModeSize LOCAL sDevNames LOCAL nDevNamesSize LOCAL sSaveDevMode LOCAL nSaveDevModeSize LOCAL lContinue:=.T. * Handle various options for printer IF VALTYPE(nPrinter)!='N'.OR.nPrinter>nNumberOfPrinters nPrinter=0 ENDIF IF nPrinter=0 nPrinter=GetDefaultPrinter() ENDIF * and orientation IF VALTYPE(nOrientation)='N' lLandScape:=(nOrientation=APS_LANDSCAPE) ELSEIF nSaveOrientation>-1 lLandScape:=(nSaveOrientation=APS_LANDSCAPE) ELSE lLandScape=.F. ENDIF IF nPrinter=nCurPrinter.AND.(lLandScape=oPrintJob:LandScape) oTmpPrint:=oPrintJob lTmp=.F. ELSE * IF we are not using the current printer then set up temporary printer * and query IF aPrinters=NIL PSGetPrinters() ENDIF sDevMode= DevMode nDevModeSize = DevModeSize sDevNames = DevNames nDevNamesSize = DevNamesSize sSaveDevMode = SaveDevMode nSaveDevModeSize = SaveDevModeSize oTmpPrint:=WinPrn32():New(IIF(nPrinter>0,aPrinters[nPrinter],GetDefaultPrinter())) oTmpPrint:LandScape:=lLandScape IF oTmpPrint:Create() lTmp=.T. ELSE lContinue=.F. ENDIF DevMode= sDevMode DevModeSize = nDevModeSize DevNames = sDevNames DevNamesSize = nDevNamesSize SaveDevMode = sSaveDevMode SaveDevModeSize = nSaveDevModeSize ENDIF IF lContinue aReturn={oTmpPrint:PageWidthPixels,oTmpPrint:PageHeightPixels,oTmpPrint:PrintWidthPixels,; oTmpPrint:PrintHeightPixels,oTmpPrint:TopMarginPixels,oTmpPrint:LeftMarginPixels,; oTmpPrint:PixelsPerInchX,oTmpPrint:PixelsPerInchY,oTmpPrint:NumColors} ENDIF IF lTmp oTmpPrint:Destroy() ENDIF RETURN aReturn * End of PSGetCaps /* --------------------------------------- */ FUNCTION PSGetDefPrinter /* $DOC$ * $FUNCNAME$ * PSGetDefPrinter * $CATEGORY$ * Printing * $ONELINER$ * Determine the system default printer * $SYNTAX$ * PSGetDefPrinter() * $ARGUMENTS$ * None * $RETURNS$ * nPrinter - The index into the printer array returned by PSGetPrinters() representing the default printer * $DESCRIPTION$ * * Return the printer that has been designated as the system default printer. Index into the array * returned by PSGetPrinters() * * * $EXAMPLES$ * * aPrinters=PSGetPrinters() * ALERT('The default printer is '+aPrinters[PSGetDefPrinter()]) * * * $SEEALSO$ * * $INCLUDE$ * PSTRANS.CH * $END$ */ * Use Harbour's routine RETURN GetDefaultPrinter() * End of PSGetDefPrinter FUNCTION PS_ActualPageSize() /* $DOC$ * $FUNCNAME$ * PS_ActualPageSize * $CATEGORY$ * Printing * $ONELINER$ * Returns the actual page size after the job has been started * $SYNTAX$ * PS_ActualPageSize() -> nPageSize * $ARGUMENTS$ * None * $RETURNS$ * nPageSize - if scalar then it is the Windows constant defining page size. If it is an array, the array contains {Height, Width} * $DESCRIPTION$ * * This routine returns the nominal page size of the job. It is useful * when the user print dialog is used to select the printer since the * page size is determined by the user and not the programmer. Call * this routine after a call to PSBeginDoc(). * * * $EXAMPLES$ * * IF PSBeginDoc(-1,'This is a job',0,1) * * nPageSize = PS_ActualPageSize() * IF nPageSize=DMPAPER_LETTER * aPage={8.5,11.0} * ELSEIF nPageSize=DMPAPER_LEGAL * aPage={11.0,14.0} * ELSE * ... * ENDIF * ENDIF * $SEEALSO$ * * $INCLUDE$ * PSTRANS.CH * $END$ */ /* Returns the actual page size. If it is a scaler, it is the Windows constant defining the page size. If it is an array, then it contains the array {Height,Width} in 1/10s of a millimeter */ RETURN IIF(lInited,oPrintJob:FormType,0) * end of PS_ActualPageSize FUNCTION PS_PrinterNumber() /* $DOC$ * $FUNCNAME$ * PS_PrinterNumber * $CATEGORY$ * Printing * $ONELINER$ * Returns the index of the active printer in the list of printers * $SYNTAX$ * PS_PrinterNumber() * $ARGUMENTS$ * None * $RETURNS$ * nPrinter * $DESCRIPTION$ * * When one calls the Windows printer selection dialog box to let * the user select the printer one needs to know the printer number * since many functions use this number to return parameters. This * routine returns this number. * * $EXAMPLES$ * * PSBeginDoc(-1,'Test print') // uses Windows dialog box * nPrinter=PS_PrinterNumber() * * * $SEEALSO$ * * $INCLUDE$ * PSTRANS.CH * $END$ */ /* Returns the index into the array of printer names of the currently selected printer. Useful when allowing the user to select the printer using the printer dialog. Returns the printer number if found. Returns 0 if no match found. */ LOCAL nLen:=LEN(aPrinters) LOCAL I:=1, nReturn:=0 IF lInited .AND. !EMPTY(oPrintJob:PrinterName) * loop through to find a match DO WHILE I <= nLen IF oPrintJob:PrinterName=aPrinters[I] nReturn=I I=nLen ENDIF I++ ENDDO ENDIF RETURN nReturn * End of PS_PrinterNumber FUNCTION PS_PageMargins(nLeft,nTop,nRight,nBottom,lInches) /* $DOC$ * $FUNCNAME$ * PS_PageMargins * $CATEGORY$ * Printing * $ONELINER$ * Set the page margins for printing in TEXT address mode * $SYNTAX$ * PS_PageMargins(nLeft,nTop,nRight,nBottom,lInch) * $ARGUMENTS$ * nLeft - Left margin * nTop - Top margin * nRight - Right margin * nBottom- bottom margin * lInch - logical, if set to .T. the units are inches, otherwise * the units are millimeters * $RETURNS$ * NIL * $DESCRIPTION$ * * This routine sets the margins for printing when using the TEXT mode * addressing (call to PSSetUnits(APS_TEXT) ). Caution, a call to this * routine does not prevent you from printing outside of the margins by * either printing too many characters or to print with right justification * that send the text over. * * $EXAMPLES$ * * PSSetUnits(APS_TEXT) * PSBeginDoc(1,'Test') * PS_PageMargins(0.5,0.5,0.5,0.5,.T.) // set margins 0.5 inches all around * * $SEEALSO$ * PS_CalcRowCol * $INCLUDE$ * PSTRANS.CH * $END$ */ /* Function to set the margins for TEXT based addressing */ /* Input: nLeft,nTop,nRight,nBottom - margin relative to the edge of the page in units of either inches or millimeters lInches - logical indicating that the distance is in inches otherwise it is in millimeters */ IF lInited IF lInches nLeftMargin=oPrintJob:PixelsPerInchX*nLeft-oPrintJob:LeftMarginPixels nRightMargin=oPrintJob:PixelsPerInchX*nRight-oPrintJob:LeftMarginPixels nTopMargin=oPrintJob:PixelsPerInchY*nTop-oPrintJob:TopMarginPixels nBottomMargin=oPrintJob:PixelsPerInchY*nTop-oPrintJob:TopMarginPixels ELSE nLeftMargin=oPrintJob:PixelsPerMMX*nLeft-oPrintJob:LeftMarginPixels nRightMargin=oPrintJob:PixelsPerMMX*nRight-oPrintJob:RightMarginPixels nTopMargin=oPrintJob:PixelsPerMMY*nTop-oPrintJob:TopMarginPixels nBottomMargin=oPrintJob:PixelsPerMMY*nTop-oPrintJob:BottomMarginPixels ENDIF ELSE aSaveNewMargins:={nLeft,nTop,nRight,nBottom,lInches} ENDIF RETURN NIL * End of PS_PageMargins FUNCTION PS_CalcRowCol(nCPI,nLPI) /* $DOC$ * $FUNCNAME$ * PS_CalcRowCol * $CATEGORY$ * Printing * $ONELINER$ * Calculates the number of rows and columns give the current margins * $SYNTAX$ * PS_CalcRowCol(nCPI,nLPI) * $ARGUMENTS$ * nCPI - the number of characters per inch * nLPI - the number of lines per inch * $RETURNS$ * aRowCol - array containing nCol - the number of columns on the page and nRow - the number of rows * $DESCRIPTION$ * * This rountine calculates the number of rows and columns that will * fit on the page when printing in TEXT address mode given the current * margin settings and the input character and lines per inch * * NOTE: You can only call this routine after you have called PSBegindDoc * * $EXAMPLES$ * * PSSetUnits(APS_TEXT) * PSBeginDoc(1,'Test') * PS_PageMargins(0.5,0.5,0.5,0.5,.T.) // set margins 0.5 inches all around * aRowCol=PS_CalcRowCol(10,6) * PSSetRowCol(aRowCol[1],aRowCol[2]) * * * $SEEALSO$ * PS_PageMargins * $INCLUDE$ * PSTRANS.CH * $END$ */ LOCAL aReturn LOCAL nPageWidth,nPageHeight IF lInited nPageWidth=oPrintJob:PrintWidthPixels-nLeftMargin-nRightMargin nPageHeight=oPrintJob:PrintHeightPixels-nTopMargin-nBottomMargin aReturn:={INT(nLPI*nPageHeight/oPrintJob:PixelsPerInchY),; INT(nCPI*nPageWidth/oPrintJob:PixelsPerInchX)} ELSE aReturn={1,1} ENDIF RETURN aReturn * End of PS_CalcRowCol /* -----------------------------------------------------*/ FUNCTION PSGetPageSize(nPrinter) /* $DOC$ * $FUNCNAME$ * PSGetPageSize * $CATEGORY$ * Printing * $ONELINER$ * Returns the default page size on the printer obtained from the print driver * $SYNTAX$ * PSGetPageSize([<nPrinter>]) * $ARGUMENTS$ * * <nPrinter> Printer from which the fonts are requested. Defaults to the current printer. * * $RETURNS$ * nPaperSize - constant describing page size - obtained from windgi.h * $DESCRIPTION$ * * Returns the windows constant defining the paper size. See Wingdi.h for values * * * $EXAMPLES$ * * PSInit() * PSBeginDoc(-1,'Test run') * nPageSize=PSGetPaperSize() * * $SEEALSO$ * * $INCLUDE$ * PSTRANS.CH * $END$ */ LOCAL oTmpPrint LOCAL nPaper LOCAL nLen LOCAL I * Default out printer if needed IF VALTYPE(nPrinter)!='N'.OR.nPrinter>nNumberOfPrinters nPrinter=nCurPrinter ENDIF IF nPrinter=nCurPrinter.AND.nPrinter>0 nPaper:=oPrintJob:GetDefPaperSize() ELSE * If no job defined or using printer not in use then create temporary job IF aPrinters=NIL PSGetPrinters() ENDIF oTmpPrint:=WinPrn32():New(IIF(nPrinter>0,aPrinters[nPrinter],GetDefaultPrinter())) IF oTmpPrint:Create() nPaper:=oTmpPrint:GetDefPaperSize() oTmpPrint:Destroy() ELSE nPaper=0 ENDIF ENDIF RETURN nPaper * End of PSGetPaperSize /* -----------------------------------------------------*/ function PSSetBin(nBin) /* $DOC$ * $FUNCNAME$ * PSSetBin * $CATEGORY$ * Printing * $ONELINER$ * Sets the bin (including envelopes, etc) used for the current print job * $SYNTAX$ * PSSetBin(<nPaperBin>) * $ARGUMENTS$ * nPaperBin Windows defined constants (see wingdi.h) indicating which bin to use * $RETURNS$ * nNewBin - the new bin number - 0 when not initialized * $DESCRIPTION$ * * Tells the printer driver to set the bin to the selected value. See WinGdi.h for approprate values. * * $EXAMPLES$ * * * * * * $SEEALSO$ * * $INCLUDE$ * PSTRANS.CH * $END$ */ LOCAL nReturn IF lInited nReturn=oPrintJob:SetBin(nBin) lSetBin=.F. ELSE nReturn=0 lSetBin=.T. nSaveBin=nBin ENDIF RETURN nReturn * End of PSSetBin FUNCTION PSSetDuplex(nDuplex) /* $DOC$ * $FUNCNAME$ * PSSetDuplex * $CATEGORY$ * Printing * $ONELINER$ * Set the duplex mode for the print job * $SYNTAX$ * PSSetDuplex(<nDuplexMode>) * $ARGUMENTS$ * nDuplexMode - the windows defined constant used to designate the printing mode * $RETURNS$ * nOldDuplexMode - the previous value * $DESCRIPTION$ * * Set the duplex mode for printing. Legal values are (from wingdi.h): * * Constant Value Description * * DMDUP_SIMPLEX 1 Simplex mode (Default) * DMDUP_VERTICAL 2 Vertical Duplex mode * DMDUP_HORIZONTAL 3 Horizontal Duplex mode * * $EXAMPLES$ * * $SEEALSO$ * * $INCLUDE$ * PSTRANS.CH * $END$ */ LOCAL nReturn IF lInited.AND.nDuplex>0.AND.nDuplex<4 nReturn=oPrintJob:SetDuplexType(nDuplex) ELSE nReturn=0 ENDIF RETURN nReturn * End of PSSetDuplex FUNCTION PSAsciiToAnsi(lConvert) /* $DOC$ * $FUNCNAME$ * PSAsciiToAnsi * $CATEGORY$ * Printing * $ONELINER$ * Sets flag to convert Ascii (OEM) characters to ANSI prior to printing * $SYNTAX$ * PSAsciiToAnsi([lConvert]) * $ARGUMENTS$ * lConvert - logical indicatine desire to do the conversion * $RETURNS$ * lOldConvert - previous setting. Current setting if called without parameter * $DESCRIPTION$ * * High order ASCII characters do not print properly in Windows. This * routine indicates the desire to do the conversion to ANSI characters. * The default behavior is to convert. * * * * $EXAMPLES$ * PSAsciiToAnsi(.F.) // turns off conversion * * $SEEALSO$ * * $INCLUDE$ * PSTRANS.CH * $END$ */ LOCAL lReturn:=lConvertAscii IF VALTYPE(lConvert)='L' lConvertAscii=lConvert ENDIF RETURN lReturn * End of PSAsciiToANSI FUNCTION PSBeginRawDoc(nPrinter,cTitle) /* $DOC$ * $FUNCNAME$ * PSBeginRawDoc * $CATEGORY$ * Printing * $ONELINER$ * Initiate printing of a RAW printer file * $SYNTAX$ * PSBeginDoc([<nPrinter>, <cTitle>, <nOrientation>, <nCopies>]) * $ARGUMENTS$ * <nPrinter> Printer number from the list of available printers, as returned * by the PSGetPrinters() function or pass 0 to select the default * windows printer. If omited, it defaults to zero. Note: This * function does NOT accept a value of -1 to have the Windows Print * Dialog called since if you have already made a RAW printer file, * you already know what printer it is going to. * * <cTitle> Title of the report. This will appear in the spool list. If * none is specified, it defaults to "Untitled". * * <nOrientation> Paper orientation. Legal values: * APS_PORTRAIT 0 Print in portrait mode (Default value) * APS_LANDSCAPE 1 Print in landscape mode * * * <nCopies> The number of copies to print. Defaults to one. * * $RETURNS$ * 0 for success * $DESCRIPTION$ * This routine starts the process of creating a file containing printer specific * escape codes and then printing it on a printer. Call this routine and * then write to the file using either @ x,y SAY, QOUT or QQOUT methods to * print to the file. It is your responsibility to insert the correct codes * and you do need to complete the process with a form feed (EJECT) prior * to finishing the process. * * $EXAMPLES$ * * PSINIT() * PSBeginRawDoc(3,'Test Job') // we know that printer 3 is an Epson * @ 1,5 SAY 'Nice Job' * EJECT * PSEndRawDoc() * $SEEALSO$ * * $INCLUDE$ * PSTRANS.CH * $END$ */ * Get the printer set up IF nNumberofPrinters=0 PSGetPrinters() ENDIF IF nPrinter=NIL.OR.nPrinter<0.OR.nPrinter>nNumberofPrinters nPrinter=0 ENDIF IF nPrinter=0 nCurPrinter=PSGetDefPrinter() ELSE nCurPrinter=nPrinter ENDIF * Save parameters for future use nCurPrinter=nPrinter cRawPrintJob=cTitle cRawFile=TempFile('.\') // Set up printing to a file SET PRINTER TO (cRawFile) SET DEVICE TO PRINTER RETURN NIL * End of PSBeginRawDoc FUNCTION PSEndRawDoc() /* $DOC$ * $FUNCNAME$ * PSEndRawDoc * $CATEGORY$ * Printing * $ONELINER$ * Complete printing of a RAW printer file * $SYNTAX$ * PSBeginDoc() * $ARGUMENTS$ * * None * * $RETURNS$ * NIL * $DESCRIPTION$ * This routine completes the process of creating a file containing printer * specific escape codes and then printing it on a printer. Call PSBeginRawDoc * and then write to the file using either @ x,y SAY, QOUT or QQOUT methods * to print to the file. It is your responsibility to insert the correct codes * and you do need to complete the process with a form feed (EJECT) prior * to finishing the process with a call to this routine. * * $EXAMPLES$ * * PSINIT() * PSBeginRawDoc(3,'Test Job') // we know that printer 3 is an Epson * @ 1,5 SAY 'Nice Job' * EJECT * PSEndRawDoc() * $SEEALSO$ * * $INCLUDE$ * PSTRANS.CH * $END$ */ * Turn off output to file SET PRINTER TO SET DEVICE TO SCREEN * use harbour's routine PrintFileRaw(aPrinters[nCurPrinter],cRawFile,; IIF(cRawPrintJob=NIL,'Untitled',cRawPrintJob)) ERASE(cRawFile) RETURN NIL * End of PSEndRawDoc

by **Antonio Linares** » Thu Apr 11, 2024 6:53 am

(tercera parte)

Code: Select all Expand view RUN: //********************************************************************************************** // modificada por johnson russi FUNCTION PSPrintFile(cFileName, lDelete, nPrinter, cTitle, nOrientation, ; nCopies, cFont, nNroImp, cNroLog, cCodCia,nNroFor, ; nNueTam,FormType,cNomFil ) /* $DOC$ * $FUNCNAME$ * PSPrintfile * $CATEGORY$ * Printing * $ONELINER$ * Prints a file to the selected printer * $SYNTAX$ * PSPrintFile(cFileName, lDelete, nPrinter, cTitle, nOrientation, ; nCopies, cFont) * $ARGUMENTS$ * cFileName - name of the file including path if not in default folder * lDelete - delete the file when done * nPrinter - index into printer array or -1 to use Windows Print Dialog * cTitle - Title of the print job * nOrientation - either APS_PORTRAIT or APS_LANDSCAPE * nCopies - the number of copies * cFont - The desired font * * $RETURNS$ * lSuccess - success status * $DESCRIPTION$ * * This routine will print a file containing control characters to * change such things a bold, underline and italic characters. One * can also change the pitch of the characters and the number of lines * or characters per inch. The codes defines are shown below: * * APC_STARTBOLD Start bold characters * APC_ENDBOLD End bold * APC_STARTITALIC Start Italics * APC_ENDITALIC End Italics * APC_STARTUNDER Start Underline * APC_ENDUNDER End underline * APC_STARTSTRIKE Start strikethrough * APC_ENDSTRIKE End strikethrough * APC_START10CPI Start Pitch =10 * APC_START12CPI Start Pitch =12 * APC_START15CPI Start Pitch =15 * APC_START17CPI Start Pitch =17 * APC_START18CPI Start Pitch =18 * APC_START20CPI Start Pitch =20 * APC_START6LPI Start Lines Per Inch = 6 * APC_START8LPI Start Lines Per Inch = 8 * APC_EJECT Eject page * APC_STARTFONT Start new font * APC_ENDFONT End the name of the font * APC_LANDSCAPE Print next page in landscape mode * APC_PORTRAIT Print next page in portrait mode * * Changes to the lines per inch value are held until the next page is * started. The name of the font starts with APC_STARTFONT and ends * with APC_ENDFONT. The font stays in effect until set by another command. * Be careful since selecting a proportional font may make the pitch * selection problematic. * * $EXAMPLES$ * * PSInit() * PSPrintFile('MyFile.TXT',-1) * * * $SEEALSO$ * * $INCLUDE$ * * $END$ */ /* Extension: if nPrinter = -1 then use windows print dialog to get printer */ /* Returns lSuccess - status of success */ LOCAL lSuccess:=.F. LOCAL cEsc := CHR(27) LOCAL cCurFont LOCAL nCurLPI LOCAL lBold:=.F., lStrike:=.F., lFont:=.F., lUnder:=.F., lItalic:=.F. LOCAL lLandScape:=.F., lPortrait:=.F., lNewOrient:=.F. LOCAL nPoint, nPitch, nLPI LOCAL nHandle, nLine:=0, cLine, lNewLine, lLineActive, nPos, nPosE LOCAl nR, nC, cTest, nScan, nStyle, nMatch, lForcePitch LOCAL nOldPitch, nOldPoint, cOldFont LOCAL aFonts, lPageActive, cTempFont, lPit16 := .F., lPit18 := .F., vVecTam, lPit10 := .F., lOTRO := .F., lPit06:=.F. LOCAL aFuncs LOCAL cNroImp := STR(nNroImp,1) LOCAL nAjuMarLoc := 0 PRIVATE cEscP10 := CHR(27)+"p" PRIVATE cEscWw10 := CHR(27)+"W" PRIVATE cEscw10 := CHR(27)+"w" PRIVATE EPS_ESC_ESC := CHR(27)+CHR(27) // RESET PRIVATE EPS_RESET := CHR(27)+"@" // RESET PRIVATE EPS_INICIA66 := CHR(27)+"C"+CHR(66) //INICIALIZA PRIVATE EPS_INICIA33 := CHR(27)+"C"+CHR(33) //INICIALIZA PRIVATE EPS_DRA_ON := CHR(27)+"x0" PRIVATE EPS_DRA_OF := CHR(27)+"x1" IF nNueTam == NIL nNueTam := 0 ENDIF IF FormType == NIL FormType := 9 ENDIF IF nNroFor == NIL nNroFor := 99999 ENDIF IF nNroFor == 888 nAjuMarLoc := 5 nTamTex := 20 ENDIF IF cNroImp == NIL cNroImp := "1" ENDIF IF cNroImp == "9" // TODAS LAS GRAFICAS aFuncs :={ {APC_STARTBOLD ,{|| lBold:=.T. },{|| lOTRO:=.T.} },; {APC_ENDBOLD ,{|| lBold:=.F. },{|| lOTRO:=.T.} },; {APC_STARTITALIC ,{|| lItalic:=.T. },{|| lOTRO:=.T.} },; {APC_ENDITALIC ,{|| lItalic:=.F. },{|| lOTRO:=.T.} },; {APC_STARTUNDER ,{|| lUnder:=.T. },{|| lOTRO:=.T.} },; {APC_ENDUNDER ,{|| lUnder:=.F. },{|| lOTRO:=.T.} },; {APC_STARTSTRIKE ,{|| lStrike:=.T. },{|| lOTRO:=.T.} },; {APC_ENDSTRIKE ,{|| lStrike:=.F. },{|| lOTRO:=.T.} },; {APC_START10CPI ,{|| nPitch:=10 },{|| lPit10:=.T.}},; {APC_START12CPI ,{|| nPitch:=13 },{|| lPit16:=.T.}},; // OJO NUEVO CONDENSADO // 13 {APC_START15CPI ,{|| nPitch:=13 },{|| lPit18:=.T.}},; // OJO NUEVO MINICONDENSADO {APC_START17CPI ,{|| nPitch:=17 },{|| lOTRO:=.T.} },; {APC_START18CPI ,{|| nPitch:=18 },{|| lOTRO:=.T.} },; {APC_START20CPI ,{|| nPitch:=20 },{|| lOTRO:=.T.} },; {APC_START21CPI ,{|| nPitch:=21 },{|| lOTRO:=.T.} },; {APC_START6LPI ,{|| nPitch:=8 },{|| lPit06:=.T.} },; {APC_START8LPI ,{|| nLPI:=8 },{|| lOTRO:=.T.} },; {APC_EJECT ,{|| .T. },{|| lOTRO:=.T.} },; {APC_STARTFONT ,{|| lFont:=.T. },{|| lOTRO:=.T.} },; {APC_LANDSCAPE ,{|| lLandScape:=.T.},{|| lOTRO:=.T.} },; {APC_PORTRAIT ,{|| lPortrait:=.T. },{|| lOTRO:=.T.} } } ENDIF IF cNroImp == "1" .OR. cNroImp == "2" .OR. cNroImp == "3" // TODAS LAS EPSON PCL O ESC aFuncs :={ {EPS_PICA ,{|| lEpica := .T. },{|| lOTRO := .T.} },; {EPS_ELITE ,{|| lElite := .T. },{|| lOTRO := .T.} },; {EPS_PROPOR_ON ,{|| lPro_On := .T. },{|| lOTRO := .T.} },; {EPS_PROPOR_OF ,{|| lPro_Of := .T. },{|| lOTRO := .T.} },; {EPS_WITH_ON ,{|| nPitch := 8 },{|| lPit06 := .T.} },; {EPS_WITH_OF ,{|| nPitch := 10 },{|| lPit10 := .T.} },; {EPS_HEIGHT_ON ,{|| lHei_On := .T. },{|| lOTRO := .T.} },; {EPS_HEIGHT_OF ,{|| lHei_Of := .T. },{|| lOTRO := .T.} },; {EPS_STARTBOLD ,{|| lBold := .T. },{|| lOTRO := .T.} },; {EPS_ENDBOLD ,{|| lBold := .F. },{|| lOTRO := .T.} },; {EPS_STARTITALIC ,{|| lItalic := .T. },{|| lOTRO := .T.} },; {EPS_ENDITALIC ,{|| lItalic := .F. },{|| lOTRO := .T.} },; {EPS_STARTUNDER ,{|| lUnder := .T. },{|| lOTRO := .T.} },; {EPS_ENDUNDER ,{|| lUnder := .F. },{|| lOTRO := .T.} },; {EPS_STARTSTRIKE ,{|| lStrike := .T. },{|| lOTRO := .T.} },; {EPS_ENDSTRIKE ,{|| lStrike := .F. },{|| lOTRO := .T.} },; {EPS_START10CPI ,{|| nPitch := 10 },{|| lPit10 := .T.} },; {EPS_START12CPI ,{|| nPitch := 13 },{|| lPit16 := .T.} },; // OJO NUEVO CONDENSADO {EPS_START15CPI ,{|| nPitch := 13 },{|| lPit18 := .T.} },; // OJO NUEVO MINICONDENSADO {EPS_START17CPI ,{|| nPitch := 17 },{|| lOTRO := .T.} },; {EPS_START18CPI ,{|| nPitch := 10 },{|| lPit10 := .T.} },; {EPS_START20CPI ,{|| nPitch := 20 },{|| lOTRO := .T.} },; {EPS_START21CPI ,{|| nPitch := 21 },{|| lOTRO := .T.} },; {EPS_START6LPI ,{|| nPitch := 8 },{|| lPit06 := .T.} },; {EPS_START8LPI ,{|| nLPI := 8 },{|| lOTRO := .T.} },; {EPS_EJECT ,{|| .T. },{|| lOTRO := .T.} },; {EPS_EJECT_NEW ,{|| .T. },{|| lOTRO := .T.} },; {EPS_STARTFONT ,{|| lFont := .T. },{|| lOTRO := .T.} },; {EPS_LANDSCAPE ,{|| lLandScape := .T.},{|| lOTRO := .T.} },; {EPS_PORTRAIT ,{|| lPortrait := .T.},{|| lOTRO := .T.} } } ENDIF IF cNroImp == "4" .OR. cNroImp == "5" // TODAS LAS EPSON PCL O ESC ENDIF * Defaults IF VALTYPE(cTitle)!='C' cTitle='Untitled' ENDIF IF VALTYPE(lDelete)!='L' lDelete=.T. ENDIF IF VALTYPE(nCopies)!='N' nCopies=1 ENDIF /* IF VALTYPE(nOrientation) != 'N' .OR. (nOrientation != APS_PORTRAIT .OR. nOrientation != APS_LANDSCAPE) nOrientation=APS_PORTRAIT ENDIF */ IF nOrientation == NIL nOrientation := 0 // VERTICAL ENDIF IF VALTYPE(cFont)!='C' cFont=APS_COURIER ENDIF cCurFont := cFont * Find out if the file exists IF FILE(cFileName) IF !lInited PSINIT() ENDIF lSuccess=.T. * Open the printer IF PSBeginDoc(nPrinter,cTitle,nOrientation,nCopies,FormType,cNomFil)=0 PSSetUnit(APS_TEXT) PSAsciiToAnsi( .T. ) * Set default number of lines and rows - 6 LPI and 10 CPI nOldPoint := GetPoint(10,cCurFont,.T.) // ALERTA("nOldPoint "+STR(nOldPoint)) IF ( M->nAjuAlt > 0 ) // para impresoras graficas con letra grande .. hp k5400 nOldPoint := 9 ENDIF // _PSSetFont(cCurFont,nStyle,nPoint,APS_BLACK,APS_NONE,0,nPitch) nPitch := 10 nPoint := nOldPoint nStyle := APS_PLAIN cOldFont := cCurFont aFonts := oPrintJob:GetFonts() nCurLPI := 6 nLPI := 6 // ALERTA("nOldPoint "+STR(nPoint)) IF M->nAjuAlt == 2 .OR. M->nAjuAlt == 3 .OR. M->nAjuAlt == 4 .OR. M->nAjuAlt == 5 nCurLPI := 12 nLPI := 12 // para impresoras graficas con letra grande .. hp k5400 ENDIF lPageActive := .F. // OJO NUEVO PARA TAMA�O DE PAGINA IF ( M->nAjuAlt == 0 .OR. M->nAjuAlt == 1 .OR. M->nAjuAlt == 2 ) PSSetRowCol(INT(nLPI*oPrintJob:PrintHeightMM/25.4),; INT(nPitch*oPrintJob:PrintWidthMM/25.4)) ELSEIF ( M->nAjuAlt == 3 .OR. M->nAjuAlt == 4 ) PSSetRowCol(INT(nLPI*oPrintJob:PrintHeightMM/48),; //26.4 INT(nPitch*oPrintJob:PrintWidthMM/25.4)) ELSEIF ( M->nAjuAlt == 5 ) PSSetRowCol( 68,; 160) ELSE // NORMAL PSSetRowCol(INT(nLPI*oPrintJob:PrintHeightMM/26.4),; INT(nPitch*oPrintJob:PrintWidthMM/25.4)) ENDIF // nRow := 70 // nCol := 134 * Open file nHandle = HB_FUSE(cFilename) /* IF ALLTRIM(cNroFor) == "15" .OR. ALLTRIM(cNroFor) == "16" IF ALLTRIM(cNroLog) == "1" // LOGO EN ENCABEZADO DE FACTURA POS IF FILE("\ZERUS\IMAGENES\32X32\LOGOFAC"+cCodCia+".BMP") PSBitMap(1,2,3,21,"\ZERUS\IMAGENES\32X32\LOGOFAC"+cCodCia+".BMP") ENDIF ENDIF ENDIF */ IF nHandle>-1 nLine=-1 * Loop through the file DO WHILE !HB_FEOF() cLine := HB_FREADLN() lNewLine := .F. lLineActive := .F. nLine++ IF EMPTY(cLine) lNewLine=.T. ENDIF DO WHILE !lNewLine nPos := AT(cEsc,cLine) // ENCONTRO SECUENCIAS ESC EN LA POS nPos IF cNroImp == "9" nPosE := AT(APC_EJECT,cLine) // ENCONTRO FIN DE PAGIVA EN LA POS nPosE ELSE nPosE := AT(EPS_EJECT,cLine) // ENCONTRO FIN DE PAGIVA EN LA POS nPosE // ESPON MATRIX ENDIF // PARA IMPRESION DE SOLO TEXTO IF ( nPos == 0 .AND. nPosE == 0 ) IF !lLineActive nR := nLine // ojo ajuste margen izquierdo nC := ( nAjuMarLoc + M->nAjuMar * 9 ) ELSE nR := nC := NIL ENDIF //alerta("nPos == 0 .AND. nPosE == 0 " + cLine) PSTextOut(nR,nC,cLine) //,,APS_LEFT,cCurFont,nStyle,nPoint,APS_BLACK) lNewLine=.T. lLineActive=.F. lPageActive=.T. // PARA AVANZE DE PAGIVA ELSEIF IF(cNroImp == "9", cLine[1] == APC_EJECT,cLine[1] == EPS_EJECT ) PSNewPage() lLineActive := .F. lPageActive := .F. cLine := SUBSTR(cLine,2) nLine := IIF(EMPTY(cLine),-1,0) IF nLPI != nCurLPI.OR.lNewOrient IF ( M->nAjuAlt == 0 .OR. M->nAjuAlt == 1 .OR. M->nAjuAlt == 2 ) PSSetRowCol(INT(nLPI*oPrintJob:PrintHeightMM/25.4),; INT(nPitch*oPrintJob:PrintWidthMM/25.4)) ELSEIF ( M->nAjuAlt == 3 .OR. M->nAjuAlt == 4 ) PSSetRowCol(INT(nLPI*oPrintJob:PrintHeightMM/48),; //26.4 INT(nPitch*oPrintJob:PrintWidthMM/25.4)) ELSEIF ( M->nAjuAlt == 5 ) PSSetRowCol( 68,; 160) ELSE // NORMAL PSSetRowCol(INT(nLPI*oPrintJob:PrintHeightMM/26.4),; INT(nPitch*oPrintJob:PrintWidthMM/25.4)) ENDIF //PSSetRowCol(INT(nLPI*oPrintJob:PrintHeightMM/26.4); // ,INT(nPitch*oPrintJob:PrintWidthMM/25.4)) nCurLPI := nLPI ENDIF lNewOrient=.F. * Escape character is first so we have one or more escape codes ELSEIF cLine[1] == cESC * loop through control characters lForcePitch=.F. DO WHILE cLine != NIL .AND. cLine[1] = cEsc /* cTest := LEFT(cLine,2) nScan := ASCAN(aFuncs,{|a| cTest==a[1]}) cLine := SUBSTR(cLine,3) */ cLine := StrTran( cLine, EPS_RESET , "" ) // QUITA EL @ Y EL TAMA�O DE PAGINA cLine := StrTran( cLine, EPS_INICIA66 , "" ) cLine := StrTran( cLine, EPS_INICIA33 , "" ) cLine := StrTran( cLine, EPS_PROPOR_OF , "" ) cLine := StrTran( cLine, EPS_PICA , "" ) cLine := StrTran( cLine, EPS_ELITE , "" ) cLine := StrTran( cLine, EPS_ESC_ESC , "" ) cLine := StrTran( cLine, EPS_DRA_ON , "" ) cLine := StrTran( cLine, EPS_DRA_OF , "" ) nCanPar := 2 cEscPar := LEFT(cLine,2) IF cEscPar == cEscP10 .OR. ; // PARA QUITAR EL TERCER CARACTER --ESC cEscPar == cEscWW10 .OR. ; cEscPar == cEscW10 nCanPar := 3 ENDIF cTest := LEFT(cLine,nCanPar) nScan := ASCAN(aFuncs,{|a| cTest==a[1]}) cLine := SUBSTR(cLine,nCanPar+1) ////// IF nScan > 0 EVAL(aFuncs[nScan,2]) EVAL(aFuncs[nScan,3]) ENDIF IF lFont nPos := AT(APC_ENDFONT,cLine) IF nPos > 0 cTempFont := LEFT(cLine,nPos-1) * Look for a match in the list nMatch := ASCAN(aFonts,{|a| UPPER(a[1])==UPPER(cTempFont)}) IF nMatch > 0 cCurFont := aFonts[nMatch,1] lForcePitch := .T. ENDIF cLine := SUBSTR(cLine,nPos+2) ENDIF lFont := .F. ELSEIF lLandScape PSSetOrientation(APS_LANDSCAPE) lLandScape=.F. lNewOrient=.T. ELSEIF lPortrait PSSetOrientation(APS_PORTRAIT) lPortrait=.F. lNewOrient=.T. ENDIF ENDDO IF (( nNroFor == 888 .OR. nNroFor == 15 .OR. nNroFor == 16 .OR. ; nNroFor == 23 .OR. nNroFor == 142 ) .AND. nNueTam > 0 ) // CASO ESPECIAL sw_style := 1 IF nNueTam <= 20 // SI ES MENOR A 20 --- 10,12.16,18 ... ES QUE ES CALIDAD NEGRILLA TODO nStyle := APS_BOLD ELSE // SI ES MAYOR A 20 --- 100,120.160,180 ... ES QUE ES CALIDAD NORMAL O TEXTO nStyle := APS_PLAIN nNueTam := ( nNueTam / 10 ) // LO DEJA EN FORMATO 10,12,16,18 ENDIF ELSE nStyle := APS_PLAIN sw_style := 0 IF lBold sw_style := 1 nStyle += APS_BOLD ENDIF IF lUnder sw_style := 1 nStyle += APS_UNDERLINE ENDIF IF lItalic sw_style := 1 nStyle += APS_ITALIC ENDIF IF lStrike sw_style := 1 nStyle += APS_STRIKEOUT ENDIF ENDIF nPoint := nOldPoint IF nOldPitch != nPitch .OR. cOldFont != cCurFont .OR. lForcePitch nPoint=GetPoint(nPitch,cCurFont,.T.) nOldPitch=nPitch //ALERTA(" cCurFont GetPoint "+STR(nPoint)+" "+cCurFont) ENDIF cOldFont=cCurFont // ojo 26.4 por 25.4 IF nLPI != nCurLPI .AND. !lPageActive IF ( M->nAjuAlt == 0 .OR. M->nAjuAlt == 1 .OR. M->nAjuAlt == 2 ) PSSetRowCol(INT(nLPI*oPrintJob:PrintHeightMM/25.4),; INT(nPitch*oPrintJob:PrintWidthMM/25.4)) ELSEIF ( M->nAjuAlt == 3 .OR. M->nAjuAlt == 4 ) PSSetRowCol(INT(nLPI*oPrintJob:PrintHeightMM/48),; //26.4 INT(nPitch*oPrintJob:PrintWidthMM/25.4)) ELSEIF ( M->nAjuAlt == 5 ) PSSetRowCol( 68,; 160) ELSE // NORMAL PSSetRowCol(INT(nLPI*oPrintJob:PrintHeightMM/26.4),; INT(nPitch*oPrintJob:PrintWidthMM/25.4)) ENDIF //PSSetRowCol(INT(nLPI*oPrintJob:PrintHeightMM/26.4); // ,INT(nPitch*oPrintJob:PrintWidthMM/25.4)) nCurLPI := nLPI ENDIF IF (( nNroFor == 888 .OR. nNroFor == 15 .OR. nNroFor == 16 .OR. nNroFor == 23 .OR. nNroFor == 142 ) .AND. nNueTam > 0 ) DO CASE CASE nNueTam == 8 vVecTam := {10,INT((8)*nPitch)} // SEMI GRANDE-NORMAL IF ( M->nAjuAlt > 0 ) nPoint := 8 ENDIF CASE nNueTam == 10 vVecTam := {10.2,INT((11)*nPitch)} // NORMAL IF ( M->nAjuAlt > 0 ) nPoint := 9 ENDIF CASE nNueTam == 12 vVecTam := {10.6,INT((13)*nPitch)} // normal ..peque�a ???? IF ( M->nAjuAlt > 0 ) nPoint := 10 ENDIF CASE nNueTam == 16 vVecTam := {11,INT((16)*nPitch)} // condensado 136 col IF ( M->nAjuAlt > 0 ) nPoint := 11 ENDIF CASE nNueTam == 18 vVecTam := {11,INT((18)*nPitch)} // minicondensado 160 col IF ( M->nAjuAlt > 0 ) nPoint := 11 ENDIF CASE nNueTam == 20 IF nNroFor == 888 nPitch := 12 ENDIF vVecTam := {11,INT((nTamTex)*nPitch)} //fijo IF ( M->nAjuAlt > 0 ) nPoint := 11 ENDIF ENDCASE //ALERTA(" 1er case "+STR(nPoint)) ELSE IF sw_style <= 1 //== 0 // SI CAMBIA ESTILO DEJA EL MISMO TAMA�O IF lPit06 // 7 vVecTam := {10.2,INT((09)*nPitch)} // letra grande IF ( M->nAjuAlt > 1 ) // para impresoras graficas con letra grande .. hp k5400 IF M->nAjuAlt == 4 nPoint := 9 ELSE nPoint := nPoint /2 ENDIF ENDIF ENDIF IF lPit10 // 9 vVecTam := {10.2,INT((11)*nPitch)} // NORMAL IF ( M->nAjuAlt > 1 ) nPoint := 9 ENDIF ENDIF IF lPit16 // 11 vVecTam := {11,INT((16)*nPitch)} // condensado 136 col IF ( M->nAjuAlt > 1 ) nPoint := 11 ENDIF ENDIF IF lPit18 // 11 vVecTam := {11,INT((18)*nPitch)} // minicondensado 160 col IF ( M->nAjuAlt > 1 ) nPoint := 11 ENDIF ENDIF ENDIF //ALERTA(" sw_style "+STR(nPoint)) ENDIF //ALERTA(cLine+ " = " + STR( nPoint) ) _PSSetFont(cCurFont,nStyle,nPoint,APS_BLACK,APS_NONE,0,nPitch,vVecTam) vVecTam := NIL nPitch := nOldPitch lPit10 := lPit16 := lPit18 := lPit06 := .F. // Control character in play so print up to it ELSEIF nPos > 0 .OR. nPosE > 0 IF ( nPosE = 0 .OR. ( nPos > 0 .AND. nPos < nPosE ) ) nPosE := nPos ENDIF IF lLineActive nR := nC := NIL ELSE nR := nLine nC := ( nAjuMarLoc + M->nAjuMar * 9 ) ENDIF //alerta("PSTextOut " + LEFT(cLine,nPosE-1)) PSTextOut(nR,nC ,LEFT(cLine,nPosE-1)) //,,APS_LEFT,cCurFont,nStyle,nPoint,APS_BLACK) lLineActive := .T. cLine := SUBSTR(cLine,nPosE) ENDIF IF EMPTY(cLine) lLineActive = .F. ENDIF ENDDO HB_FSKIP() lNewLine=.F. ENDDO HB_FUSE() ELSE lSuccess=.F. ENDIF PSEndDoc() ENDIF IF lDelete DELETE FILE (cFileName) ENDIF ENDIF RETURN lSuccess //********************************************************************************* //STATIC FUNCTION GetPoint(nPitch,cFont,lExact) FUNCTION GetPoint(nPitch,cFont,lExact) /* Input: nPitch - desired pitch cFont - Desired font Returns: nPoint - point size of font */ * Loop through fonts to find the one that best fits LOCAL aSaveFont LOCAL aFontSizes:={72,48,36,26,24,22,20,18,16,14,12,11,10,9,8,7,6,5} LOCAL nNewPitch, nNewestPitch LOCAL nReturn := 72 LOCAL I, nLen, nReturn1, savepitch IF VALTYPE(lExact)!='L' lExact=.F. ENDIF aSaveFont:={oPrintJob:FontName,oPrintJob:FontStyle,oPrintJob:FontPointSize,; oPrintJob:TextColor,oPrintJob:BkColor,oPrintJob:FontAngle,oPrintJob:Pitch} *aSaveFont:=PSSetFont(cFont,APS_PLAIN,72,,,0) //,0) * Set initial guess oPrintJob:SetFont(cFont,72,0) I=1 * Go through list of fonts nLen=LEN(aFontSizes) * Get the intial pitch //alerta(str( oPrintJob:PixelsPerInchX) +" - "+str(oPrintJob:CharWidth)) nNewPitch=oPrintJob:PixelsPerInchX/oPrintJob:CharWidth * Will round to the nearest 0.1 CPI nPitch=INT(10*nPitch) DO WHILE INT(10*nNewPitch)<nPitch.AND.I<=nLen oPrintJob:SetFont(cFont,aFontSizes[I],0) nNewPitch=oPrintJob:PixelsPerInchX/oPrintJob:CharWidth I++ ENDDO I-- IF !lExact.OR.I=1.OR.nPitch=INT(10*nNewPitch) IF I<=nLen.AND.I>0 nReturn=aFontSizes[I] //alerta(" !lExact.OR.I=1.OR.nPitch=INT(10*nNewPitch) "+str(nReturn)) ENDIF ELSEIF I>1 * Interprelate // alerta(oPrintJob:GetCharWidth()) nPitch=nPitch/10 oPrintJob:SetFont(cFont,aFontSizes[I-1],0) nNewestPitch=oPrintJob:PixelsPerInchX/oPrintJob:GetCharWidth() * ratio of distance between fonts nReturn1=(nPitch-nNewPitch)/(nNewestPitch-nNewPitch) * New pitch nReturn=aFontSizes[I]+((aFontSizes[I-1]-aFontSizes[I])*nReturn1) * Round to the nearest 0.5 point - works in MS Word nReturn=(5*INT((10*nReturn)/5))/10 // alerta(" Round "+str(nReturn)) ENDIF PSSetFont(aSaveFont[1],aSaveFont[2],aSaveFont[3],aSaveFont[4],aSaveFont[5],; aSaveFont[6],aSaveFont[7]) RETURN nReturn * End of GetPoint /* !!! Unneeded or unimplimented functions */ function PSShutdown() RETURN NIL ////////////////////////////////////////////////////////////////////////// FUNCTION PSBarCode() oPrintJob:SetFont('Barcode Font', 28, 0 ) oPrintJob:TextOut(" *6920897718380* " ) //ALERT(PROCNAME()+' Called',{'Continue'}) RETURN NIL FUNCTION PSSendMail //ALERT( 'PS Mail called - not impimented' ) RETURN NIL FUNCTION PSSetTimeSlice RETURN NIL FUNCTION PSShowIcon RETURN NIL FUNCTION PSVersion RETURN '0.94.0'

by **Antonio Linares** » Thu Apr 11, 2024 6:54 am

(cuarta parte)

Code: Select all Expand view RUN: // Modified version of WIN32PRN /* * $Id: WINPRN32.prg,v 1.20 2006/01/15 20:29:02 peterrees Exp $ */ /* * Harbour Project source code: * Printing subsystem for Win32 using GUI printing * Copyright 2004 Peter Rees <peter@rees.co.nz> * Rees Software & Systems Ltd * * See doc/license.txt for licensing terms. * * www - http://www.harbour-project.org * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2, or (at your option ) * any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this software; see the file COPYING. If not, write to * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/ ). * * As a special exception, the Harbour Project gives permission for * additional uses of the text contained in its release of Harbour. * * The exception is that, if you link the Harbour libraries with other * files to produce an executable, this does not by itself cause the * resulting executable to be covered by the GNU General Public License. * Your use of that executable is in no way restricted on account of * linking the Harbour library code into it. * * This exception does not however invalidate any other reasons why * the executable file might be covered by the GNU General Public License. * * This exception applies only to the code released by the Harbour * Project under the name Harbour. If you copy code from other * Harbour Project or Free Software Foundation releases into a copy of * Harbour, as the General Public License permits, the exception does * not apply to the code that you add in this way. To avoid misleading * anyone as to the status of such modified files, you must delete * this exception notice from them. * * If you write modifications of your own for Harbour, it is your choice * whether to permit this exception to apply to your modifications. * If you do not wish that, delete this exception notice. */ /* TPRINT() was designed to make it easy to emulate Clipper Dot Matrix printing. Dot Matrix printing was in CPI ( Characters per inch & Lines per inch ). Even though "Mapping Mode" for TPRINT() is MM_TEXT, ::SetFont() accepts the nWidth parameter in CPI not Pixels. Also the default ::LineHeight is for 6 lines per inch so ::NewLine() works as per "LineFeed" on Dot Matrix printers. If you do not like this then inherit from the class and override anything you want Simple example TO DO: Colour printing etc.... Peter Rees 21 January 2004 <peter@rees.co.nz> */ #ifndef __PLATFORM__Windows Function WINPRN32() Return nil #else #include "hbclass.ch" #include "common.ch" #include "wingdi.ch" /* // Cut from wingdi.h #define MM_TEXT 1 #define MM_LOMETRIC 2 #define MM_HIMETRIC 3 #define MM_LOENGLISH 4 #define MM_HIENGLISH 5 // Device Parameters for GetDeviceCaps() #define HORZSIZE 4 // Horizontal size in millimeters #define VERTSIZE 6 // Vertical size in millimeters #define HORZRES 8 // Horizontal width in pixels #define VERTRES 10 // Vertical height in pixels #define NUMBRUSHES 16 // Number of brushes the device has #define NUMPENS 18 // Number of pens the device has #define NUMFONTS 22 // Number of fonts the device has #define NUMCOLORS 24 // Number of colors the device supports #define RASTERCAPS 38 // Bitblt capabilities #define LOGPIXELSX 88 // Logical pixels/inch in X #define LOGPIXELSY 90 // Logical pixels/inch in Y #define PHYSICALWIDTH 110 // Physical Width in device units #define PHYSICALHEIGHT 111 // Physical Height in device units #define PHYSICALOFFSETX 112 // Physical Printable Area x margin #define PHYSICALOFFSETY 113 // Physical Printable Area y margin #define SCALINGFACTORX 114 // Scaling factor x #define SCALINGFACTORY 115 // Scaling factor y */ #define MM_TO_INCH 25.4 #define _PORIENT 1 #define _PSIZE 2 #define _PWIDTH 3 #define _PLENGTH 4 #define _PYRES 5 #define _PXRES 6 CLASS WINPRN32 METHOD New(cPrinter,nForTyp) METHOD Create(nMapMode) // CreatesDC and sets "Courier New" font, set Orientation, Copies, Bin# // Create() ( & StartDoc() ) must be called before printing can start. METHOD Destroy() // Calls EndDoc() - restores default font, Deletes DC. // Destroy() must be called to avoid memory leaks METHOD StartDoc(cDocame) // Calls StartPage() METHOD EndDoc(lAbortDoc) // Calls EndPage() if lAbortDoc not .T. METHOD StartPage() METHOD EndPage(lFinished) // If lFinished = .F. then StartPage() is called for the next page of output * METHOD NewLine() METHOD NewPage() METHOD SetFont(cFontName, nPointSize, nWidth, nBold, lUnderline, lItalic, lStrike, nCharSet, nAngle) // NB: nWidth is in "CharactersPerInch" // _OR_ { nMul, nDiv } which equates to "CharactersPerInch" // _OR_ ZERO ( 0 ) which uses the default width of the font // for the nPointSize // IF nWidth (or nDiv) is < 0 then Fixed font is emulated METHOD SetDefaultFont() METHOD GetFonts() // Returns array of { "FontName", lFixed, lTrueType, nCharSetRequired } METHOD Bold(nBoldWeight) METHOD UnderLine(lOn) METHOD Italic(lOn) METHOD SetDuplexType(nDuplexType) // Get/Set current Duplexmode METHOD SetPrintQuality(nPrintQuality) // Get/Set Printquality METHOD CharSet(nCharSet) METHOD SetPos(nX, nY) // **WARNING** : (Col,Row) _NOT_ (Row,Col) METHOD SetColor(nClrText, nClrPane, nAlign) INLINE (; ::TextColor:=nClrText, ::BkColor:=nClrPane, ::TextAlign:=nAlign,; SetColor( ::hPrinterDC, nClrText, nClrPane, nAlign) ) METHOD TextOut(cString, lNewLine, lUpdatePosX, nAlign) // nAlign : 0 = left, 1 = right, 2 = centered METHOD TextOutAt(nPosX,nPosY, cString, lNewLine, lUpdatePosX, nAlign) // **WARNING** : (Col,Row) _NOT_ (Row,Col) METHOD TextBox(cString,nLeft, nTop, nRight, nBottom, cAlign) // align same as text out METHOD SetPen(nStyle, nWidth, nColor) METHOD SetBrush(lSolid,nStyle,nColor,lNull) // brush for filling in polygons METHOD Line(nX1, nY1, nX2, nY2) INLINE LineTo(::hPrinterDC, nX1, nY1, nX2, nY2) METHOD Box(nX1, nY1, nX2, nY2, nWidth, nHeight) INLINE Rectangle(::hPrinterDC, nX1, nY1, nX2, nY2, nWidth, nHeight) METHOD Arc(nX1, nY1, nX2, nY2) INLINE Arc(::hPrinterDC, nX1, nY1, nX2, nY2) METHOD Ellipse(nX1, nY1, nX2, nY2) INLINE Ellipse(::hPrinterDC, nX1, nY1, nX2, nY2) METHOD FillRect(nX1, nY1, nX2, nY2, nColor) INLINE FillRect(::hPrinterDC, nX1, nY1, nX2, nY2, nColor) METHOD GetCharWidth() METHOD GetCharHeight() METHOD GetTextWidth(cString) METHOD GetTextHeight(cString) METHOD DrawBitMap(oBmp, nTransparent) METHOD GetBkColor() // returns the DC background color METHOD SetBkColor(nColor) // sets the DC background color METHOD GetBin() // get default printer bin METHOD SetBin(nBin) // Set the bin number METHOD GetDefPaperSize() // get default printer page size METHOD SaveCaps() // Clipper DOS compatible functions. * METHOD SetPrc(nRow, nCol) // Based on ::LineHeight and current ::CharWidth * METHOD PRow() * METHOD PCol() * METHOD MaxRow() // Based on ::LineHeight & Form dimensions * METHOD MaxCol() // Based on ::CharWidth & Form dimensions * METHOD MM_TO_POSX( nMm ) // Convert position on page from MM to pixel location Column * METHOD MM_TO_POSY( nMm ) // " " " " " " " " " Row * METHOD INCH_TO_POSX( nInch ) // Convert position on page from INCH to pixel location Column * METHOD INCH_TO_POSY( nInch ) // " " " " " " " " " Row METHOD TextAtFont( nPosX, nPosY, cString, cFont, nPointSize,; // Print text string at location nWidth, nBold, lUnderLine, lItalic, lStrike, lNewLine,; // in specified font and color. lUpdatePosX, nColor, nAlign ) // Restore original font and colour // after printing. METHOD SetBkMode( nMode ) INLINE (; ::BkMode:=nMode, SetBkMode( ::hPrinterDc, nMode )) // OPAQUE= 2 or TRANSPARENT= 1 METHOD SetPageSize( nPageSize ) // change the nPaperSize - predefined or an array containing // {paperheight,paperwidth} in units of 0.1 mm // Set Background mode VAR PrinterName INIT "" VAR Printing INIT .F. VAR HavePrinted INIT .F. VAR hPrinterDc INIT 0 VAR UsePrintDialog INIT .F. // These next 4 variables must be set before calling ::Create() if // you wish to alter the defaults VAR FormType INIT 0 VAR BinNumber INIT 0 VAR Landscape INIT .F. VAR Copies INIT 1 VAR CustomHeight INIT 0 // user requested custom height VAR CustomWidth INIT 0 // user requested custom width VAR RequestedCopies INIT 1 // copies the program must produce VAR SetFontOk INIT .F. VAR FontName INIT "" // Current Point size for font VAR FontPointSize INIT 12 // Point size for font VAR FontWidth INIT {0,0} // {Mul, Div} Calc width: nWidth:= MulDiv(nMul, GetDeviceCaps(shDC,LOGPIXELSX), nDiv) // If font width is specified it is in "characters per inch" to emulate DotMatrix VAR Pitch INIT 0 VAR fBold INIT 0 HIDDEN // font darkness weight ( Bold). See wingdi.h or WIN SDK CreateFont() for valid values VAR fUnderLine INIT .F. HIDDEN // UnderLine is on or off VAR fItalic INIT .F. HIDDEN // Italic is on or off VAR StrikeThrough INIT .F. HIDDEN VAR fCharSet INIT 1 HIDDEN // Default character set == DEFAULT_CHARSET ( see wingdi.h ) VAR FontAngle INIT 0 // text angle VAR PixelsPerInchY VAR PixelsPerInchX VAR PageHeightPixels INIT 0 VAR PageWidthPixels INIT 0 VAR TopMarginPixels INIT 0 VAR BottomMarginPixels INIT 0 VAR LeftMarginPixels INIT 0 VAR RightMarginPixels INIT 0 VAR PrintWidthPixels INIT 0 VAR PrintHeightPixels INIT 0 VAR PageWidthMM INIT 0 VAR PageHeightMM INIT 0 VAR LeftMarginMM INIT 0 VAR RightMarginMM INIT 0 VAR TopMarginMM INIT 0 VAR BottomMarginMM INIT 0 VAR PrintWidthMM INIT 0 VAR PrintHeightMM INIT 0 VAR LineHeight INIT 0 VAR CharHeight INIT 0 VAR CharWidth INIT 0 VAR fCharWidth INIT 0 HIDDEN VAR BitmapsOk INIT .F. VAR NumColors INIT 1 VAR fDuplexType INIT 1 HIDDEN //DMDUP_SIMPLEX VAR fPrintQuality INIT -4 HIDDEN //DMRES_HIGH VAR fNewDuplexType INIT 1 HIDDEN VAR fNewPrintQuality INIT -4 HIDDEN VAR fOldLandScape INIT .F. HIDDEN VAR fOldBinNumber INIT 0 HIDDEN VAR fOldFormType INIT 0 HIDDEN VAR PosX INIT 0 VAR PosY INIT 0 VAR TextColor VAR BkColor VAR TextAlign VAR BkMode INIT 2 // opaque is the default VAR PenStyle INIT PS_SOLID VAR PenWidth INIT 1 VAR PenColor INIT 0 VAR TextCol VAR TextRow VAR FontStyle VAR PixelsPerMMX VAR PixelsPerMMY VAR lSolidBrush INIT .T. HIDDEN // solid brush to start out VAR BrushStyle INIT -1 HIDDEN // illegal value to force initial setting VAR BrushColor INIT 0 HIDDEN // brush color VAR lNullBrush INIT .F. HIDDEN // null - transparent - brush VAR hWindowHnd INIT 0 // handle to window call print routines * VAR sDevmodeSmall // DevMode structure without the device specific stuff // since that returned by the driver is of arbitrary size VAR SelectedOrientation // User selected orientation VAR SelectedForm // Form selected by user VAR PaperWidth // Paper width in inches VAR PaperLength // Paper length in inches VAR UsefulItems // useful items from DevMode since I can't seem to get structures // to work without crashing ENDCLASS METHOD New(xPrinter,nForTyp) CLASS WINPRN32 IF VALTYPE(xPrinter)='N'.AND.xPrinter=-1 ::UsePrintDialog:=.T. ::PrinterName=' ' ELSE ::UsePrintDialog:=.F. ::PrinterName := IIF(!EMPTY(xPrinter), xPrinter, GetDefaultPrinter()) ENDIF IF nForTyp <> NIL ::FormType := nForTyp ENDIF RETURN(Self) METHOD Create(nMapMode) CLASS WINPRN32 LOCAL Result:= .F. LOCAL aPrintData LOCAL nCopies LOCAL cCurrentDrv // current disk drive LOCAL cCurrentDir // current directory ::Destroy() // Finish current print job if any ::hWindowHnd=GetWindowHandle() nCopies=::Copies IF ::UsePrintDialog /* We are going to save the current drive and directory since some print drivers that produce files - Microsoft Office Document Image Writer being one - uses the standard Windows file selection dialog. The file selection dialog changes the default directory and these drivers do not reset it to the original. - Editorial: this is bad form. */ cCurrentDrv=CURDRIVE() cCurrentDir=CURDIR() aPrintData=PrintDialog(::hWindowHnd,SaveDevMode, SaveDevModeSize, DevNames, ; DevNamesSize,@nCopies) * Return to previous default location DISKCHANGE(cCurrentDrv) DIRCHANGE("\"+cCurrentDir) IF aPrintData=NIL ::hPrinterDC=NIL ELSE ::hPrinterDC=aPrintData[1] ::FormType=aPrintData[3] ::PrinterName=aPrintData[2] SaveDevMode:=DevMode:=aPrintData[4] SaveDevModeSize:=DevModeSize:=aPrintData[5] DevNames=aPrintData[6] DevNamesSize=aPrintData[7] ::RequestedCopies:=nCopies DevMode=SetDocumentProperties(::hWindowHnd,::hPrinterDC, ::PrinterName, @DevMode, DevModeSize, ; ::FormType, ::Landscape, , ::BinNumber, ::fDuplexType, ; ::fPrintQuality) ENDIF ELSE IF !EMPTY(::hPrinterDC := CreateDC(::PrinterName, ::Copies, @DevMode, @DevModeSize)) DevMode=SetDocumentProperties(::hWindowHnd,::hPrinterDC, ::PrinterName, DevMode, DevModeSize, ; ::FormType, ::Landscape, ::Copies, ::BinNumber, ::fDuplexType, ; ::fPrintQuality) ENDIF ENDIF IF !EMPTY(::hPrinterDC) // Set Form Type // Set Number of Copies // Set Orientation // Set Duplex mode // Set PrintQuality /* SetDocumentProperties(::hWindowHnd,::hPrinterDC, ::PrinterName, @DevMode, DevModeSize, ; ::FormType, ::Landscape, ::Copies, ::BinNumber, ::fDuplexType, ; ::fPrintQuality) */ // Set mapping mode to pixels, topleft down IF VALTYPE(nMapMode)='N' SetMapMode(::hPrinterDC,nMapMode) ELSE SetMapMode(::hPrinterDC,MM_TEXT) ENDIF ::UsefulItems=ExtractFromDevmode(DevMode) ::SaveCaps() // Set the standard font ::SetDefaultFont() ::HavePrinted:= ::Printing:= .F. ::fOldFormType:= ::FormType // Last formtype used ::fOldLandScape:= ::LandScape ::fOldBinNumber:= ::BinNumber Result:= .T. // Set the default pen and brush self:SetPen(::PenStyle,::PenWidth,::PenColor) self:SetBrush(::lSolidBrush,::BrushStyle,::BrushColor,::lNullBrush) ENDIF RETURN(Result) METHOD SaveCaps() CLASS WINPRN32 * Function to query printer for document and printer properties // Get Margins etc... here * ::sDevModeSmall=Move2DevMode() * Move2DevMode() ::SelectedOrientation := ::UsefulItems[_PORIENT] // sDevModeSmall:dmOrientation ::SelectedForm := ::UsefulItems[_PSIZE] //sDevModeSmall:dmPaperSize * Get paper size - two ways because all drivers don't behave well ::PaperWidth := ::UsefulItems[_PWIDTH]/254. //sDevModeSmall:dmPaperWidth/254. IF ::PaperWidth<=0 ::PaperWidth := GetDeviceCaps(::hPrinterDC,HORZSIZE)/25.4 ENDIF ::PaperLength := ::UsefulItems[_PLENGTH]/254. //sDevModeSmall:dmPaperLength/254. IF ::PaperLength<=0 ::PaperLength := GetDeviceCaps(::hPrinterDC,VERTSIZE)/25.4 ENDIF ::PixelsPerInchY := ::UsefulItems[_PYRES] // sDevModeSmall:dmYResolution // IF ::PixelsPerInchY>0 ::PixelsPerInchX := ::UsefulItems[_PXRES] // sDevModeSmall:dmPrintQuality // double use variable ELSE ::PixelsPerInchY := GetDeviceCaps(::hPrinterDC,LOGPIXELSY) ::PixelsPerInchX := GetDeviceCaps(::hPrinterDC,LOGPIXELSX) ENDIF ::PageWidthPixels := GetDeviceCaps(::hPrinterDC,PHYSICALWIDTH) ::PageHeightPixels := GetDeviceCaps(::hPrinterDC,PHYSICALHEIGHT) ::LeftMarginPixels := GetDeviceCaps(::hPrinterDC,PHYSICALOFFSETX) ::TopMarginPixels := GetDeviceCaps(::hPrinterDC,PHYSICALOFFSETY) ::PrintWidthPixels := GetDeviceCaps(::hPrinterDC,HORZRES) ::PrintHeightPixels := GetDeviceCaps(::hPrinterDC,VERTRES) * For reliability sake, we will calculate 2 ways since sometimes the call to getdevicecaps doesn't seem to work IF ::PageWidthPixels<=0 .OR. (::PaperWidth>0.AND.::PageWidthPixels/::PixelsPerInchX > 1.1*::PaperWidth) ::PageWidthPixels := ::Paperwidth*::PixelsPerInchX ENDIF IF ::PageHeightPixels<=0 .OR. (::PaperLength>0.AND.::PageHeightPixels/::PixelsPerInchY > 1.1*::PaperLength) ::PageHeightPixels := ::PaperLength*::PixelsPerInchY ENDIF IF ::LeftMarginPixels=0 ::LeftMarginPixels := ::PixelsPerInchX/4.0 // This is a guess since sometimes we get 0 in the above call ENDIF ::RightMarginPixels := (::PageWidthPixels - ::LeftMarginPixels)+1 IF ::TopMarginPixels=0 ::TopMarginPixels := ::PixelsPerInchY/4.0 // This is a guess - 0.25 inches ENDIF ::BottomMarginPixels := (::PageHeightPixels - ::TopMarginPixels)+1 ::PixelsPerMMX :=::PixelsPerInchX/25.4 ::PixelsPerMMY :=::PixelsPerInchY/25.4 ::PageWidthMM := ::PageWidthPixels/::PixelsPerMMX ::PageHeightMM := ::PageHeightPixels/::PixelsPerMMY ::LeftMarginMM := ::LeftMarginPixels/::PixelsPerMMX ::RightMarginMM := ::RightMarginPixels/::PixelsPerMMX ::TopMarginMM := ::TopMarginPixels/::PixelsPerMMY ::BottomMarginMM := ::BottomMarginPixels/::PixelsPerMMY ::PrintWidthMM := ::PageWidthMM-(2*::LeftMarginMM) ::PrintHeightMM := ::PageHeightMM-(2*::TopMarginMM) ::LineHeight := INT(::PixelsPerInchY / 6) // Default 6 lines per inch == # of pixels per line ::FontStyle :=0 // Set .T. if can print bitmaps ::BitMapsOk := BitMapsOk(::hPrinterDC) // supports Colour ::NumColors := GetDeviceCaps(::hPrinterDC,NUMCOLORS) // bin number ::BinNumber=::GetBin() RETURN NIL METHOD Destroy() CLASS WINPRN32 IF !EMPTY(::hPrinterDc) IF ::Printing ::EndDoc() ENDIF ::hPrinterDC:= DeleteDC(::hPrinterDC) ENDIF RETURN(.T.) METHOD SetPageSize(nPaperSize) CLASS WINPRN32 // nPapersize for predefined sizes // nPapersize for height and nWidth for width of custom sizes DevMode=SetDocumentProperties(::hWindowHnd,::hPrinterDC, ::PrinterName, DevMode, DevModeSize, ; nPaperSize,::Landscape) IF ISARRAY(nPaperSize) ::CustomHeight=nPaperSize[1] ::CustomWidth=nPaperSize[2] ELSE ::CustomHeight=0 ::CustomWidth=0 ENDIF ::SaveCaps() ::FormType=nPaperSize RETURN .T. METHOD SetPen(nStyle, nWidth, nColor) CLASS WINPRN32 ::PenStyle:=nStyle ::PenWidth:=nWidth ::PenColor:=nColor SetPen(::hPrinterDC, nStyle, nWidth, nColor) RETURN NIL METHOD StartDoc(cDocName) CLASS WINPRN32 LOCAL Result:= .F. IF cDocName == NIL cDocName:= GetExeFileName()+" ["+DTOC(DATE())+' - '+TIME()+"]" ENDIF //ALERTA(::hPrinterDc) //cDocName := "c:\temp\file.pdf" IF (Result:= StartDoc(::hPrinterDc, cDocName)) IF !(Result:= ::StartPage(::hPrinterDc)) ::EndDoc(.T.) ELSE ::Printing:= .T. ENDIF ENDIF RETURN(Result) METHOD EndDoc(lAbortDoc) CLASS WINPRN32 IF lAbortDoc == NIL lAbortDoc:= .F. ENDIF IF !::HavePrinted lAbortDoc:= .T. ENDIF IF !lAbortDoc ::EndPage(.F.) ENDIF EndDoc(::hPrinterDC,lAbortDoc) ::Printing:= .F. ::HavePrinted:= .F. RETURN(.T.) METHOD StartPage() CLASS WINPRN32 LOCAL lLLandScape, nLBinNumber, nLFormType, nLDuplexType, nLPrintQuality LOCAL lArray, lChange IF ::LandScape <> ::fOldLandScape // Direct-modify property lLLandScape:= ::fOldLandScape := ::LandScape ENDIF IF ::BinNumber <> ::fOldBinNumber // Direct-modify property nLBinNumber:= ::fOldBinNumber := ::BinNumber ENDIF /* Form type has changed if 1) Changed from/to custom to/from standard 2) changed the size of custom or 3) changed the standard size */ lChange=(VALTYPE(::FormType)<>VALTYPE(::fOldFormType)) IF !lChange.AND. (VALTYPE(::FormType)='A'.AND.VALTYPE(::fOldFormType)='A') lChange=((::FormType[1] <> ::fOldFormType[1]).OR.; (::FormType[2] <> ::fOldFormType[2])) ELSEIF !lChange lChange=(::FormType <> ::fOldFormType) ENDIF IF lChange nLFormType:= ::fOldFormType := ::FormType ENDIF IF ::fDuplexType <> ::fNewDuplexType // Get/Set property nLDuplexType:= ::fDuplexType:= ::fNewDuplexType ENDIF IF ::fPrintQuality <> ::fNewPrintQuality // Get/Set property nLPrintQuality:= ::fPrintQuality:= ::fNewPrintQuality ENDIF IF lLLandScape <> NIL .or. nLBinNumber <> NIL .or. nLFormType <> NIL .or. nLDuplexType <> NIL .or. nLPrintQuality <> NIL SetDocumentProperties(::hWindowHnd,::hPrinterDC, ::PrinterName, @DevMode, DevModeSize,; nLFormType, lLLandscape, , nLBinNumber, nLDuplexType, nLPrintQuality) ::SaveCaps() ::SetFont(::FontName, ::FontPointSize, ::FontWidth, ::fBold, ::fUnderline, ::fItalic, ::StrikeThrough, ::fCharSet, ::FontAngle) ENDIF StartPage(::hPrinterDC) ::PosX:=0 ::Posy:=0 RETURN(.T.) METHOD EndPage(lStartNewPage) CLASS WINPRN32 IF lStartNewPage == NIL lStartNewPage:= .T. ENDIF EndPage(::hPrinterDC) IF lStartNewPage ::StartPage() IF OS_ISWIN9X() // Reset font on Win9X ::SetFont() ENDIF ENDIF RETURN(.T.) METHOD NewPage() CLASS WINPRN32 ::EndPage(.T.) RETURN(.T.) // If font width is specified it is in "characters per inch" to emulate DotMatrix // An array {nMul,nDiv} is used to get precise size such a the Dot Matric equivalent // of Compressed print == 16.67 char per inch == { 3,-50 } // If nDiv is < 0 then Fixed width printing is forced via ExtTextOut() METHOD SetFont(cFontName, nPointSize, nWidth, nBold, lUnderline, lItalic, lStrike, nCharSet, nAngle) CLASS WINPRN32 LOCAL cType IF cFontName !=NIL ::FontName:= cFontName ENDIF IF nPointSize!=NIL ::FontPointSize:= nPointSize ENDIF IF nWidth != NIL cType:= VALTYPE(nWidth) IF cType='A' ::FontWidth := nWidth ELSEIF cType='N' .AND. !EMPTY(nWidth) ::FontWidth := {1,nWidth } ELSE ::FontWidth := {0, 0 } ENDIF ENDIF IF nBold != NIL ::fBold := nBold ENDIF IF lUnderLine != NIL ::fUnderline:= lUnderLine ENDIF IF lItalic != NIL ::fItalic := lItalic ENDIF IF nCharSet != NIL ::fCharSet := nCharSet ENDIF IF nAngle !=NIL ::FontAngle := nAngle ENDIF IF lStrike != NIL ::StrikeThrough := lStrike ENDIF IF (::SetFontOk:= CreateFont( ::hPrinterDC, ::FontName, ::FontPointSize, ::FontWidth[1], ::FontWidth[2], ::fBold, ::fUnderLine, ::fItalic, ::fCharSet, ::StrikeThrough, ::FontAngle*10)) ::fCharWidth := ::GetCharWidth() ::CharWidth := ABS(::fCharWidth) ::CharHeight := ::GetCharHeight() ENDIF ::FontName:= GetPrinterFontName(::hPrinterDC) // Get the font name that Windows actually used RETURN(::SetFontOk) METHOD SetDefaultFont() RETURN(::SetFont("Courier New",12, 0, 0, .F., .F., 0, 0)) METHOD Bold(nWeight) CLASS WINPRN32 LOCAL Result:= ::fBold IF nWeight!= NIL ::fBold:= nWeight IF ::Printing ::SetFont() ENDIF ENDIF RETURN(Result) METHOD Underline(lUnderLine) CLASS WINPRN32 LOCAL Result:= ::fUnderline IF lUnderLine!= NIL ::fUnderLine:= lUnderLine IF ::Printing ::SetFont() ENDIF ENDIF RETURN(Result) METHOD Italic(lItalic) CLASS WINPRN32 LOCAL Result:= ::fItalic IF lItalic!= NIL ::fItalic:= lItalic IF ::Printing ::SetFont() ENDIF ENDIF RETURN(Result) METHOD CharSet(nCharSet) CLASS WINPRN32 LOCAL Result:= ::fCharSet IF nCharSet!= NIL ::fCharSet:= nCharSet IF ::Printing ::SetFont() ENDIF ENDIF RETURN(Result) METHOD SetDuplexType(nDuplexType) CLASS WINPRN32 LOCAL Result:= ::fDuplexType IF nDuplexType!= NIL ::fNewDuplexType:= nDuplexType IF !::Printing ::fDuplexType:= nDuplexType ENDIF ENDIF RETURN(Result) METHOD SetPrintQuality(nPrintQuality) CLASS WINPRN32 LOCAL Result:= ::fPrintQuality IF nPrintQuality!= NIL ::fNewPrintQuality:= nPrintQuality IF !::Printing ::fPrintQuality:= nPrintQuality ENDIF ENDIF RETURN(Result) METHOD GetFonts() CLASS WINPRN32 RETURN(ENUMFONTS(::hPrinterDC)) METHOD SetPos(nPosX, nPosY) CLASS WINPRN32 LOCAL Result:= {::PosX, ::PosY} IF nPosX != NIL ::PosX:= INT(nPosX) ENDIF IF nPosY != NIL ::PosY:= INT(nPosY) ENDIF RETURN(Result) METHOD TextOut(cString, lNewLine, lUpdatePosX, nAlign) CLASS WINPRN32 LOCAL nPosX IF nAlign == NIL nAlign:= 0 ENDIF IF lUpdatePosX == NIL lUpdatePosX:=.T. ENDIF IF lNewLine == NIL lNewLine:= .F. ENDIF IF cString!=NIL nPosX:= TextOut(::hPrinterDC,::PosX, ::PosY, cString, LEN(cString), ::fCharWidth, nAlign) ::HavePrinted:= .T. IF lUpdatePosX ::PosX+= nPosX ENDIF IF lNewLine ::NewLine() ENDIF ENDIF RETURN( .T. ) METHOD TextOutAt(nPosX,nPosY, cString, lNewLine, lUpdatePosX, nAlign) CLASS WINPRN32 IF lNewLine == NIL lNewLine:= .F. ENDIF IF lUpdatePosX == NIL lUpdatePosX:= .T. ENDIF ::SetPos(nPosX,nPosY) ::TextOut(cString, lNewLine, lUpdatePosX, nAlign) RETURN(.T.) METHOD TextBox(cString, nLeft, nTop, nRight, nBottom, nAlign) CLASS WINPRN32 RETURN TextBox(::hPrinterDC,cString,LEN(cString),nLeft,nTop,nRight,nBottom,nAlign) METHOD GetCharWidth() CLASS WINPRN32 LOCAL nWidth:= 0 IF ::FontWidth[2] < 0 .AND. !EMPTY(::FontWidth[1]) nWidth:= MulDiv(::FontWidth[1], ::PixelsPerInchX,::FontWidth[2]) ELSE nWidth:= GetCharSize(::hPrinterDC) ENDIF RETURN(nWidth) METHOD GetCharHeight() CLASS WINPRN32 RETURN(GetCharSize(::hPrinterDC, .T.)) METHOD GetTextWidth(cString) CLASS WINPRN32 LOCAL nWidth:= 0 IF ::FontWidth[2] < 0 .AND. !EMPTY(::FontWidth[1]) nWidth:= LEN(cString) * ::CharWidth ELSE nWidth:= GetTextSize(::hPrinterDC, cString, LEN(cString)) // Return Width in device units ENDIF RETURN(nWidth) METHOD GetTextHeight(cString) CLASS WINPRN32 RETURN(GetTextSize(::hPrinterDC, cString, LEN(cString), .F.)) // Return Height in device units METHOD GetBkColor() CLASS WINPRN32 RETURN GetBkColor(::hPrinterDC) METHOD SetBkColor(nColor) CLASS WINPRN32 ::BkColor=nColor RETURN SetBkColor(::hPrinterDC, nColor) METHOD GetBin() CLASS WINPRN32 RETURN GetDocumentBin(DevMode) METHOD SetBin(nBin) CLASS WINPRN32 ::BinNumber=SetDocumentBin(::hWindowHnd,::hPrinterDC, ::PrinterName, @DevMode,; DevModeSize, nBin) RETURN ::BinNumber METHOD GetDefPaperSize() CLASS WINPRN32 RETURN GetPrinterSize(::hPrinterDC, ::PrinterName) METHOD DrawBitMap(oBmp, nTransparent) CLASS WINPRN32 LOCAL Result:= .F. IF ::BitMapsOk .AND. ::Printing .AND. !EMPTY(oBmp:BitMap) IF nTransparent!=NIL Result:= DrawTransBitMap(::hPrinterDc, oBmp:BitMap,oBmp:Rect[1], oBmp:Rect[2], oBmp:rect[3], oBmp:Rect[4], nTransparent) ::HavePrinted:= .T. ELSE IF (Result:= DrawBitMap(::hPrinterDc, oBmp:BitMap,oBmp:Rect[1], oBmp:Rect[2], oBmp:rect[3], oBmp:Rect[4])) ::HavePrinted:= .T. ENDIF ENDIF ENDIF RETURN(Result) METHOD SetBrush(lSolid,nStyle, nColor, lNull) CLASS WINPRN32 // lSolid is true if the brush is solid // nStyle is the brush style if the brush is not solid. // Values from WinGdi.h include HS_VERTICAL, HS_HORIZONTAL, HS_FDIAGONAL, // HS_BDIAGONAL, HS_CROSS, HS_DIAGCROSS // nColor is the RGB style color IF VALTYPE(lSolid)!='L' lSolid=::lSolidBrush ENDIF IF VALTYPE(lNull)!='L' lNull=::lNullBrush ENDIF // If we aren't changing the style then don't do anything IF lSolid!=::lSolidBrush.OR.nStyle!=::BrushStyle.OR.nColor!=::BrushColor; .OR.lNull!=::lNullBrush IF lSolid // Create a solid brush CreateSolidBrush(::hPrinterDC,nColor) ELSEIF !lNull // hatched brush CreateHatchBrush(::hPrinterDC,nStyle,nColor) ELSE // Null - empty - brush CreateStockBrush(::hPrinterDC,NULL_BRUSH) ENDIF ::lSolidBrush=lSolid ::BrushStyle=nStyle ::BrushColor=nColor ::lNullBrush=lNull ENDIF RETURN NIL METHOD TextAtFont( nPosX, nPosY, cString, cFont, nPointSize, nWidth, nBold, lUnderLine, lItalic, lStrike, nCharSet, lNewLine, lUpdatePosX, nColor, nAlign ) CLASS WINPRN32 LOCAL lCreated:= .F., nDiv:= 0, cType DEFAULT nPointSize TO ::FontPointSize IF cFont != NIL cType:= VALTYPE(nWidth) IF cType='A' nDiv := nWidth[ 1 ] nWidth:= nWidth[ 2 ] ELSEIF cType='N' .AND. !EMPTY(nWidth) nDiv:= 1 ENDIF lCreated:= CreateFont( ::hPrinterDC, cFont, nPointSize, nDiv, nWidth, nBold, lUnderLine, lItalic, lStrike, nCharSet ) ENDIF IF nColor != NIL nColor:= SetColor( ::hPrinterDC, nColor ) ENDIF ::TextOutAt( nPosX, nPosY, cString, lNewLine, lUpdatePosX, nAlign) IF lCreated ::SetFont() // Reset font ENDIF IF nColor != NIL SetColor( ::hPrinterDC, nColor ) // Reset Color ENDIF RETURN( .T. ) /*STATIC FUNCTION Move2DevMode *LOCAL sDevmode is cDevMode sDevmodeSmall:Buffer(GetDevMode(DevMode),.T.) RETURN NIL /*sDevMode*/ */ // Bitmap class CLASS WINBMP32 EXPORTED: METHOD New() METHOD LoadFile(cFileName) METHOD LoadMemory(cBitMap) METHOD Create() METHOD Destroy() METHOD Draw(oPrn,arectangle,nTransparent) METHOD GetDimensions() VAR Rect INIT { 0,0,0,0 } // Coordinates to print BitMap // XDest, // x-coord of destination upper-left corner // YDest, // y-coord of destination upper-left corner // nDestWidth, // width of destination rectangle // nDestHeight, // height of destination rectangle // See WinApi StretchDIBits() VAR BitMap INIT "" VAR FileName INIT "" VAR BitMapWidth INIT 0 // width (x dimension) VAR BitMapHeight INIT 0 // heigth (y dimension) VAR lDown INIT .T. // Top Down bit map ENDCLASS METHOD New() CLASS WINBMP32 RETURN(Self) METHOD LoadMemory(cBitMap) CLASS WINBMP32 ::Bitmap := cBitMap RETURN(Self) METHOD LoadFile(cFileName) CLASS WINBMP32 ::FileName:= cFileName ::Bitmap := LoadBitMapFile(::FileName) RETURN(!EMPTY(::Bitmap)) METHOD GetDimensions() CLASS WINBMP32 LOCAL aDim // array containing dimensions aDim=GetBitMapDim(::BitMap) ::BitMapWidth=aDim[1] ::BitMapHeight=aDim[2] ::lDown=(aDim[3]!=aDim[1]) // Top down addressing - Do I need it?? RETURN NIL METHOD Create() CLASS WINBMP32 // Compatibility function for Alaska Xbase++ Return(Self) METHOD Destroy() CLASS WINBMP32 // Compatibility function for Alaska Xbase++ RETURN(NIL) METHOD Draw(oPrn, aRectangle,nTransparent) CLASS WINBMP32 // Pass a TPRINT class reference & Rectangle array ::Rect:= aRectangle RETURN(oPrn:DrawBitMap(Self,nTransparent)) #pragma BEGINDUMP #include <windows.h> #include <winspool.h> #include "wingdi.h" #include "hbapiitm.h" #ifndef INVALID_FILE_SIZE #define INVALID_FILE_SIZE (DWORD)0xFFFFFFFF #endif /*HB_FUNC_STATIC(GETDEVMODE) { PDEVMODE pDevMode = (PDEVMODE) hb_parc(1); hb_retclenAdoptRaw( (char *) pDevMode, sizeof(DEVMODE)); } */ HB_FUNC_STATIC( CREATEDC ) { LONG Result = 0 ; LONG lSize ; HANDLE hPrinter; LPTSTR pszPrinterName; PDEVMODE pDevMode; if (ISCHAR(1)) { pszPrinterName = (char*) hb_parc(1); if (OpenPrinter(pszPrinterName, &hPrinter, NULL)) /* Windows Call */ lSize= DocumentProperties(0,hPrinter,pszPrinterName, pDevMode,pDevMode,0); if (lSize > 0) { pDevMode = (PDEVMODE) hb_xgrab(lSize); DocumentProperties(0,hPrinter,pszPrinterName, pDevMode,pDevMode,DM_OUT_BUFFER); if (ISNUM(2)) { pDevMode->dmCopies = hb_parni(2); pDevMode->dmFields = pDevMode->dmFields | DM_COPIES; } Result = (LONG) CreateDC("",pszPrinterName, NULL, pDevMode) ; hb_storclen((CHAR *) pDevMode, lSize, 3); hb_stornl(lSize, 4); hb_xfree(pDevMode); } } hb_retnl(Result) ; } HB_FUNC_STATIC( STARTDOC ) { HDC hDC = (HDC) hb_parnl(1) ; LPDOCINFO sDoc = NULL; BOOL Result = FALSE ; if (hDC ) { sDoc = (LPDOCINFO) hb_xgrab(sizeof(DOCINFO)); sDoc->cbSize= sizeof(DOCINFO) ; sDoc->lpszDocName= hb_parc(2) ; sDoc->lpszOutput = NULL ; sDoc->lpszDatatype= NULL ; sDoc->fwType = 0 ; Result = (BOOL) (StartDoc(hDC, sDoc) >0 ) ; hb_xfree(sDoc); } hb_retl(Result); } HB_FUNC_STATIC(ENDDOC) { BOOL Result = FALSE; HDC hDC = (HDC) hb_parnl(1) ; if (hDC) { if (ISLOG(2) && hb_parl(2)) { Result = (AbortDoc(hDC) > 0) ; } else { Result = (EndDoc( hDC) > 0) ; } } hb_retnl(Result) ; } HB_FUNC_STATIC( DELETEDC ) { HDC hDC = (HDC) hb_parnl(1) ; if (hDC) { DeleteDC( hDC ) ; } hb_retnl(0) ; // Return zero as a new handle even if fails } HB_FUNC_STATIC(STARTPAGE) { BOOL Result = FALSE ; HDC hDC = (HDC) hb_parnl(1) ; if (hDC) { Result = ( StartPage( hDC ) > 0) ; } hb_retl(Result) ; } HB_FUNC_STATIC(ENDPAGE) { BOOL Result = FALSE ; HDC hDC = (HDC) hb_parnl(1) ; if (hDC) { Result = (EndPage( hDC ) > 0) ; } hb_retl(Result) ; } HB_FUNC_STATIC(TEXTOUT) { LONG Result = 0 ; HDC hDC = (HDC) hb_parnl(1) ; SIZE sSize ; if (hDC) { int iLen = (int) hb_parnl(5) ; if ( iLen > 0 ) { int iRow = (int) hb_parnl(2) ; int iCol = (int) hb_parnl(3) ; char *pszData = (char*) hb_parc(4) ; int iWidth = ISNUM(6) ? (int) hb_parnl(6) : 0 ; if (ISNUM(7) && (hb_parnl(7) == 1 || hb_parnl(7) == 2)) { if (hb_parnl(7) == 1) { SetTextAlign((HDC) hDC, TA_TOP | TA_RIGHT | TA_NOUPDATECP) ; } else { SetTextAlign((HDC) hDC, TA_TOP | TA_CENTER | TA_NOUPDATECP) ; } } else { SetTextAlign((HDC) hDC, TA_TOP | TA_LEFT | TA_NOUPDATECP) ; } if (iWidth < 0 && iLen < 1024 ) { int n= iLen, aFixed[1024] ; iWidth = -iWidth ; while( n ) { aFixed[ --n ] = iWidth; } if (ExtTextOut( hDC, iRow, iCol, 0, NULL, pszData, iLen, aFixed )) { Result = (LONG) (iLen * iWidth) ; } } else if (TextOut(hDC, iRow, iCol, pszData, iLen)) { GetTextExtentPoint32(hDC,pszData, iLen , &sSize) ; // Get the length of the text in device size Result = (LONG) sSize.cx ; // return the width so we can update the current pen position (::PosY) } } } hb_retnl(Result) ; }

by **Antonio Linares** » Thu Apr 11, 2024 6:55 am

(quinta parte)

Code: Select all Expand view RUN: HB_FUNC_STATIC(TEXTBOX) /* Calling paramters: PrinterDC, String, Charcount, x1,y1,x2,y2, align */ { LPRECT lpRect = NULL; HDC hDC = (HDC) hb_parnl(1) ; if (hDC) { int nCount = ISNUM(3) ? (int) hb_parnl(3) : -1 ; char *pszData = (char*) hb_parc(2) ; int oldalign = SetTextAlign( hDC, TA_TOP | TA_LEFT | TA_NOUPDATECP) ; int uFormat = 0; lpRect = (LPRECT) hb_xgrab(sizeof(RECT)); lpRect->left = (long) hb_parnl(4); lpRect->top = (long) hb_parnl(5); lpRect->right = (long) hb_parnl(6); lpRect->bottom= (long) hb_parnl(7); if (ISNUM(8) && (hb_parnl(8) == 1 || hb_parnl(8) == 2)) { if (hb_parnl(8) == 2) { uFormat = (DT_CENTER | DT_END_ELLIPSIS | DT_NOPREFIX | DT_TOP | DT_WORDBREAK); } else { uFormat = (DT_RIGHT | DT_END_ELLIPSIS | DT_NOPREFIX | DT_TOP | DT_WORDBREAK); } } else { uFormat = (DT_LEFT | DT_END_ELLIPSIS | DT_NOPREFIX | DT_TOP | DT_WORDBREAK); } DrawText( hDC, pszData, nCount, lpRect, uFormat); SetTextAlign(hDC, oldalign); hb_xfree(lpRect); } } HB_FUNC_STATIC(GETTEXTSIZE) { LONG Result = 0 ; HDC hDC = (HDC) hb_parnl(1) ; SIZE sSize ; if (hDC) { char *pszData = (char*) hb_parc(2) ; int iLen = (int) hb_parnl(3) ; GetTextExtentPoint32(hDC,pszData, iLen , &sSize) ; // Get the length of the text in device size if (ISLOG(4) && !hb_parl(4)) { Result = (LONG) sSize.cy ; // return the height } else { Result = (LONG) sSize.cx ; // return the width } } hb_retnl(Result) ; } HB_FUNC_STATIC(GETBKCOLOR) /* Returns DC background color */ { hb_retnl( (ULONG) GetBkColor( (HDC) hb_parnl(1))); } HB_FUNC_STATIC(SETBKCOLOR) /* Sets DC background color Returns old background color */ { hb_retnl( (ULONG) SetBkColor( (HDC) hb_parnl(1), (COLORREF) hb_parnl( 2 ) )); } HB_FUNC_STATIC( GETCHARSIZE ) { LONG Result = 0 ; HDC hDC = (HDC) hb_parnl(1) ; if (hDC) { LPTEXTMETRIC tm; tm = (LPTEXTMETRIC) hb_xgrab(sizeof(TEXTMETRIC)); GetTextMetrics( hDC, tm ); if ( ISLOG(2) && hb_parl(2) ) { Result = (LONG) tm->tmHeight; } else { Result = (LONG) tm->tmAveCharWidth; } hb_xfree(tm); } hb_retnl(Result) ; } HB_FUNC_STATIC( GETDEVICECAPS ) { LONG Result = 0 ; HDC hDC = (HDC) hb_parnl(1) ; if (hDC && ISNUM(2)) { Result = (LONG) GetDeviceCaps( hDC, hb_parnl(2)) ; } hb_retnl( Result) ; } HB_FUNC_STATIC( SETMAPMODE ) { LONG Result = 0 ; HDC hDC = (HDC) hb_parnl(1) ; if (hDC && ISNUM(2)) { Result = SetMapMode( hDC, hb_parni(2)) ; } hb_retnl( Result) ; } HB_FUNC( MULDIV ) { hb_retnl(MulDiv(hb_parnl(1), hb_parnl(2), hb_parnl(3))); } HB_FUNC_STATIC( CREATEFONT ) { BOOL Result = FALSE ; HDC hDC = (HDC) hb_parnl(1) ; HFONT hFont, hOldFont ; char *pszFont = (char*) hb_parc(2) ; int iHeight = (int) hb_parnl(3) ; int iMul = (int) hb_parnl(4) ; int iDiv = (int) hb_parnl(5) ; int iWidth ; int iWeight = (int) hb_parnl(6) ; DWORD dwUnderLine = (DWORD) hb_parl(7) ; DWORD dwItalic = (DWORD) hb_parl(8) ; DWORD dwCharSet = (DWORD) hb_parnl(9) ; DWORD dwStrike = (DWORD) hb_parl(10); int nEscapement = (int) hb_parnl(11); iWeight = iWeight > 0 ? iWeight : FW_NORMAL ; iHeight = -MulDiv(iHeight, GetDeviceCaps(hDC, LOGPIXELSY), 72); if (iDiv ) { iWidth = MulDiv(abs(iMul), GetDeviceCaps(hDC,LOGPIXELSX), abs(iDiv)) ; } else { iWidth = 0 ; // Use the default font width } hFont = CreateFont(iHeight, iWidth, nEscapement, nEscapement, iWeight, dwItalic, dwUnderLine, dwStrike, dwCharSet, OUT_TT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, DEFAULT_PITCH | FF_ROMAN, pszFont) ; if (hFont) { Result = TRUE; hOldFont = (HFONT) SelectObject(hDC, hFont) ; if ( hOldFont ) { DeleteObject(hOldFont) ; } } hb_retl( Result ) ; } HB_FUNC_STATIC( GETPRINTERFONTNAME ) { HDC hDC = (HDC) hb_parnl(1) ; if (hDC) { char cFont[128] ; GetTextFace(hDC, 128, cFont) ; hb_retc( cFont ) ; } else { hb_retc("") ; } } HB_FUNC_STATIC(BITMAPSOK) { BOOL Result = FALSE ; HDC hDC = (HDC) hb_parnl(1) ; if (hDC) { Result = (GetDeviceCaps(hDC, RASTERCAPS) & RC_STRETCHDIB) ; } hb_retl(Result) ; } HB_FUNC_STATIC( SETDOCUMENTPROPERTIES ) /* Calling parameters: hWindowHnd Handle to calling window hPrinterDC Handle to printer Device Context PrinterName Name of the printer DevMode Devmode structure from creating the DC DevModeSize size of the DevMode structure including device specific info FormType Form size if scalar, actual measurements if array Landscape Logical indicating if landscape Copies Desired # of copies BinNumber Desired Bin number fDuplexType Desired duplex type fPrintQuality Desired print quality */ { BOOL Result = FALSE ; HDC hDC = (HDC) hb_parnl(2) ; if (hDC) { HANDLE hPrinter ; LPTSTR pszPrinterName = (char*) hb_parc(3) ; PDEVMODE pDevMode ; // = NULL ; LONG lSize = hb_parnl(5) ; HWND hWnd = (HWND) hb_parni(1); // CHAR* cConsoleTitle ; if (OpenPrinter(pszPrinterName, &hPrinter, NULL)) /* Windows Call */ { if (lSize > 0 ) { pDevMode= (PDEVMODE) hb_xgrab(lSize) ; memcpy(pDevMode,hb_parc(4),lSize) ; if (pDevMode ) { if (ISNUM(6) ) //&& hb_parnl(3) > 0) { pDevMode->dmPaperSize = ( short ) hb_parnl(6) ; pDevMode->dmPaperLength=0; pDevMode->dmPaperWidth=0; } else if ISARRAY(6) { pDevMode->dmPaperSize = 0; pDevMode->dmPaperLength = ( short ) hb_parnl(6,1); pDevMode->dmPaperWidth = ( short ) hb_parnl(6,2); } if (ISLOG(7)) { pDevMode->dmOrientation = ( short ) (hb_parl(7) ? 2 : 1) ; } if (ISNUM(8) && hb_parnl(8) > 0) { pDevMode->dmCopies = ( short ) hb_parnl(8) ; } if (ISNUM(9) ) //&& hb_parnl(6) > 0) { pDevMode->dmDefaultSource = ( short ) hb_parnl(9) ; } if (ISNUM(10) ) //&& hb_parnl(9) > 0) { pDevMode->dmDuplex = ( short ) hb_parnl(10) ; } if (ISNUM(11) ) //&& hb_parnl(8) <> 0) { pDevMode->dmPrintQuality = ( short ) hb_parnl(11) ; } DocumentProperties(hWnd,hPrinter,pszPrinterName, pDevMode,pDevMode,DM_IN_BUFFER|DM_OUT_BUFFER); Result= (BOOL) ResetDC(hDC, pDevMode) ; // hb_storclen((CHAR *) pDevMode,lSize,3); hb_retclen((CHAR *) pDevMode,lSize); hb_xfree(pDevMode); } else hb_retc(hb_parc(4)); // no pdevmode } else hb_retc(hb_parc(4)); // no size ClosePrinter(hPrinter) ; } else hb_retc(hb_parc(4)); // no open printer } else hb_retc(hb_parc(4)); // no hDC } /* HB_FUNC_STATIC(DEBPRINT) { printf("%s\n",hb_parc(1)); } */ HB_FUNC_STATIC( GETDOCUMENTBIN ) { PDEVMODE pDevMode = (PDEVMODE) hb_parc(1); hb_retni(pDevMode->dmDefaultSource); } HB_FUNC_STATIC( SETDOCUMENTBIN ) { HDC hDC = (HDC) hb_parnl(2) ; if (hDC) { HANDLE hPrinter ; LPTSTR pszPrinterName = (char*) hb_parc(3) ; PDEVMODE pDevMode = NULL ; LONG lSize ; HWND hWinHnd = (HWND) hb_parni(1); if (OpenPrinter(pszPrinterName, &hPrinter, NULL)) /* Windows Call */ { lSize = hb_parnl(5); if (lSize > 0 ) { pDevMode= (PDEVMODE) hb_xgrab(lSize) ; pDevMode = memcpy(pDevMode, hb_parc(4), lSize); if (pDevMode ) { pDevMode->dmDefaultSource = hb_parni(5); DocumentProperties(0,hPrinter,pszPrinterName, pDevMode,pDevMode,DM_IN_BUFFER|DM_OUT_BUFFER) ; ResetDC(hDC,pDevMode); hb_storclen((CHAR *)pDevMode, lSize, 4); } hb_retni(pDevMode->dmDefaultSource); hb_xfree(pDevMode); } else hb_ret(); ClosePrinter(hPrinter) ; } } } HB_FUNC_STATIC( GETPRINTERSIZE ) { HDC hDC = (HDC) hb_parnl(1) ; if (hDC) { HANDLE hPrinter ; LPTSTR pszPrinterName = (char*) hb_parc(2) ; PDEVMODE pDevMode = NULL ; LONG lSize ; if (OpenPrinter(pszPrinterName, &hPrinter, NULL)) /* Windows Call */ { lSize= DocumentProperties(0,hPrinter,pszPrinterName, pDevMode,pDevMode,0); if (lSize > 0 ) { pDevMode= (PDEVMODE) hb_xgrab(lSize) ; if (pDevMode ) { DocumentProperties(0,hPrinter,pszPrinterName, pDevMode,pDevMode,DM_OUT_BUFFER) ; hb_retni(pDevMode->dmPaperSize); } hb_xfree(pDevMode); } ClosePrinter(hPrinter) ; } } } // Functions for Loading & Printing bitmaps HB_FUNC_STATIC( LOADBITMAPFILE ) { PTSTR pstrFileName = (char*) hb_parc(1) ; BOOL bSuccess= FALSE ; DWORD dwFileSize, dwHighSize, dwBytesRead ; HANDLE hFile ; BITMAPFILEHEADER * pbmfh = NULL ; hFile = CreateFile (pstrFileName, GENERIC_READ, FILE_SHARE_READ, NULL,OPEN_EXISTING, FILE_FLAG_SEQUENTIAL_SCAN, NULL) ; if (hFile != INVALID_HANDLE_VALUE) { dwFileSize = GetFileSize (hFile, &dwHighSize) ; if ((dwFileSize != INVALID_FILE_SIZE) && !dwHighSize) // Do not continue if File size error or TOO big for memory { pbmfh = (BITMAPFILEHEADER *) hb_xgrab(dwFileSize) ; if (pbmfh) { bSuccess = ReadFile (hFile, pbmfh, dwFileSize, &dwBytesRead, NULL) ; bSuccess = bSuccess && (dwBytesRead == dwFileSize) && (pbmfh->bfType == * (WORD *) "BM") ; //&& (pbmfh->bfSize == dwFileSize) ; } } CloseHandle (hFile) ; } if (bSuccess) { hb_retclenAdoptRaw( (char *) pbmfh, dwFileSize ); } else { hb_retc("") ; if (pbmfh != NULL) { hb_xfree (pbmfh) ; } } } HB_FUNC_STATIC( GETBITMAPDIM ) // return the x and y dimentions of the bit map passed as a handle // returns an array of {x,y,original y}; see BITMAPINFO info in Win SDK for // meaning of the sign of the original Y { BITMAPFILEHEADER * pbmfh = (BITMAPFILEHEADER *) hb_parc(1) ; BITMAPINFO * pbmi ; BYTE * pBits ; int cxDib, cyDib, cyDib2 ; PHB_ITEM aReturn; PHB_ITEM nX; PHB_ITEM nY; PHB_ITEM nY2; pbmi = (BITMAPINFO *) (pbmfh + 1) ; pBits = (BYTE *) pbmfh + pbmfh->bfOffBits ; if (pbmi->bmiHeader.biSize == sizeof (BITMAPCOREHEADER)) { // Remember there are 2 types of BitMap File cxDib = ((BITMAPCOREHEADER *) pbmi)->bcWidth ; cyDib = ((BITMAPCOREHEADER *) pbmi)->bcHeight ; } else { cxDib = pbmi->bmiHeader.biWidth ; cyDib = abs (pbmi->bmiHeader.biHeight) ; cyDib2 = pbmi->bmiHeader.biHeight; } aReturn = hb_itemArrayNew(3); nX = hb_itemPutNL(NULL,cxDib); nY = hb_itemPutNL(NULL,cyDib); nY2 =hb_itemPutNL(NULL, cyDib2); hb_itemArrayPut(aReturn,1,nX ); hb_itemArrayPut(aReturn,2,nY ); hb_itemArrayPut(aReturn,3,nY2 ); hb_itemReturn(aReturn); hb_itemRelease(aReturn); hb_itemRelease(nY); hb_itemRelease(nX); hb_itemRelease(nY2); return; } HB_FUNC_STATIC( DRAWBITMAP ) { HDC hDC = (HDC) hb_parnl(1) ; BITMAPFILEHEADER * pbmfh = (BITMAPFILEHEADER *) hb_parc(2) ; BITMAPINFO * pbmi ; BYTE * pBits ; int cxDib, cyDib ; pbmi = (BITMAPINFO *) (pbmfh + 1) ; pBits = (BYTE *) pbmfh + pbmfh->bfOffBits ; if (pbmi->bmiHeader.biSize == sizeof (BITMAPCOREHEADER)) { // Remember there are 2 types of BitMap File cxDib = ((BITMAPCOREHEADER *) pbmi)->bcWidth ; cyDib = ((BITMAPCOREHEADER *) pbmi)->bcHeight ; } else { cxDib = pbmi->bmiHeader.biWidth ; cyDib = abs (pbmi->bmiHeader.biHeight) ; } SetStretchBltMode (hDC, COLORONCOLOR) ; hb_retl( StretchDIBits( hDC, hb_parni(3), hb_parni(4), hb_parni(5), hb_parni(6), 0, 0, cxDib, cyDib, pBits, pbmi, DIB_RGB_COLORS, SRCCOPY ) != ( int ) GDI_ERROR ); } HB_FUNC_STATIC( DRAWTRANSBITMAP) /*void DrawTransparentBitmap(HDC hdc, HBITMAP hBitmap, short xStart, short yStart, COLORREF cTransparentColor) Calling parameters: hDC - Printer hBitMap - bit map file x - origin x y - origin y xWidth - width yHeight - height nColor - transparent color */ { BITMAP bm; HDC hdcTemp; HDC hdc = (HDC) hb_parnl(1) ; HBITMAP hBitmap; // = (HBITMAP) hb_parc(2) ; INT xStart = (INT) hb_parni(3) ; INT yStart = (INT) hb_parni(4) ; INT xWidth = (INT) hb_parni(5) ; INT yHeight = (INT) hb_parni(6) ; BITMAPFILEHEADER * pbmfh = (BITMAPFILEHEADER *) hb_parc(2) ; BITMAPINFO * pbmi ; BYTE * pBits ; int cxDib, cyDib ; COLORREF cTransparentColor = (COLORREF) hb_parnl(7) ; pbmi = (BITMAPINFO *) (pbmfh + 1) ; pBits = (BYTE *) pbmfh + pbmfh->bfOffBits ; if (pbmi->bmiHeader.biSize == sizeof (BITMAPCOREHEADER)) { // Remember there are 2 types of BitMap File cxDib = ((BITMAPCOREHEADER *) pbmi)->bcWidth ; cyDib = ((BITMAPCOREHEADER *) pbmi)->bcHeight ; } else { cxDib = pbmi->bmiHeader.biWidth ; cyDib = abs (pbmi->bmiHeader.biHeight) ; } hdcTemp = CreateCompatibleDC(hdc); hBitmap = CreateCompatibleBitmap(hdc, cxDib, cyDib); SetDIBits(hdcTemp,hBitmap,0,cyDib,pBits,pbmi ,DIB_RGB_COLORS); SelectObject(hdcTemp,hBitmap); GetObject(hBitmap, sizeof(BITMAP), (LPSTR)&bm); SetStretchBltMode (hdc, COLORONCOLOR) ; TransparentBlt(hdc,xStart,yStart,xWidth,yHeight,hdcTemp,0,0,bm.bmWidth,bm.bmHeight,cTransparentColor); DeleteDC(hdcTemp); DeleteObject(hBitmap); return; } static int CALLBACK FontEnumCallBack(LOGFONT *lplf, TEXTMETRIC *lpntm, DWORD FontType, LPVOID pArray ) { HB_ITEM SubItems; SubItems.type = HB_IT_NIL; hb_arrayNew( &SubItems, 5 ); hb_itemPutC( hb_arrayGetItemPtr( &SubItems, 1 ), lplf->lfFaceName ); hb_itemPutL( hb_arrayGetItemPtr( &SubItems, 2 ), lplf->lfPitchAndFamily & FIXED_PITCH ); hb_itemPutL( hb_arrayGetItemPtr( &SubItems, 3 ), FontType & TRUETYPE_FONTTYPE ); hb_itemPutNL( hb_arrayGetItemPtr( &SubItems, 4 ), lpntm->tmCharSet ); hb_itemPutNL( hb_arrayGetItemPtr( &SubItems, 5 ), (lplf->lfPitchAndFamily>>2)<<2 ); hb_arrayAddForward( (PHB_ITEM) pArray, &SubItems); return(TRUE); } HB_FUNC_STATIC( ENUMFONTS ) { BOOL Result = FALSE ; HDC hDC = (HDC) hb_parnl(1) ; if (hDC) { HB_ITEM Array; Array.type = HB_IT_NIL; hb_arrayNew( &Array, 0 ); EnumFonts(hDC, (LPCTSTR) NULL, (FONTENUMPROC) FontEnumCallBack, (LPARAM) &Array); hb_itemReturnForward( &Array) ; Result = TRUE ; } if( !Result ) { hb_ret() ; } } HB_FUNC_STATIC( GETEXEFILENAME ) { unsigned char pBuf[1024] ; GetModuleFileName(NULL, (LPTSTR) pBuf, 1023) ; hb_retc( (char*) pBuf ) ; } HB_FUNC_STATIC( SETCOLOR ) { HDC hDC = ( HDC ) hb_parnl( 1 ); SetTextColor( hDC, (COLORREF) hb_parnl( 2 ) ); if( ISNUM(3) ) { SetBkColor( hDC, (COLORREF) hb_parnl( 3 ) ); } if( ISNUM(4) ) { SetTextAlign( hDC, hb_parni( 4 ) ); } } HB_FUNC_STATIC( CREATESOLIDBRUSH ) { HDC hDC = ( HDC ) hb_parnl( 1 ); HBRUSH hBrush = CreateSolidBrush( (COLORREF) hb_parnl( 2 ) // pen color ); HBRUSH hOldBrush = (HBRUSH) SelectObject( hDC, hBrush); if( hOldBrush ) DeleteObject( hOldBrush ); hb_retnl( (LONG) hBrush); } HB_FUNC_STATIC( CREATEHATCHBRUSH ) { HDC hDC = ( HDC ) hb_parnl( 1 ); HBRUSH hBrush = CreateHatchBrush( hb_parni( 2 ), // brush style (COLORREF) hb_parnl( 3 ) // pen color ); HBRUSH hOldBrush = (HBRUSH) SelectObject( hDC, hBrush); if( hOldBrush ) DeleteObject( hOldBrush ); hb_retnl( (LONG) hBrush); } HB_FUNC_STATIC( CREATESTOCKBRUSH ) { HDC hDC = ( HDC ) hb_parnl( 1 ); HBRUSH hBrush = GetStockObject( hb_parni( 2 )); // brush index style HBRUSH hOldBrush = (HBRUSH) SelectObject( hDC, hBrush); if( hOldBrush ) DeleteObject( hOldBrush ); hb_retnl( (LONG) hBrush); } HB_FUNC_STATIC( SETPEN ) { HDC hDC = ( HDC ) hb_parnl( 1 ); HPEN hPen = CreatePen( hb_parni( 2 ), // pen style hb_parni( 3 ), // pen width (COLORREF) hb_parnl( 4 ) // pen color ); HPEN hOldPen = (HPEN) SelectObject( hDC, hPen); if( hOldPen ) DeleteObject( hOldPen ); hb_retnl( (LONG) hPen); } HB_FUNC_STATIC( FILLRECT ) { HDC hDC = ( HDC ) hb_parnl( 1 ); int x1 = hb_parni( 2 ); int y1 = hb_parni( 3 ); int x2 = hb_parni( 4 ); int y2 = hb_parni( 5 ); HBRUSH hBrush = CreateSolidBrush( (COLORREF) hb_parnl( 6 ) ); RECT rct; rct.top = y1; rct.left = x1; rct.bottom = y2; rct.right = x2; FillRect( hDC, &rct, hBrush ); DeleteObject( hBrush ); hb_ret( ); } HB_FUNC_STATIC( LINETO ) { HDC hDC = ( HDC ) hb_parnl( 1 ); int x1 = hb_parni( 2 ); int y1 = hb_parni( 3 ); int x2 = hb_parni( 4 ); int y2 = hb_parni( 5 ); MoveToEx( hDC, x1, y1, NULL ); hb_retl( LineTo( hDC, x2, y2 ) ); } HB_FUNC_STATIC( RECTANGLE ) { HDC hDC = ( HDC ) hb_parnl( 1 ); int x1 = hb_parni( 2 ); int y1 = hb_parni( 3 ); int x2 = hb_parni( 4 ); int y2 = hb_parni( 5 ); int iWidth = hb_parni( 6 ); int iHeight = hb_parni( 7 ); if ( iWidth && iHeight ) { hb_retl( RoundRect( hDC, x1, y1, x2, y2, iWidth, iHeight ) ); } else { hb_retl( Rectangle( hDC, x1, y1, x2, y2) ); } } HB_FUNC_STATIC( ARC ) { HDC hDC = ( HDC ) hb_parnl( 1 ); int x1 = hb_parni( 2 ); int y1 = hb_parni( 3 ); int x2 = hb_parni( 4 ); int y2 = hb_parni( 5 ); hb_retl( Arc( hDC, x1, y1, x2, y2, 0, 0, 0, 0) ); } HB_FUNC_STATIC( ELLIPSE ) { HDC hDC = ( HDC ) hb_parnl( 1 ); int x1 = hb_parni( 2 ); int y1 = hb_parni( 3 ); int x2 = hb_parni( 4 ); int y2 = hb_parni( 5 ); hb_retl( Ellipse( hDC, x1, y1, x2, y2) ); } HB_FUNC_STATIC( SETBKMODE ) { hb_retnl( SetBkMode( (HDC) hb_parnl( 1 ), hb_parnl( 2 ) ) ) ; } HB_FUNC_STATIC( GETWINDOWHANDLE) // Returns the window handle of the calling routine // Checks both the GDI and Console Mode options { HWND hWindow = GetActiveWindow(); TCHAR cConsoleTitle[MAX_PATH] ; if (hWindow==NULL) { GetConsoleTitle(cConsoleTitle,MAX_PATH); SetConsoleTitle((LPCTSTR) "a1s2d3f4g5g\0"); Sleep(40); hWindow = FindWindow(NULL,(LPCTSTR) "a1s2d3f4g5g\0"); SetConsoleTitle(cConsoleTitle); } hb_retni((INT) hWindow); } HB_FUNC_STATIC(EXTRACTFROMDEVMODE) { PHB_ITEM UsefulItems; //, ItemTemp; PDEVMODE hDevMode; if ( ISCHAR(1) ) { hDevMode = (PDEVMODE)hb_parc(1); // Fill up array with useful devmode items // Returns an array containing the following (in order): // Paper Orientation 1=portrait // Paper size based upon defined constants for predefined sizes in windgi.ch // Paper width in tenths of millimeters // Paper height in tenhts of millimeters // y resolution in pixels per inch // x resolution in pixels per inch UsefulItems = hb_itemArrayNew(6); hb_itemArrayPut(UsefulItems,1, hb_itemPutNI( NULL, (SHORT) hDevMode->dmOrientation)); hb_itemArrayPut(UsefulItems,2, hb_itemPutNI(NULL, (SHORT) hDevMode->dmPaperSize)); hb_itemArrayPut(UsefulItems,3, hb_itemPutNI(NULL, (SHORT) hDevMode->dmPaperWidth)); hb_itemArrayPut(UsefulItems,4, hb_itemPutNI(NULL, (SHORT) hDevMode->dmPaperLength)); hb_itemArrayPut(UsefulItems,5, hb_itemPutNI(NULL, (SHORT) hDevMode->dmYResolution)); hb_itemArrayPut(UsefulItems,6, hb_itemPutNI(NULL, (SHORT) hDevMode->dmPrintQuality)); hb_itemReturn(UsefulItems); hb_itemRelease(UsefulItems); } else { hb_ret(); } } HB_FUNC_STATIC( PRINTDIALOG ) // Call up the printer dialog box // // If all of the parameters are filled in, then the call to printdlg // will be prepopulated with the values from the last call. // Calling parameters: // hWindowHnd - handle of the window calling this routine // DevMode - Contents of the last used DEVMODE Structure // LenDevMode - Length of the devmode structure // DevNames - Contents of the last DEVNAMES structure // LenDevNames - length of the devnames structure // Copies - by reference number of copies program should produce // Returns: // If successful: an array containing: // hPrinter - handle to the printer DC // cPrinterName - name of the printer // nFormType - Windows constant indicating the paper type (Letter, legal, etc.) // DevMode - DEVMODE Structure // LenDevMode - length of DEVMODE structure (it is variable in length) // DevNames - DEVNAMES structure // LenDevNames - length of DEVNAME structure (it is also variable) // aUsefulParms - Array of useful parameters from DevMode { PRINTDLG hPrinter; PHB_ITEM Array, ItemTemp ; BOOL OK ; PDEVMODE hDevMode; LPDEVNAMES hDevNames; LONG lenString; memset( &hPrinter,0,sizeof(PRINTDLG)); hPrinter.lStructSize = (DWORD) sizeof(PRINTDLG); hPrinter.hwndOwner = (HWND) hb_parni(1) ; // GetActiveWindow(); //NULL; hPrinter.hDevNames = NULL ; hPrinter.Flags = (DWORD) (PD_ALLPAGES | PD_HIDEPRINTTOFILE | PD_RETURNDC | PD_NOPAGENUMS | PD_NOSELECTION | PD_USEDEVMODECOPIESANDCOLLATE ); hPrinter.nFromPage = 1; hPrinter.nToPage = 1; hPrinter.nMinPage = 1; hPrinter.nMaxPage = 1; hPrinter.nCopies = 1; hPrinter.hDC = NULL ; // If we receive all of the data from the last call, then re-use it if (ISCHAR(2) && ISNUM(3) && ISCHAR(4) && ISNUM(5)) { ULONG nLen = hb_parnl(5); CHAR *Temp = (char*) hb_parc(4); PDEVMODE DevTemp = (PDEVMODE)hb_parc(2); // Build the devnames structure hPrinter.hDevNames = GlobalAlloc(GHND, nLen); hDevNames = (DEVNAMES*) GlobalLock(hPrinter.hDevNames); memcpy(hDevNames,Temp,nLen); GlobalUnlock(hDevNames); // Build the devmode structure nLen = hb_parnl(3); if (ISNUM(6)) { DevTemp->dmCopies = (SHORT) hb_parni(6); } hPrinter.hDevMode = (DEVMODE*) GlobalAlloc(GHND, nLen); hDevMode = (DEVMODE*) GlobalLock(hPrinter.hDevMode); memcpy(hDevMode,DevTemp,nLen); GlobalUnlock(hDevMode); } /* if ( ISNUM(6) ) { SHORT nCopies = hb_parni(6); if (nCopies > 0) { hPrinter->(PDEVMODE)hDevMode->dmCopies = (SHORT) nCopies; hPrinter.nCopies = (SHORT) nCopies; } } */ OK = PrintDlg(&hPrinter); if (OK) { Array = hb_itemArrayNew(8); // printer handle ItemTemp = hb_itemPutNL(NULL, (LONG) hPrinter.hDC); hb_itemArrayPut(Array,1, ItemTemp); // lock memory so we can grab it hDevMode=(PDEVMODE)GlobalLock(hPrinter.hDevMode); // return needed number of copies hb_storni(hPrinter.nCopies,6); // send the printer name hDevNames=(LPDEVNAMES)GlobalLock(hPrinter.hDevNames); ItemTemp = hb_itemPutC(NULL, (PCHAR) hDevNames+hDevNames->wDeviceOffset); hb_itemArrayPut(Array,2, ItemTemp); // send paper size ItemTemp = hb_itemPutNL(NULL, (LONG) hDevMode->dmPaperSize); hb_itemArrayPut(Array,3, ItemTemp); // send the devmode structure ItemTemp = hb_itemPutCL(NULL, (PCHAR) hDevMode, hDevMode->dmSize+hDevMode->dmDriverExtra); hb_itemArrayPut(Array, 4, ItemTemp); // Send the size of the structure hb_itemArrayPut(Array, 5, hb_itemPutNL(NULL, (LONG) hDevMode->dmSize+hDevMode->dmDriverExtra)); ItemTemp = hb_itemPutNI(NULL, (SHORT) hDevMode->dmPrintQuality); hb_itemArrayPut(Array, 8, ItemTemp); // Send the devname structure lenString = lstrlen((PCHAR) hDevNames+hDevNames->wOutputOffset); ItemTemp = hb_itemPutCL(NULL, (PCHAR) hDevNames, sizeof(DEVNAMES)+(LONG) hDevNames->wOutputOffset+lenString); hb_itemArrayPut(Array, 6, ItemTemp); // send the size of the devname structure hb_itemArrayPut(Array, 7, hb_itemPutNL(NULL, (LONG) sizeof(DEVNAMES)+ (LONG) hDevNames->wOutputOffset+lenString)); hb_itemReturn(Array); hb_itemRelease(Array); hb_itemRelease(ItemTemp); if (hPrinter.hDevMode != NULL) { GlobalUnlock(hDevMode); GlobalFree(hPrinter.hDevMode);} if (hPrinter.hDevNames != NULL) { GlobalUnlock(hDevNames); GlobalFree(hPrinter.hDevNames);} } else { hb_ret(); } } //HB_FUNC_STATIC(PSREADFILE) /* Calling parameters: cFilename - name of the file to open hFile - file handle if null open file File is closed when the buffer returns empty */ /*{ UCHAR printBuffer[ BIG_PRINT_BUFFER ] ; HANDLE hFile ; DWORD nRead; IF ISNIL(hFile) hFile = CreateFile( (const char *) cFileName,GENERIC_READ,0,NULL,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,NULL) ; if (hFile != INVALID_HANDLE_VALUE ) { while (ReadFile(hFile, printBuffer, BIG_PRINT_BUFFER, &nRead, NULL) && (nRead > 0)) { if (printBuffer[nRead-1] == 26 ) { nRead-- ; // Skip the EOF() character } WritePrinter(hPrinter, printBuffer, nRead, &nWritten) ; } Result = 1 ; CloseHandle(hFile) ; */ #pragma ENDDUMP #endif //************************************************************************ function _PSSetFont(cFont,nStyle,nPoint,nFColor,nBColor,nAngle,nPitch,vVecTam) /* $DOC$ * $FUNCNAME$ * PSSetFont * $CATEGORY$ * Printing * $ONELINER$ * Set the default font for subsequent printing using PSTextOut or PSTextBox * $SYNTAX$ * PSSetFont([<cFont>, <nStyle>, <nPoint>, <nFColor>, <nBColor>, <nPitch>]) * $ARGUMENTS$ * * Colors can be predefined or RGB colors * * <cFont> Font to use. May be either a PageScript font constant, a valid font name * or a font name as returned by the PSGetFonts() function. * <nStyle> Styles includes bold, italic and so on. * <nPoint> Size of the font in points. * <nFColor> Text Foreground color. * <nBColor> Text Background color. * <nPitch> Set a fixed spacing between characters rounded to the * nearest 0.1 characters per inch. * * $RETURNS$ * Array containing the previous values {cOldFont, nOldStyle, nOldPoint, nOldFColor, nOldBColor} * * $DESCRIPTION$ * * Set the font for subsequent printing using one of the text printing functions. * See PSTRANS.CH for defined colors. * Styles can also be found in PSTRANS.CH * * * $EXAMPLES$ * * * * * * $SEEALSO$ * * $INCLUDE$ * PSTRANS.CH * $END$ */ // Added nPitch which sets the absolute pitch to the nearest .1 characters // per inch LOCAL aReturn LOCAL nBold := FW_NORMAL LOCAL lItalic := .F. LOCAL lUnderline := .F. LOCAL lStrikeOut := .F. IF lInited * return the old values aReturn:={oPrintJob:FontName,oPrintJob:FontStyle,oPrintJob:FontPointSize,; oPrintJob:TextColor,oPrintJob:BkColor,oPrintJob:FontAngle,oPrintJob:Pitch} TRY IF M->xStyFonPsc == "BOLD" oPrintJob:FontStyle= APS_BOLD nStyle := APS_BOLD ELSE oPrintJob:FontStyle = nStyle ENDIF CATCH oPrintJob:FontStyle = nStyle END * Default out the input if needed IF VALTYPE(nStyle)!='N' nStyle=0 ENDIF * Decipher the style IF nStyle % 2 == 1 nBold := FW_BOLD ENDIF IF VALTYPE(nPitch) != 'N' nPitch := 0 ELSE oPrintJob:Pitch := nPitch ENDIF IF nPitch != 0 IF vVecTam == NIL nPitch = {10.2,INT(11*nPitch)} ELSE nPitch := vVecTam // {10.2,INT(14*nPitch)} ENDIF ENDIF lItalic := INT(nStyle/2)%2=1 lUnderLine := INT(nStyle/4)%2=1 lStrikeOut := INT(nStyle/8)%2=1 oPrintJob:SetFont(cFont,nPoint,nPitch,nBold,lUnderLine,lItalic,lStrikeOut,,nAngle) oPrintJob:SetColor(TransColor(nFColor),TransColor(nBColor)) lSaveUnderline=lUnderline ELSE * Fake return aReturn={'Currier New',0,10,0,0,0} lSetFont=.T. * Save for setting later aSaveFont={cFont,nStyle,nPoint,nFColor,nBColor,nAngle,nPitch} ENDIF RETURN aReturn * End of PSSetFont **************************************************************************************************

by **Antonio Linares** » Thu Apr 11, 2024 6:58 am

Esta es la función a la que te refieres:

Donde está el código en C++ que mencionas ?

Code: Select all Expand view RUN: FUNCTION PSPrintFile(cFileName, lDelete, nPrinter, cTitle, nOrientation, ; nCopies, cFont, nNroImp, cNroLog, cCodCia,nNroFor, ; nNueTam,FormType,cNomFil ) /* $DOC$ * $FUNCNAME$ * PSPrintfile * $CATEGORY$ * Printing * $ONELINER$ * Prints a file to the selected printer * $SYNTAX$ * PSPrintFile(cFileName, lDelete, nPrinter, cTitle, nOrientation, ; nCopies, cFont) * $ARGUMENTS$ * cFileName - name of the file including path if not in default folder * lDelete - delete the file when done * nPrinter - index into printer array or -1 to use Windows Print Dialog * cTitle - Title of the print job * nOrientation - either APS_PORTRAIT or APS_LANDSCAPE * nCopies - the number of copies * cFont - The desired font * * $RETURNS$ * lSuccess - success status * $DESCRIPTION$ * * This routine will print a file containing control characters to * change such things a bold, underline and italic characters. One * can also change the pitch of the characters and the number of lines * or characters per inch. The codes defines are shown below: * * APC_STARTBOLD Start bold characters * APC_ENDBOLD End bold * APC_STARTITALIC Start Italics * APC_ENDITALIC End Italics * APC_STARTUNDER Start Underline * APC_ENDUNDER End underline * APC_STARTSTRIKE Start strikethrough * APC_ENDSTRIKE End strikethrough * APC_START10CPI Start Pitch =10 * APC_START12CPI Start Pitch =12 * APC_START15CPI Start Pitch =15 * APC_START17CPI Start Pitch =17 * APC_START18CPI Start Pitch =18 * APC_START20CPI Start Pitch =20 * APC_START6LPI Start Lines Per Inch = 6 * APC_START8LPI Start Lines Per Inch = 8 * APC_EJECT Eject page * APC_STARTFONT Start new font * APC_ENDFONT End the name of the font * APC_LANDSCAPE Print next page in landscape mode * APC_PORTRAIT Print next page in portrait mode * * Changes to the lines per inch value are held until the next page is * started. The name of the font starts with APC_STARTFONT and ends * with APC_ENDFONT. The font stays in effect until set by another command. * Be careful since selecting a proportional font may make the pitch * selection problematic. * * $EXAMPLES$ * * PSInit() * PSPrintFile('MyFile.TXT',-1) * * * $SEEALSO$ * * $INCLUDE$ * * $END$ */ /* Extension: if nPrinter = -1 then use windows print dialog to get printer */ /* Returns lSuccess - status of success */ LOCAL lSuccess:=.F. LOCAL cEsc := CHR(27) LOCAL cCurFont LOCAL nCurLPI LOCAL lBold:=.F., lStrike:=.F., lFont:=.F., lUnder:=.F., lItalic:=.F. LOCAL lLandScape:=.F., lPortrait:=.F., lNewOrient:=.F. LOCAL nPoint, nPitch, nLPI LOCAL nHandle, nLine:=0, cLine, lNewLine, lLineActive, nPos, nPosE LOCAl nR, nC, cTest, nScan, nStyle, nMatch, lForcePitch LOCAL nOldPitch, nOldPoint, cOldFont LOCAL aFonts, lPageActive, cTempFont, lPit16 := .F., lPit18 := .F., vVecTam, lPit10 := .F., lOTRO := .F., lPit06:=.F. LOCAL aFuncs LOCAL cNroImp := STR(nNroImp,1) LOCAL nAjuMarLoc := 0 PRIVATE cEscP10 := CHR(27)+"p" PRIVATE cEscWw10 := CHR(27)+"W" PRIVATE cEscw10 := CHR(27)+"w" PRIVATE EPS_ESC_ESC := CHR(27)+CHR(27) // RESET PRIVATE EPS_RESET := CHR(27)+"@" // RESET PRIVATE EPS_INICIA66 := CHR(27)+"C"+CHR(66) //INICIALIZA PRIVATE EPS_INICIA33 := CHR(27)+"C"+CHR(33) //INICIALIZA PRIVATE EPS_DRA_ON := CHR(27)+"x0" PRIVATE EPS_DRA_OF := CHR(27)+"x1" IF nNueTam == NIL nNueTam := 0 ENDIF IF FormType == NIL FormType := 9 ENDIF IF nNroFor == NIL nNroFor := 99999 ENDIF IF nNroFor == 888 nAjuMarLoc := 5 nTamTex := 20 ENDIF IF cNroImp == NIL cNroImp := "1" ENDIF IF cNroImp == "9" // TODAS LAS GRAFICAS aFuncs :={ {APC_STARTBOLD ,{|| lBold:=.T. },{|| lOTRO:=.T.} },; {APC_ENDBOLD ,{|| lBold:=.F. },{|| lOTRO:=.T.} },; {APC_STARTITALIC ,{|| lItalic:=.T. },{|| lOTRO:=.T.} },; {APC_ENDITALIC ,{|| lItalic:=.F. },{|| lOTRO:=.T.} },; {APC_STARTUNDER ,{|| lUnder:=.T. },{|| lOTRO:=.T.} },; {APC_ENDUNDER ,{|| lUnder:=.F. },{|| lOTRO:=.T.} },; {APC_STARTSTRIKE ,{|| lStrike:=.T. },{|| lOTRO:=.T.} },; {APC_ENDSTRIKE ,{|| lStrike:=.F. },{|| lOTRO:=.T.} },; {APC_START10CPI ,{|| nPitch:=10 },{|| lPit10:=.T.}},; {APC_START12CPI ,{|| nPitch:=13 },{|| lPit16:=.T.}},; // OJO NUEVO CONDENSADO // 13 {APC_START15CPI ,{|| nPitch:=13 },{|| lPit18:=.T.}},; // OJO NUEVO MINICONDENSADO {APC_START17CPI ,{|| nPitch:=17 },{|| lOTRO:=.T.} },; {APC_START18CPI ,{|| nPitch:=18 },{|| lOTRO:=.T.} },; {APC_START20CPI ,{|| nPitch:=20 },{|| lOTRO:=.T.} },; {APC_START21CPI ,{|| nPitch:=21 },{|| lOTRO:=.T.} },; {APC_START6LPI ,{|| nPitch:=8 },{|| lPit06:=.T.} },; {APC_START8LPI ,{|| nLPI:=8 },{|| lOTRO:=.T.} },; {APC_EJECT ,{|| .T. },{|| lOTRO:=.T.} },; {APC_STARTFONT ,{|| lFont:=.T. },{|| lOTRO:=.T.} },; {APC_LANDSCAPE ,{|| lLandScape:=.T.},{|| lOTRO:=.T.} },; {APC_PORTRAIT ,{|| lPortrait:=.T. },{|| lOTRO:=.T.} } } ENDIF IF cNroImp == "1" .OR. cNroImp == "2" .OR. cNroImp == "3" // TODAS LAS EPSON PCL O ESC aFuncs :={ {EPS_PICA ,{|| lEpica := .T. },{|| lOTRO := .T.} },; {EPS_ELITE ,{|| lElite := .T. },{|| lOTRO := .T.} },; {EPS_PROPOR_ON ,{|| lPro_On := .T. },{|| lOTRO := .T.} },; {EPS_PROPOR_OF ,{|| lPro_Of := .T. },{|| lOTRO := .T.} },; {EPS_WITH_ON ,{|| nPitch := 8 },{|| lPit06 := .T.} },; {EPS_WITH_OF ,{|| nPitch := 10 },{|| lPit10 := .T.} },; {EPS_HEIGHT_ON ,{|| lHei_On := .T. },{|| lOTRO := .T.} },; {EPS_HEIGHT_OF ,{|| lHei_Of := .T. },{|| lOTRO := .T.} },; {EPS_STARTBOLD ,{|| lBold := .T. },{|| lOTRO := .T.} },; {EPS_ENDBOLD ,{|| lBold := .F. },{|| lOTRO := .T.} },; {EPS_STARTITALIC ,{|| lItalic := .T. },{|| lOTRO := .T.} },; {EPS_ENDITALIC ,{|| lItalic := .F. },{|| lOTRO := .T.} },; {EPS_STARTUNDER ,{|| lUnder := .T. },{|| lOTRO := .T.} },; {EPS_ENDUNDER ,{|| lUnder := .F. },{|| lOTRO := .T.} },; {EPS_STARTSTRIKE ,{|| lStrike := .T. },{|| lOTRO := .T.} },; {EPS_ENDSTRIKE ,{|| lStrike := .F. },{|| lOTRO := .T.} },; {EPS_START10CPI ,{|| nPitch := 10 },{|| lPit10 := .T.} },; {EPS_START12CPI ,{|| nPitch := 13 },{|| lPit16 := .T.} },; // OJO NUEVO CONDENSADO {EPS_START15CPI ,{|| nPitch := 13 },{|| lPit18 := .T.} },; // OJO NUEVO MINICONDENSADO {EPS_START17CPI ,{|| nPitch := 17 },{|| lOTRO := .T.} },; {EPS_START18CPI ,{|| nPitch := 10 },{|| lPit10 := .T.} },; {EPS_START20CPI ,{|| nPitch := 20 },{|| lOTRO := .T.} },; {EPS_START21CPI ,{|| nPitch := 21 },{|| lOTRO := .T.} },; {EPS_START6LPI ,{|| nPitch := 8 },{|| lPit06 := .T.} },; {EPS_START8LPI ,{|| nLPI := 8 },{|| lOTRO := .T.} },; {EPS_EJECT ,{|| .T. },{|| lOTRO := .T.} },; {EPS_EJECT_NEW ,{|| .T. },{|| lOTRO := .T.} },; {EPS_STARTFONT ,{|| lFont := .T. },{|| lOTRO := .T.} },; {EPS_LANDSCAPE ,{|| lLandScape := .T.},{|| lOTRO := .T.} },; {EPS_PORTRAIT ,{|| lPortrait := .T.},{|| lOTRO := .T.} } } ENDIF IF cNroImp == "4" .OR. cNroImp == "5" // TODAS LAS EPSON PCL O ESC ENDIF * Defaults IF VALTYPE(cTitle)!='C' cTitle='Untitled' ENDIF IF VALTYPE(lDelete)!='L' lDelete=.T. ENDIF IF VALTYPE(nCopies)!='N' nCopies=1 ENDIF /* IF VALTYPE(nOrientation) != 'N' .OR. (nOrientation != APS_PORTRAIT .OR. nOrientation != APS_LANDSCAPE) nOrientation=APS_PORTRAIT ENDIF */ IF nOrientation == NIL nOrientation := 0 // VERTICAL ENDIF IF VALTYPE(cFont)!='C' cFont=APS_COURIER ENDIF cCurFont := cFont * Find out if the file exists IF FILE(cFileName) IF !lInited PSINIT() ENDIF lSuccess=.T. * Open the printer IF PSBeginDoc(nPrinter,cTitle,nOrientation,nCopies,FormType,cNomFil)=0 PSSetUnit(APS_TEXT) PSAsciiToAnsi( .T. ) * Set default number of lines and rows - 6 LPI and 10 CPI nOldPoint := GetPoint(10,cCurFont,.T.) // ALERTA("nOldPoint "+STR(nOldPoint)) IF ( M->nAjuAlt > 0 ) // para impresoras graficas con letra grande .. hp k5400 nOldPoint := 9 ENDIF // _PSSetFont(cCurFont,nStyle,nPoint,APS_BLACK,APS_NONE,0,nPitch) nPitch := 10 nPoint := nOldPoint nStyle := APS_PLAIN cOldFont := cCurFont aFonts := oPrintJob:GetFonts() nCurLPI := 6 nLPI := 6 // ALERTA("nOldPoint "+STR(nPoint)) IF M->nAjuAlt == 2 .OR. M->nAjuAlt == 3 .OR. M->nAjuAlt == 4 .OR. M->nAjuAlt == 5 nCurLPI := 12 nLPI := 12 // para impresoras graficas con letra grande .. hp k5400 ENDIF lPageActive := .F. // OJO NUEVO PARA TAMA�O DE PAGINA IF ( M->nAjuAlt == 0 .OR. M->nAjuAlt == 1 .OR. M->nAjuAlt == 2 ) PSSetRowCol(INT(nLPI*oPrintJob:PrintHeightMM/25.4),; INT(nPitch*oPrintJob:PrintWidthMM/25.4)) ELSEIF ( M->nAjuAlt == 3 .OR. M->nAjuAlt == 4 ) PSSetRowCol(INT(nLPI*oPrintJob:PrintHeightMM/48),; //26.4 INT(nPitch*oPrintJob:PrintWidthMM/25.4)) ELSEIF ( M->nAjuAlt == 5 ) PSSetRowCol( 68,; 160) ELSE // NORMAL PSSetRowCol(INT(nLPI*oPrintJob:PrintHeightMM/26.4),; INT(nPitch*oPrintJob:PrintWidthMM/25.4)) ENDIF // nRow := 70 // nCol := 134 * Open file nHandle = HB_FUSE(cFilename) /* IF ALLTRIM(cNroFor) == "15" .OR. ALLTRIM(cNroFor) == "16" IF ALLTRIM(cNroLog) == "1" // LOGO EN ENCABEZADO DE FACTURA POS IF FILE("\ZERUS\IMAGENES\32X32\LOGOFAC"+cCodCia+".BMP") PSBitMap(1,2,3,21,"\ZERUS\IMAGENES\32X32\LOGOFAC"+cCodCia+".BMP") ENDIF ENDIF ENDIF */ IF nHandle>-1 nLine=-1 * Loop through the file DO WHILE !HB_FEOF() cLine := HB_FREADLN() lNewLine := .F. lLineActive := .F. nLine++ IF EMPTY(cLine) lNewLine=.T. ENDIF DO WHILE !lNewLine nPos := AT(cEsc,cLine) // ENCONTRO SECUENCIAS ESC EN LA POS nPos IF cNroImp == "9" nPosE := AT(APC_EJECT,cLine) // ENCONTRO FIN DE PAGIVA EN LA POS nPosE ELSE nPosE := AT(EPS_EJECT,cLine) // ENCONTRO FIN DE PAGIVA EN LA POS nPosE // ESPON MATRIX ENDIF // PARA IMPRESION DE SOLO TEXTO IF ( nPos == 0 .AND. nPosE == 0 ) IF !lLineActive nR := nLine // ojo ajuste margen izquierdo nC := ( nAjuMarLoc + M->nAjuMar * 9 ) ELSE nR := nC := NIL ENDIF //alerta("nPos == 0 .AND. nPosE == 0 " + cLine) PSTextOut(nR,nC,cLine) //,,APS_LEFT,cCurFont,nStyle,nPoint,APS_BLACK) lNewLine=.T. lLineActive=.F. lPageActive=.T. // PARA AVANZE DE PAGIVA ELSEIF IF(cNroImp == "9", cLine[1] == APC_EJECT,cLine[1] == EPS_EJECT ) PSNewPage() lLineActive := .F. lPageActive := .F. cLine := SUBSTR(cLine,2) nLine := IIF(EMPTY(cLine),-1,0) IF nLPI != nCurLPI.OR.lNewOrient IF ( M->nAjuAlt == 0 .OR. M->nAjuAlt == 1 .OR. M->nAjuAlt == 2 ) PSSetRowCol(INT(nLPI*oPrintJob:PrintHeightMM/25.4),; INT(nPitch*oPrintJob:PrintWidthMM/25.4)) ELSEIF ( M->nAjuAlt == 3 .OR. M->nAjuAlt == 4 ) PSSetRowCol(INT(nLPI*oPrintJob:PrintHeightMM/48),; //26.4 INT(nPitch*oPrintJob:PrintWidthMM/25.4)) ELSEIF ( M->nAjuAlt == 5 ) PSSetRowCol( 68,; 160) ELSE // NORMAL PSSetRowCol(INT(nLPI*oPrintJob:PrintHeightMM/26.4),; INT(nPitch*oPrintJob:PrintWidthMM/25.4)) ENDIF //PSSetRowCol(INT(nLPI*oPrintJob:PrintHeightMM/26.4); // ,INT(nPitch*oPrintJob:PrintWidthMM/25.4)) nCurLPI := nLPI ENDIF lNewOrient=.F. * Escape character is first so we have one or more escape codes ELSEIF cLine[1] == cESC * loop through control characters lForcePitch=.F. DO WHILE cLine != NIL .AND. cLine[1] = cEsc /* cTest := LEFT(cLine,2) nScan := ASCAN(aFuncs,{|a| cTest==a[1]}) cLine := SUBSTR(cLine,3) */ cLine := StrTran( cLine, EPS_RESET , "" ) // QUITA EL @ Y EL TAMA�O DE PAGINA cLine := StrTran( cLine, EPS_INICIA66 , "" ) cLine := StrTran( cLine, EPS_INICIA33 , "" ) cLine := StrTran( cLine, EPS_PROPOR_OF , "" ) cLine := StrTran( cLine, EPS_PICA , "" ) cLine := StrTran( cLine, EPS_ELITE , "" ) cLine := StrTran( cLine, EPS_ESC_ESC , "" ) cLine := StrTran( cLine, EPS_DRA_ON , "" ) cLine := StrTran( cLine, EPS_DRA_OF , "" ) nCanPar := 2 cEscPar := LEFT(cLine,2) IF cEscPar == cEscP10 .OR. ; // PARA QUITAR EL TERCER CARACTER --ESC cEscPar == cEscWW10 .OR. ; cEscPar == cEscW10 nCanPar := 3 ENDIF cTest := LEFT(cLine,nCanPar) nScan := ASCAN(aFuncs,{|a| cTest==a[1]}) cLine := SUBSTR(cLine,nCanPar+1) ////// IF nScan > 0 EVAL(aFuncs[nScan,2]) EVAL(aFuncs[nScan,3]) ENDIF IF lFont nPos := AT(APC_ENDFONT,cLine) IF nPos > 0 cTempFont := LEFT(cLine,nPos-1) * Look for a match in the list nMatch := ASCAN(aFonts,{|a| UPPER(a[1])==UPPER(cTempFont)}) IF nMatch > 0 cCurFont := aFonts[nMatch,1] lForcePitch := .T. ENDIF cLine := SUBSTR(cLine,nPos+2) ENDIF lFont := .F. ELSEIF lLandScape PSSetOrientation(APS_LANDSCAPE) lLandScape=.F. lNewOrient=.T. ELSEIF lPortrait PSSetOrientation(APS_PORTRAIT) lPortrait=.F. lNewOrient=.T. ENDIF ENDDO IF (( nNroFor == 888 .OR. nNroFor == 15 .OR. nNroFor == 16 .OR. ; nNroFor == 23 .OR. nNroFor == 142 ) .AND. nNueTam > 0 ) // CASO ESPECIAL sw_style := 1 IF nNueTam <= 20 // SI ES MENOR A 20 --- 10,12.16,18 ... ES QUE ES CALIDAD NEGRILLA TODO nStyle := APS_BOLD ELSE // SI ES MAYOR A 20 --- 100,120.160,180 ... ES QUE ES CALIDAD NORMAL O TEXTO nStyle := APS_PLAIN nNueTam := ( nNueTam / 10 ) // LO DEJA EN FORMATO 10,12,16,18 ENDIF ELSE nStyle := APS_PLAIN sw_style := 0 IF lBold sw_style := 1 nStyle += APS_BOLD ENDIF IF lUnder sw_style := 1 nStyle += APS_UNDERLINE ENDIF IF lItalic sw_style := 1 nStyle += APS_ITALIC ENDIF IF lStrike sw_style := 1 nStyle += APS_STRIKEOUT ENDIF ENDIF nPoint := nOldPoint IF nOldPitch != nPitch .OR. cOldFont != cCurFont .OR. lForcePitch nPoint=GetPoint(nPitch,cCurFont,.T.) nOldPitch=nPitch //ALERTA(" cCurFont GetPoint "+STR(nPoint)+" "+cCurFont) ENDIF cOldFont=cCurFont // ojo 26.4 por 25.4 IF nLPI != nCurLPI .AND. !lPageActive IF ( M->nAjuAlt == 0 .OR. M->nAjuAlt == 1 .OR. M->nAjuAlt == 2 ) PSSetRowCol(INT(nLPI*oPrintJob:PrintHeightMM/25.4),; INT(nPitch*oPrintJob:PrintWidthMM/25.4)) ELSEIF ( M->nAjuAlt == 3 .OR. M->nAjuAlt == 4 ) PSSetRowCol(INT(nLPI*oPrintJob:PrintHeightMM/48),; //26.4 INT(nPitch*oPrintJob:PrintWidthMM/25.4)) ELSEIF ( M->nAjuAlt == 5 ) PSSetRowCol( 68,; 160) ELSE // NORMAL PSSetRowCol(INT(nLPI*oPrintJob:PrintHeightMM/26.4),; INT(nPitch*oPrintJob:PrintWidthMM/25.4)) ENDIF //PSSetRowCol(INT(nLPI*oPrintJob:PrintHeightMM/26.4); // ,INT(nPitch*oPrintJob:PrintWidthMM/25.4)) nCurLPI := nLPI ENDIF IF (( nNroFor == 888 .OR. nNroFor == 15 .OR. nNroFor == 16 .OR. nNroFor == 23 .OR. nNroFor == 142 ) .AND. nNueTam > 0 ) DO CASE CASE nNueTam == 8 vVecTam := {10,INT((8)*nPitch)} // SEMI GRANDE-NORMAL IF ( M->nAjuAlt > 0 ) nPoint := 8 ENDIF CASE nNueTam == 10 vVecTam := {10.2,INT((11)*nPitch)} // NORMAL IF ( M->nAjuAlt > 0 ) nPoint := 9 ENDIF CASE nNueTam == 12 vVecTam := {10.6,INT((13)*nPitch)} // normal ..peque�a ???? IF ( M->nAjuAlt > 0 ) nPoint := 10 ENDIF CASE nNueTam == 16 vVecTam := {11,INT((16)*nPitch)} // condensado 136 col IF ( M->nAjuAlt > 0 ) nPoint := 11 ENDIF CASE nNueTam == 18 vVecTam := {11,INT((18)*nPitch)} // minicondensado 160 col IF ( M->nAjuAlt > 0 ) nPoint := 11 ENDIF CASE nNueTam == 20 IF nNroFor == 888 nPitch := 12 ENDIF vVecTam := {11,INT((nTamTex)*nPitch)} //fijo IF ( M->nAjuAlt > 0 ) nPoint := 11 ENDIF ENDCASE //ALERTA(" 1er case "+STR(nPoint)) ELSE IF sw_style <= 1 //== 0 // SI CAMBIA ESTILO DEJA EL MISMO TAMA�O IF lPit06 // 7 vVecTam := {10.2,INT((09)*nPitch)} // letra grande IF ( M->nAjuAlt > 1 ) // para impresoras graficas con letra grande .. hp k5400 IF M->nAjuAlt == 4 nPoint := 9 ELSE nPoint := nPoint /2 ENDIF ENDIF ENDIF IF lPit10 // 9 vVecTam := {10.2,INT((11)*nPitch)} // NORMAL IF ( M->nAjuAlt > 1 ) nPoint := 9 ENDIF ENDIF IF lPit16 // 11 vVecTam := {11,INT((16)*nPitch)} // condensado 136 col IF ( M->nAjuAlt > 1 ) nPoint := 11 ENDIF ENDIF IF lPit18 // 11 vVecTam := {11,INT((18)*nPitch)} // minicondensado 160 col IF ( M->nAjuAlt > 1 ) nPoint := 11 ENDIF ENDIF ENDIF //ALERTA(" sw_style "+STR(nPoint)) ENDIF //ALERTA(cLine+ " = " + STR( nPoint) ) _PSSetFont(cCurFont,nStyle,nPoint,APS_BLACK,APS_NONE,0,nPitch,vVecTam) vVecTam := NIL nPitch := nOldPitch lPit10 := lPit16 := lPit18 := lPit06 := .F. // Control character in play so print up to it ELSEIF nPos > 0 .OR. nPosE > 0 IF ( nPosE = 0 .OR. ( nPos > 0 .AND. nPos < nPosE ) ) nPosE := nPos ENDIF IF lLineActive nR := nC := NIL ELSE nR := nLine nC := ( nAjuMarLoc + M->nAjuMar * 9 ) ENDIF //alerta("PSTextOut " + LEFT(cLine,nPosE-1)) PSTextOut(nR,nC ,LEFT(cLine,nPosE-1)) //,,APS_LEFT,cCurFont,nStyle,nPoint,APS_BLACK) lLineActive := .T. cLine := SUBSTR(cLine,nPosE) ENDIF IF EMPTY(cLine) lLineActive = .F. ENDIF ENDDO HB_FSKIP() lNewLine=.F. ENDDO HB_FUSE() ELSE lSuccess=.F. ENDIF PSEndDoc() ENDIF IF lDelete DELETE FILE (cFileName) ENDIF ENDIF RETURN lSuccess

by **russimicro** » Thu Apr 11, 2024 11:48 am

Code: Select all Expand view RUN: FUNCTION PSPRINTFILE() IF PSBeginDoc(nPrinter,cTitle,nOrientation,nCopies,FormType,cNomFil)=0 // leo se baso en WIN32PRN ... oPrintJob := WinPrn32():New(IIF(nPrinter>0,aPrinters[nPrinter],; IIF(nPrinter<0,nPrinter,GetDefaultPrinter())),FormType) ... oPrintJob:StartDoc(cNomFil) ...METHOD StartDoc(cDocName) CLASS WINPRN32 LOCAL Result:= .F. IF cDocName == NIL cDocName:= GetExeFileName()+" ["+DTOC(DATE())+' - '+TIME()+"]" ENDIF //ALERTA(::hPrinterDc) //cDocName := "c:\temp\file.pdf" IF (Result:= StartDoc(::hPrinterDc, cDocName)) IF !(Result:= ::StartPage(::hPrinterDc)) ::EndDoc(.T.) ELSE ::Printing:= .T. ENDIF ENDIF RETURN(Result) ... HB_FUNC_STATIC( STARTDOC ) { HDC hDC = (HDC) hb_parnl(1) ; LPDOCINFO sDoc = NULL; BOOL Result = FALSE ; if (hDC ) { sDoc = (LPDOCINFO) hb_xgrab(sizeof(DOCINFO)); sDoc->cbSize= sizeof(DOCINFO) ; sDoc->lpszDocName= hb_parc(2) ; sDoc->lpszOutput = NULL ; sDoc->lpszDatatype= NULL ; sDoc->fwType = 0 ; Result = (BOOL) (StartDoc(hDC, sDoc) >0 ) ; hb_xfree(sDoc); } hb_retl(Result); }

by **Antonio Linares** » Thu Apr 11, 2024 2:28 pm

What error do you get ?

by **russimicro** » Thu Apr 11, 2024 3:40 pm

Antonio...no tengo error, necesito ver si es posible obtener el archivo generado.. y almacenar

by **Antonio Linares** » Thu Apr 11, 2024 3:56 pm

No lo entiendo. No puedes compilarlo ? Da error al compilar ?

by **russimicro** » Thu Apr 11, 2024 5:17 pm

El código trabaja perfecto, convierte el texto a gráfico y lo manda a la impresora de forma correcto.

Lo que necesito es ver si el archivo generado con esta clase... que hace lo mismo que la clase win32prn, se puede almacenar en disco y no mandar a la impresora,
La necesidad se da porque requiero mandar el archivo resultante a unidades remotas para que allí lo impriman o visualicen.

Code: Select all Expand view RUN: HB_FUNC_STATIC( CREATEDC ) { LONG Result = 0 ; LONG lSize ; HANDLE hPrinter; LPTSTR pszPrinterName; PDEVMODE pDevMode; if (ISCHAR(1)) { pszPrinterName = (char*) hb_parc(1); if (OpenPrinter(pszPrinterName, &hPrinter, NULL)) /* Windows Call */ lSize= DocumentProperties(0,hPrinter,pszPrinterName, pDevMode,pDevMode,0); if (lSize > 0) { pDevMode = (PDEVMODE) hb_xgrab(lSize); DocumentProperties(0,hPrinter,pszPrinterName, pDevMode,pDevMode,DM_OUT_BUFFER); if (ISNUM(2)) { pDevMode->dmCopies = hb_parni(2); pDevMode->dmFields = pDevMode->dmFields | DM_COPIES; } Result = (LONG) CreateDC("",pszPrinterName, NULL, pDevMode) ; hb_storclen((CHAR *) pDevMode, lSize, 3); hb_stornl(lSize, 4); hb_xfree(pDevMode); } } hb_retnl(Result) ; } HB_FUNC_STATIC( STARTDOC ) { HDC hDC = (HDC) hb_parnl(1) ; LPDOCINFO sDoc = NULL; BOOL Result = FALSE ; if (hDC ) { sDoc = (LPDOCINFO) hb_xgrab(sizeof(DOCINFO)); sDoc->cbSize= sizeof(DOCINFO) ; sDoc->lpszDocName= hb_parc(2) ; sDoc->lpszOutput = NULL ; sDoc->lpszDatatype= NULL ; sDoc->fwType = 0 ; Result = (BOOL) (StartDoc(hDC, sDoc) >0 ) ; hb_xfree(sDoc); } hb_retl(Result); } HB_FUNC_STATIC(ENDDOC) { BOOL Result = FALSE; HDC hDC = (HDC) hb_parnl(1) ; if (hDC) { if (ISLOG(2) && hb_parl(2)) { Result = (AbortDoc(hDC) > 0) ; } else { Result = (EndDoc( hDC) > 0) ; } } hb_retnl(Result) ; } HB_FUNC_STATIC( DELETEDC ) { HDC hDC = (HDC) hb_parnl(1) ; if (hDC) { DeleteDC( hDC ) ; } hb_retnl(0) ; // Return zero as a new handle even if fails } HB_FUNC_STATIC(STARTPAGE) { BOOL Result = FALSE ; HDC hDC = (HDC) hb_parnl(1) ; if (hDC) { Result = ( StartPage( hDC ) > 0) ; } hb_retl(Result) ; } HB_FUNC_STATIC(ENDPAGE) { BOOL Result = FALSE ; HDC hDC = (HDC) hb_parnl(1) ; if (hDC) { Result = (EndPage( hDC ) > 0) ; } hb_retl(Result) ; }

by **russimicro** » Fri Apr 19, 2024 9:37 pm

// hb_parc(3) -> "c:\temp\salida.pdf" // la impresora por defecto no pueder ser PDF24 O PDFCREATOR (VIRTUALES)

HB_FUNC_STATIC( STARTDOC )
{
HDC hDC = (HDC) hb_parnl(1) ;
LPDOCINFO sDoc = NULL;
BOOL Result = FALSE ;
if (hDC )

{
sDoc = (LPDOCINFO) hb_xgrab(sizeof(DOCINFO));

sDoc->cbSize= sizeof(DOCINFO) ;
sDoc->lpszDocName= hb_parc(2) ;
sDoc->lpszOutput = hb_parc(3) ;
sDoc->lpszDatatype= NULL ;
sDoc->fwType = 0 ;
Result = (BOOL) (StartDoc(hDC, sDoc) >0 ) ;
hb_xfree(sDoc);
}
hb_retl(Result);
}

FiveTech Software tech support forums

Ayuda C++ : SOLUCIONADO

Ayuda C++ : SOLUCIONADO

Re: Ayuda C++

Re: Ayuda C++

Re: Ayuda C++

Re: Ayuda C++

Re: Ayuda C++

Re: Ayuda C++

Re: Ayuda C++

Re: Ayuda C++

Re: Ayuda C++

Re: Ayuda C++

Re: Ayuda C++

Re: Ayuda C++ : SOLUCIONADO

Who is online