Clase EnumPrinterFormsClass de Sergey Berezniker (originalmente publicada en Universalthread
http://www.universalthread.com/wconnect/wc.dll?2,84,13,5 FAQ ID: 22445).
NOTA: Necesita VFP8 o superior
************************************************************ * Funcion: PrintFormID * Obtiene el ID de un formulario de impresión * Parametros: * tcImpresora - Nombre de la Impresora, "" tomar los forms del PC * tcFormulario - Nombre del formulario personalizado previamente creado * tlsilencioso - En modo silencioso * Ejemplos: * lnret = PrintFormID("", "100x80") * lnret = PrintFormID("HP Laser", "100x80",.T.) * Retorno * >0 - correcto, devuelve el ID del formulario * -1 - Error, no se pudo obtener la lista de formularios de impresion * -2 - Error, formulario no encontrado * Notas * Creación : 14/02/2006 Pablo Roca * Ultima Modificacion: 14/02/2006 Pablo Roca ************************************************************ FUNCTION PrintFormID(tcImpresora, tcFormulario, tlsilencioso) LOCAL loPrintForm, lnret, i LOCAL loForm, lnForm, lcLabel LOCAL lalineas(1), lcst, llret lcst = "" lnForm = 0 loPrintForm = NEWOBJECT("EnumForms", "EnumPrinterFormsClass.fxp") * obtenemos la lista de formularios IF NOT loPrintForm.GetFormList(tcImpresora) * no se puede obtener la lista de formularios lnret = -1 IF !tlsilencioso MESSAGEBOX("No se pudo obtener la lista de formularios de impresión.",16,"ATENCION") ENDIF ELSE * recorremos la lista de formularios buscando nuestro formulario FOR i=1 TO loPrintForm.oFormList.Count loForm = loPrintForm.oFormList.Item(i) IF loForm.FormName = tcFormulario lnForm = loForm.FormID EXIT ENDIF ENDFOR IF lnForm <> 0 lnret = lnForm ELSE * formulario no encontrado lnret = -2 IF !tlsilencioso MESSAGEBOX("Formulario ("+tcFormulario+") no encontrado.",16,"ATENCION") ENDIF ENDIF ENDIF loPrintForm = NULL RETURN lnret ENDFUNC
Ahora la clase EnumPrinterForms:
*-------------------------------------------- * EnumPrinterFormsClass.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 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
Pablo Roca
Hola.
ResponderBorrarHe utilizado una variación de esta solución para imprimir formularios con altura variable. Localizo un ID de impresión con la altura que necesito, le asigno el ID al FRX y funciona perfectamente bien, pero en una LAN.
Cuando tengo todo instalado en un escritorio remoto es otra cosa, puesto que no puedo obtener el ID de la computadora local, cuando la impresión viaja hacia la impresora local con el ID que encontró en el servidor, cualquier cosa puede pasar, generalmente, imprimirá con las especificaciones que tenga la computadora local asociada al ID que se le envía.
¿Te han planteado este problema? Traté de plantearlo a Sergey Berezniker desde su blog pero no encontré como registrarme.