The Bereznikers

CLEAR
 
&& Form flag values
#define FORM_USER       0x00000000
#define FORM_BUILTIN    0x00000001
#define FORM_PRINTER    0x00000002
ooo = NEWOBJECT("EnumForms", "EnumPrinterForms.fxp")
ooo.cUnit = "English"
ooo.nRound = 2
 
&& 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"
 
IF NOT ooo.GetFormList(lcPrinter, "Envelope")
	? ooo.cErrorMessage
	? ooo.cApiErrorMessage
	&& Error
ENDIF
 
? ooo.cFormName, ooo.nFormNumber
 
FOR i=1 TO ooo.oFormList.Count
	loOneForm = ooo.oFormList.Item(i)
	? loOneForm.FormID, loOneForm.FormName, loOneForm.Width, loOneForm.Height, loOneForm.FormFlags
ENDFOR
ooo = Null
RETURN
&&------------------------------------------------------------------------
 
&& EnumPrinterForm.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, it would retrieve the list of forms defined on local PC
	cPrinterName = ""
	&& The form attributes are stored in thousands of millimeters
	&& It can be converted 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 = 1
 
	&& Error code and Error message returned by Win API
	cApiErrorMessage = ""
	&& Error message returned by class itself (none-API error)
	cErrorMessage = ""
 
	hHeap = 0
	&& Collection of Print Forms retrieved
	oFormList = Null
	&& Win API support class
	oWas = NULL
 
	&& Store Form # for the form
	cFormName = ""
	nFormNumber = 0
 
	PROCEDURE Init(tcUnit, tnRound)
 
	IF PCOUNT() >= 1 
		This.cUnit = PROPER(tcUnit)
	ENDIF
	IF PCOUNT() = 2
		This.nRound = tnRound
	ENDIF
	This.oFormList = CREATEOBJECT("Collection")
	This.oWas = NEWOBJECT("WinApiSupport", "WinApiSupport.fxp")
 
	&& Load DLLs
	This.LoadApiDlls()
	&& Allocate a heap
	This.hHeap = HeapCreate(0, 4096*10, 0)
	ENDPROC
 
	PROCEDURE cUnit_Assign(tcUnit)
	IF INLIST(tcUnit, "English", "Metric", "Internal")
		This.cUnit = PROPER(tcUnit)
	ELSE
		RETURN	
	ENDIF
	&& 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 GetFormNumber(tcPrinterName, tcFormName)
	&&ENDPROC
 
	PROCEDURE GetFormList(tcPrinterName, tcFormName)
	LOCAL lhPrinter, llSuccess, lnNeeded, lnNumberOfForms, lnBuffer, i, lcFormName, lcFormName 
 
	IF NOT EMPTY(tcPrinterName)
		This.cPrinterName = tcPrinterName
	ENDIF	
 
	&&This.cFormName = ""
	IF NOT EMPTY(tcFormName)
		This.cFormName = tcFormName
	ENDIF
 
	This.ClearErrors()
	This.nFormNumber = 0
	This.oFormList.Remove(-1)
 
	&& Open a printer
	lhPrinter = 0
	lcPrinterName = This.cPrinterName
	lnResult = OpenPrinter( IIF(EMPTY(lcPrinterName),0,lcPrinterName), @lhPrinter, 0)
 
	IF  lnResult = 0
		This.cErrorMessage = "Unable to get printer handle for '" + This.cPrinterName 
		This.cApiErrorMessage = WinApiErrMsg(GetLastError())
		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.cApiErrorMessage = WinApiErrMsg(GetLastError())
			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.cApiErrorMessage = WinApiErrMsg(GetLastError())
		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.oWas.Long2NumFromBuffer(lnPointer)
				.FormName 	= This.oWas.StrZFromBuffer(lnPointer+4)
				.Width 		= This.ConvertFormDimension(lnPointer+8) 
				.Height		= This.ConvertFormDimension(lnPointer+12)
				.Left 		= This.ConvertFormDimension(lnPointer+16)
				.Top 		= This.ConvertFormDimension(lnPointer+20)
				.Right 		= This.ConvertFormDimension(lnPointer+24)
				.Bottom 	= This.ConvertFormDimension(lnPointer+28)
				&& Store form # for requested form
				IF UPPER(.FormName) == UPPER(This.cFormName )
					This.nFormNumber = .FormID
				ENDIF
 
			ENDWITH
			This.oFormList.Add(loOneForm, TRANSFORM(i))
		ENDFOR
	ENDIF
 
	= HeapFree(This.hHeap, 0, lnBuffer )
	= ClosePrinter(lhPrinter)
 
	RETURN llSuccess
 
	FUNCTION ConvertFormDimension(tnPointer)
		RETURN ROUND(This.oWas.Long2NumFromBuffer(tnPointer) / This.nCoefficient, This.nRound)
	ENDFUNC
 
	&& 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.cApiErrorMessage = ""
	ENDPROC
 
	HIDDEN PROCEDURE LoadApiDlls
		DECLARE Long HeapCreate IN WIN32API Long dwOptions, Long dwInitialSize, Long dwMaxSize
		DECLARE Long HeapAlloc IN WIN32API Long hHeap, Long dwFlags, Long dwBytes
		DECLARE Long HeapFree IN WIN32API Long hHeap, Long dwFlags, Long lpMem
		DECLARE HeapDestroy IN WIN32API Long hHeap
		DECLARE Long GetLastError IN kernel32
	ENDPROC
 
ENDDEFINE
&&----------------------------------------------------------------------------------------------
 
FUNCTION OpenPrinter(tcPrinterName, thPrinter, tcDefault)
DECLARE Long OpenPrinter IN WinSpool.Drv ;
	String pPrinterName, Long @ phPrinter, String pDefault
RETURN 	OpenPrinter(tcPrinterName, @thPrinter, tcDefault)
 
FUNCTION ClosePrinter (thPrinter)
DECLARE Long ClosePrinter IN WinSpool.Drv Long hPrinter
RETURN ClosePrinter(thPrinter)
 
FUNCTION EnumForms(thPrinter, tnLevel, tnForm, tnBuf, tnNeeded, tnReturned)
DECLARE Long EnumForms IN winspool.drv ;
	Long hPrinter, Long Level, Long pForm, ;
	Long cbBuf, Long @pcbNeeded, Long @ pcReturned
RETURN EnumForms(thPrinter, tnLevel, tnForm, tnBuf, @tnNeeded, @tnReturned)