llreturn = .F. tcform = "Half-Sheet" tcPrinter = GETPRINTER() IF verforms(tcform, tcprinter) lnformnum = GetFormSize(tcform, tcprinter) IF TYPE('lnformnum')="N" .and. lnformnum > 0 =MESSAGEBOX("Half-Sheet form number is: "+ALLTRIM(STR(lnformnum))+CHR(13); +"That value will have to be added to the db_memo.frx"+CHR(13); +"by adding the PAPERSIZE = "+ALLTRIM(STR(lnformnum))+CHR(13); +"to the Expr Memo field.",0+4096,'SUCCESS') llreturn = .T. ELSE =MESSAGEBOX('Could not determine Half-sheet form number!',0+16+4096,'ERROR') ENDIF ENDIF RETURN llreturn PROCEDURE verforms(tcform, tcprinter) IF TYPE('tcform')<> "C" .or. EMPTY(tcform) RETURN .F. ENDIF IF TYPE('tcprinter')<>"C" .or. EMPTY(tcprinter) RETURN .F. ENDIF *--Verify Printer Forms (Windows 2000 and Windows XP) not required for 95/98 *--Notes *--The getprinter() call would be replaced with the windows printer name determined *--by the PrintSet() call we make in the app. *--If the form does not exist, it creates it and if it exists it just returns .t. *--and performs no action. *Testing only clear screen CLEAR #DEFINE DC_PAPERS 2 #DEFINE DC_SIZE 8 #DEFINE DC_VERSION 10 #DEFINE DC_PAPERNAMES 16 DECLARE INTEGER DeviceCapabilities IN winspool.drv; STRING pDevice, STRING pPort, INTEGER fwCapability,; STRING @pOutput, INTEGER pDevMode LOCAL lcBuffer, lnCount, lnIndex, lcName lcBuffer = Repli(Chr(0), 16384) * provide valid printer and port names lcprinter = tcprinter lnCount = DeviceCapabilities(lcprinter, "",; DC_PAPERNAMES, @lcBuffer, 0) * each string buffer is 64 characters long * and contains the name of a paper form ACTIVATE screen llfoundit = .F. FOR lnIndex=1 To lnCount lcName = SUBSTR(lcBuffer, (lnIndex-1)*64+1, 64) + Chr(0) lcName = SUBSTR(lcName, 1, AT(Chr(0), lcName)-1) IF UPPER(ALLTRIM(lcName))=UPPER(ALLTRIM(tcform)) llfoundit = .T. ENDIF * ? lcName ENDFOR IF !llfoundit ooapi = NEWOBJECT("AddPrinterForm") IF NOT ooapi.AddForm(tcform, 8.5, 5.5, lcPrinter) * Error lcmessage= ooapi.cErrorMessage lcmessage=lcmessage+CHR(13)+ooapi.cApiErrorMessage =MESSAGEBOX(lcmessage,0+16+4096,'An Error Ocurred.') ELSE *!* *Delete it since I created it for testing purposes only *!* IF NOT ooapi.DeleteForm(tcform,lcprinter) *!* * Error *!* lcmessage= ooapi.cErrorMessage *!* lcmessage=lcmessage+CHR(13)+ooapi.cApiErrorMessage *!* =MESSAGEBOX(lcmessage,0+16+4096,'An Error Ocurred.') *!* ELSE llfoundit = .T. *!* ENDIF ENDIF ooapi = Null RELEASE ooapi ENDIF *!* ooapi = NEWOBJECT("AddPrinterForm") *!* *Delete it since I created it for testing purposes only *!* IF NOT ooapi.DeleteForm(tcform,lcprinter) *!* * Error *!* lcmessage= ooapi.cErrorMessage *!* lcmessage=lcmessage+CHR(13)+ooapi.cApiErrorMessage *!* =MESSAGEBOX(lcmessage,0+16+4096,'An Error Ocurred.') *!* ELSE *!* =MESSAGEBOX('Deleted the form: '+tcform,0+64+4096,'SUCCESS') *!* ENDIF *!* ooapi = NULL *!* RELEASE ooapi RETURN llfoundit *---------------------------------------------------------------------------------------- * All sizes in inches *AddPrinterFormClass.prg DEFINE CLASS AddPrinterForm AS Custom HIDDEN cUnit, cPrinterName, nFormHeight, nFormWidth, nLeftMargin, ; nTopMargin, nRightMargin, nBottomMargin, ; nInch2mm, nCm2mm, nCoefficient, hHeap cUnit = "English" && inches or Metric - cm's cPrinterName = "" nFormHeight = 0 nFormWidth = 0 nLeftMargin = 0 nTopMargin = 0 nRightMargin = 0 nBottomMargin = 0 nApiErrorCode = 0 cApiErrorMessage = "" cErrorMessage = "" nInch2mm = 25.4 nCm2mm = 10 nCoefficient = 0 hHeap = 0 PROCEDURE Init(tcUnit) IF PCOUNT() = 1 AND INLIST(tcUnit, "English", "Metric") This.cUnit = PROPER(tcUnit) ENDIF This.LoadApiDlls() This.hHeap = HeapCreate(0, 4096, 0) * Use Windows default printer This.cPrinterName = SET("Printer",2) This.nCoefficient = IIF(PROPER(This.cUnit) = "English", ; This.nInch2mm, This.nCm2mm) * 1000 ENDPROC PROCEDURE Destroy IF This.hHeap <> 0 HeapDestroy(This.hHeap) ENDIF ENDPROC PROCEDURE SetFormMargins(tnLeft, tnTop, tnRight, tnBottom) WITH This .nLeftMargin = tnLeft * .nCoefficient .nTopMargin = tnTop * .nCoefficient .nRightMargin = tnRight * .nCoefficient .nBottomMargin = tnBottom * .nCoefficient ENDWITH ENDPROC PROCEDURE AddForm(tcFormName, tnWidth, tnHeight, tcPrinterName) LOCAL lhPrinter, llSuccess, lcForm This.nFormWidth = tnWidth * This.nCoefficient This.nFormHeight = tnHeight * This.nCoefficient IF PCOUNT() > 3 This.cPrinterName = tcPrinterName ENDIF This.ClearErrors() lhPrinter = 0 IF OpenPrinter(This.cPrinterName, @lhPrinter, 0) = 0 This.cErrorMessage = "Unable to get printer handle for '" ; + This.cPrinterName + "." This.nApiErrorCode = GetLastError() This.cApiErrorMessage = This.ApiErrorText(This.nApiErrorCode) RETURN .F. ENDIF lnFormName = HeapAlloc(This.hHeap, 0, LEN(tcFormName) + 1) = SYS(2600, lnFormName, LEN(tcFormName) + 1, tcFormName + CHR(0)) * Build FORM_INFO_1 structure WITH This lcForm = This.Num2LOng(0) + ; && Flags This.Num2LOng(lnFormName) + ; This.Num2LOng(.nFormWidth) + ; This.Num2LOng(.nFormHeight) + ; This.Num2LOng(.nLeftMargin) + ; This.Num2LOng(.nTopMargin) + ; This.Num2LOng(.nFormWidth - .nRightMargin) + ; This.Num2LOng(.nFormHeight - .nBottomMargin) ENDWITH * Finally, call the API IF AddForm(lhPrinter, 1, @lcForm) = 0 This.cErrorMessage = "Unable to Add Form '" + tcFormName + "'." This.nApiErrorCode = GetLastError() This.cApiErrorMessage = This.ApiErrorText(This.nApiErrorCode) llSuccess = .F. ELSE llSuccess = .T. ENDIF = HeapFree(This.hHeap, 0, lnFormName) = ClosePrinter(lhPrinter) RETURN llSuccess PROCEDURE ClearErrors This.cErrorMessage = "" This.nApiErrorCode = 0 This.cApiErrorMessage = "" ENDPROC PROCEDURE DeleteForm(tcFormName, tcPrinterName) LOCAL lhPrinter, llSuccess IF PCOUNT() > 1 This.cPrinterName = tcPrinterName ENDIF This.ClearErrors() lhPrinter = 0 IF OpenPrinter(This.cPrinterName, @lhPrinter, 0) = 0 This.cErrorMessage = "Unable to get printer handle for '" + This.cPrinterName + "." This.nApiErrorCode = GetLastError() This.cApiErrorMessage = This.ApiErrorText(This.nApiErrorCode) RETURN .F. ENDIF * Finally, call the API IF DeleteForm(lhPrinter, tcFormName) = 0 This.cErrorMessage = "Unable to delete Form '" + tcFormName + "'." This.nApiErrorCode = GetLastError() This.cApiErrorMessage = This.ApiErrorText(This.nApiErrorCode) llSuccess = .F. ELSE llSuccess = .T. ENDIF = ClosePrinter(lhPrinter) RETURN llSuccess FUNCTION Num2LOng(tnNum) DECLARE RtlMoveMemory IN WIN32API AS RtlCopyLong ; STRING @Dest, Long @Source, Long Length LOCAL lcString lcString = SPACE(4) =RtlCopyLong(@lcString, BITOR(tnNum,0), 4) RETURN lcString ENDFUNC FUNCTION Long2Num(tcLong) DECLARE RtlMoveMemory IN WIN32API AS RtlCopyNum ; Long @Dest, String @Source, Long Length LOCAL lnNum lnNum = 0 = RtlCopyNum(@lnNum, tcLong, 4) RETURN lnNum ENDFUNC HIDDEN PROCEDURE ApiErrorText LPARAMETERS tnErrorCode Local lcErrBuffer lcErrBuffer = REPL(CHR(0),1024) = FormatMessage(0x1000 ,.NULL., tnErrorCode, 0, @lcErrBuffer, 1024,0) RETURN STRTRAN(LEFT(lcErrBuffer, AT(CHR(0),lcErrBuffer)- 1 ), ; "file", "form", -1, -1, 3) ENDPROC HIDDEN PROCEDURE LoadApiDlls DECLARE INTEGER OpenPrinter IN winspool.drv; STRING pPrinterName,; INTEGER @phPrinter,; INTEGER pDefault DECLARE INTEGER ClosePrinter IN winspool.drv; INTEGER hPrinter DECLARE INTEGER AddForm IN winspool.drv; INTEGER hPrinter,; INTEGER LEVEL,; STRING @pForm DECLARE INTEGER DeleteForm IN winspool.drv; INTEGER hPrinter,; STRING pFormName DECLARE INTEGER HeapCreate IN Win32API; INTEGER dwOptions, INTEGER dwInitialSize,; INTEGER dwMaxSize DECLARE INTEGER HeapAlloc IN Win32API; INTEGER hHeap, INTEGER dwFlags, INTEGER dwBytes DECLARE lstrcpy IN Win32API; STRING @lpstring1, INTEGER lpstring2 DECLARE INTEGER HeapFree IN Win32API; INTEGER hHeap, INTEGER dwFlags, INTEGER lpMem DECLARE HeapDestroy IN Win32API; INTEGER hHeap DECLARE INTEGER GetLastError IN kernel32 Declare Integer FormatMessage In kernel32.dll ; Integer dwFlags, String @lpSource, ; Integer dwMessageId, Integer dwLanguageId, ; String @lpBuffer, Integer nSize, Integer Arguments ENDPROC ENDDEFINE *------------------------------------------------------------------ FUNCTION getformsize(tcform, tcprinter) IF TYPE('tcform')<> "C" .or. EMPTY(tcform) RETURN .F. ENDIF IF TYPE('tcprinter')<>"C" .or. EMPTY(tcprinter) RETURN .F. ENDIF * Form flag values #define FORM_USER 0x00000000 #define FORM_BUILTIN 0x00000001 #define FORM_PRINTER 0x00000002 ooo = NEWOBJECT("EnumForms") * Enumerate forms on local PC lcPrinter = "" * Enumerate forms for default VFP printer *lcPrinter = SET("Printer",3) * Enumerate forms for specified Windows printer *lcPrinter = "Acrobat Distiller" lcPrinter = tcprinter IF NOT ooo.GetFormList(lcPrinter) * ? ooo.cErrorMessage * ? ooo.cApiErrorMessage * Error ENDIF lnreturn = 0 FOR i=1 TO ooo.oFormList.Count loOneForm = ooo.oFormList.Item(i) *?loOneForm.FormID, loOneForm.FormName, loOneForm.Width, loOneForm.Height, loOneForm.FormFlags IF loOneForm.FormName=tcform lnreturn = loOneForm.FormID *WAIT WINDOW "tcform form number is: "+ALLTRIM(STR(loOneform.FormID)) ENDIF ENDFOR ooo = Null RETURN lnreturn *-------------------------------------------- * EnumPrinterFormClass.prg DEFINE CLASS EnumForms AS Custom HIDDEN hHeap, nInch2mm, nCm2mm, nCoefficient * Specified a Printer name for which the list of supported forms is retrieved * If empty, retrieved the list of formds defined on local PC cPrinterName = "" * The form attributes are stored in in thousandths of millimeters * It can be coverted by class to inches ("English") or centimeters ("Metric") cUnit = "Internal" * Specified how to round result of conversion nRound = 0 * Conversion Coefficients nInch2mm = 25.4 nCm2mm = 10 nCoefficient = 0 * Error code and Error message returned by Win API nApiErrorCode = 0 cApiErrorMessage = "" * Error message returned by class itself (none-API error) cErrorMessage = "" hHeap = 0 * Collection of Print Forms retrieved oFormList = Null PROCEDURE Init(tcUnit, tnRound) IF PCOUNT() >= 1 AND INLIST(tcUnit, "English", "Metric") This.cUnit = PROPER(tcUnit) ENDIF IF PCOUNT() = 2 This.nRound = tnRound ENDIF This.oFormList = CREATEOBJECT("Collection") * Load DLLs This.LoadApiDlls() * Allocate a heap This.hHeap = HeapCreate(0, 4096*10, 0) * Calculate conversion coefficient DO CASE CASE PROPER(This.cUnit) = "English" This.nCoefficient = This.nInch2mm * 1000 CASE PROPER(This.cUnit) = "Metric" This.nCoefficient = This.nCm2mm * 1000 OTHERWISE This.cUnit = "Internal" This.nCoefficient = 1 ENDCASE ENDPROC PROCEDURE Destroy IF This.hHeap <> 0 HeapDestroy(This.hHeap) ENDIF ENDPROC PROCEDURE GetFormList(tcPrinterName) LOCAL lhPrinter, llSuccess, lnNeeded, lnNumberOfForms, lnBuffer, i IF PCOUNT() > 0 This.cPrinterName = tcPrinterName ENDIF This.ClearErrors() * Open a printer lhPrinter = 0 lcPrinterName = This.cPrinterName IF EMPTY(lcPrinterName) lnResult = OpenPrinter(0, @lhPrinter, 0) ELSE lnResult = OpenPrinter(@lcPrinterName, @lhPrinter, 0) ENDIF IF lnResult = 0 This.cErrorMessage = "Unable to get printer handle for '" ; + This.cPrinterName + "'." This.nApiErrorCode = GetLastError() This.cApiErrorMessage = This.ApiErrorText(This.nApiErrorCode) RETURN .F. ENDIF lnNeeded = 0 lnNumberOfForms = 0 * Get the size of the buffer required to fit all forms in lnNeeded IF EnumForms(lhPrinter, 1, 0, 0, ; @lnNeeded, @lnNumberOfForms ) = 0 IF GetLastError() <> 122 && The buffer too small error This.cErrorMessage = "Unable to Enumerate Forms." This.nApiErrorCode = GetLastError() This.cApiErrorMessage = This.ApiErrorText(This.nApiErrorCode) RETURN .F. ENDIF ENDIF * Get the list of forms lnBuffer = HeapAlloc(This.hHeap, 0, lnNeeded) llSuccess = .T. IF EnumForms(lhPrinter, 1, lnBuffer, @lnNeeded, ; @lnNeeded, @lnNumberOfForms ) = 0 This.cErrorMessage = "Unable to Enumerate Forms." This.nApiErrorCode = GetLastError() This.cApiErrorMessage = This.ApiErrorText(This.nApiErrorCode) llSuccess = .F. ENDIF IF llSuccess * Put list of the forms into collection with Form number (i) as a key * A collection here can be replaced with an array or a cursor. FOR i=1 TO lnNumberOfForms loOneForm = This.OneFormObj() WITH loOneForm lnPointer = lnBuffer + (i-1) * 32 .FormID = i .FormFlags = This.Long2NumFromBuffer(lnPointer) .FormName = This.StrZFromBuffer(lnPointer+4) .Width = ROUND(This.Long2NumFromBuffer(lnPointer+8) / ; This.nCoefficient, This.nRound) .Height = ROUND(This.Long2NumFromBuffer(lnPointer+12) / ; This.nCoefficient, This.nRound) .Left = ROUND(This.Long2NumFromBuffer(lnPointer+16) / ; This.nCoefficient, This.nRound) .Top = ROUND(This.Long2NumFromBuffer(lnPointer+20) / ; This.nCoefficient, This.nRound) .Right = ROUND(This.Long2NumFromBuffer(lnPointer+24) / ; This.nCoefficient, This.nRound) .Bottom = ROUND(This.Long2NumFromBuffer(lnPointer+28) / ; This.nCoefficient, This.nRound) ENDWITH This.oFormList.Add(loOneForm, TRANSFORM(i)) ENDFOR ENDIF = HeapFree(This.hHeap, 0, lnBuffer ) = ClosePrinter(lhPrinter) RETURN llSuccess * Create an object with forms attributes PROCEDURE OneFormObj LOCAL loOneForm loOneForm = NEWOBJECT("Empty") ADDPROPERTY(loOneForm, "FormFlags", 0) ADDPROPERTY(loOneForm, "FormId", 0) ADDPROPERTY(loOneForm, "FormName", "") ADDPROPERTY(loOneForm, "Width", 0) ADDPROPERTY(loOneForm, "Height", 0) ADDPROPERTY(loOneForm, "Left", 0) ADDPROPERTY(loOneForm, "Top", 0) ADDPROPERTY(loOneForm, "Right", 0) ADDPROPERTY(loOneForm, "Bottom", 0) RETURN loOneForm ENDPROC PROCEDURE ClearErrors This.cErrorMessage = "" This.nApiErrorCode = 0 This.cApiErrorMessage = "" ENDPROC * Retrieve zero-terminated string from a buffer into VFP variable PROCEDURE StrZFromBuffer(tnPointer) LOCAL lcStr, lnStrPointer lcStr = SPACE(256) lnStrPointer = 0 = RtlCopy(@lnStrPointer, tnPointer, 4) lstrcpy(@lcStr, lnStrPointer) RETURN LEFT(lcStr, AT(CHR(0),lcStr)-1) ENDPROC * Convert Long integer into VFP numeric variable PROCEDURE Long2NumFromBuffer(tnPointer) LOCAL lnNum lnNum = 0 = RtlCopy(@lnNum, tnPointer, 4) RETURN lnNum ENDPROC * Converts VFP number to the Long integer FUNCTION Num2LOng(tnNum) DECLARE RtlMoveMemory IN WIN32API AS RtlCopyLong ; STRING @Dest, Long @Source, Long Length LOCAL lcString lcString = SPACE(4) =RtlCopyLong(@lcString, BITOR(tnNum,0), 4) RETURN lcString ENDFUNC * Convert Long integer into VFP numeric variable FUNCTION Long2Num(tcLong) DECLARE RtlMoveMemory IN WIN32API AS AS RtlCopyNum ; Long @Dest, String @Source, Long Length LOCAL lnNum lnNum = 0 = RtlCopyNum(@lnNum, tcLong, 4) RETURN lnNum ENDFUNC HIDDEN PROCEDURE ApiErrorText LPARAMETERS tnErrorCode Local lcErrBuffer lcErrBuffer = REPL(CHR(0),1024) = FormatMessage(0x1000 ,.NULL., tnErrorCode, 0, @lcErrBuffer, 1024,0) RETURN LEFT(lcErrBuffer, AT(CHR(0),lcErrBuffer)- 1 ) ENDPROC HIDDEN PROCEDURE LoadApiDlls DECLARE INTEGER OpenPrinter IN winspool.drv; STRING @pPrinterName,; INTEGER @phPrinter,; INTEGER pDefault DECLARE INTEGER ClosePrinter IN winspool.drv; INTEGER hPrinter DECLARE LONG EnumForms IN winspool.drv AS EnumForms ; LONG hPrinter, LONG Level, LONG pForm, ; LONG cbBuf, LONG @pcbNeeded, ; LONG @ pcReturned DECLARE INTEGER HeapCreate IN Win32API; INTEGER dwOptions, INTEGER dwInitialSize,; INTEGER dwMaxSize DECLARE INTEGER HeapAlloc IN Win32API; INTEGER hHeap, INTEGER dwFlags, INTEGER dwBytes DECLARE lstrcpy IN Win32API; STRING @lpstring1, INTEGER lpstring2 DECLARE INTEGER HeapFree IN Win32API; INTEGER hHeap, INTEGER dwFlags, INTEGER lpMem DECLARE HeapDestroy IN Win32API; INTEGER hHeap DECLARE RtlMoveMemory IN WIN32API AS RtlCopy ; Long @Dest, Long Source, Long Length DECLARE lstrcpy IN Win32API; STRING @lpstring1, INTEGER lpstring2 DECLARE INTEGER GetLastError IN kernel32 Declare Integer FormatMessage In kernel32.dll ; Integer dwFlags, String @lpSource, ; Integer dwMessageId, Integer dwLanguageId, ; String @lpBuffer, Integer nSize, Integer Arguments ENDPROC ENDDEFINE>Tracy,