Ayuda C++ : SOLUCIONADO
-
- Posts: 262
- Joined: Sun Jan 31, 2010 3:30 pm
- Location: Bucaramanga - Colombia
Ayuda C++ : SOLUCIONADO
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
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
Last edited by russimicro on Fri Apr 19, 2024 9:39 pm, edited 1 time in total.
- Antonio Linares
- Site Admin
- Posts: 42273
- Joined: Thu Oct 06, 2005 5:47 pm
- Location: Spain
- Contact:
Re: Ayuda C++
Estimado Jonsson,
Copio aqui su contenido: (primera parte)
Copio aqui su contenido: (primera parte)
Code: Select all | Expand
/* 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
// _
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
- Antonio Linares
- Site Admin
- Posts: 42273
- Joined: Thu Oct 06, 2005 5:47 pm
- Location: Spain
- Contact:
Re: Ayuda C++
(segunda parte)
Code: Select all | Expand
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
- Antonio Linares
- Site Admin
- Posts: 42273
- Joined: Thu Oct 06, 2005 5:47 pm
- Location: Spain
- Contact:
Re: Ayuda C++
(tercera parte)
Code: Select all | Expand
//**********************************************************************************************
// 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'
- Antonio Linares
- Site Admin
- Posts: 42273
- Joined: Thu Oct 06, 2005 5:47 pm
- Location: Spain
- Contact:
Re: Ayuda C++
(cuarta parte)
Code: Select all | Expand
// 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) ;
}
- Antonio Linares
- Site Admin
- Posts: 42273
- Joined: Thu Oct 06, 2005 5:47 pm
- Location: Spain
- Contact:
Re: Ayuda C++
(quinta parte)
Code: Select all | Expand
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
**************************************************************************************************
- Antonio Linares
- Site Admin
- Posts: 42273
- Joined: Thu Oct 06, 2005 5:47 pm
- Location: Spain
- Contact:
Re: Ayuda C++
Esta es la función a la que te refieres:
Donde está el código en C++ que mencionas ?
Donde está el código en C++ que mencionas ?
Code: Select all | Expand
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
-
- Posts: 262
- Joined: Sun Jan 31, 2010 3:30 pm
- Location: Bucaramanga - Colombia
Re: Ayuda C++
Code: Select all | Expand
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);
}
- Antonio Linares
- Site Admin
- Posts: 42273
- Joined: Thu Oct 06, 2005 5:47 pm
- Location: Spain
- Contact:
-
- Posts: 262
- Joined: Sun Jan 31, 2010 3:30 pm
- Location: Bucaramanga - Colombia
Re: Ayuda C++
Antonio...no tengo error, necesito ver si es posible obtener el archivo generado.. y almacenar
- Antonio Linares
- Site Admin
- Posts: 42273
- Joined: Thu Oct 06, 2005 5:47 pm
- Location: Spain
- Contact:
Re: Ayuda C++
No lo entiendo. No puedes compilarlo ? Da error al compilar ?
-
- Posts: 262
- Joined: Sun Jan 31, 2010 3:30 pm
- Location: Bucaramanga - Colombia
Re: Ayuda C++
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.
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
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) ;
}
-
- Posts: 262
- Joined: Sun Jan 31, 2010 3:30 pm
- Location: Bucaramanga - Colombia
Re: Ayuda C++ : SOLUCIONADO
// 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);
}
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);
}