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