14 de febrero de 2006

Obtener el ID de un tamaño de papel

Como obtener el ID numerico de un formulario de impresión.

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

1 comentario :

  1. Hola.

    He 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.

    ResponderBorrar

Los comentarios son moderados, por lo que pueden demorar varias horas para su publicación.