Printerschacht.p 3.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101
  1. /* =================================================================
  2. file : printbins.p
  3. dd : 15.11.2006
  4. purpose : Returns an array of Printer Bins and Bin Names
  5. by : Ildefonzo Arocha
  6. usage : See Example below
  7. tested : Tested in Windows 2003 Server, OE 10.1A,
  8. Brother HL-1250,
  9. HP Color LaserJet 4550 and HP 4250 Tr.
  10. Note : Runs in earlier versions of Progress, just change
  11. the indeterminate array to something else of your choice
  12. (comma-delimited list, etc)
  13. ================================================================= */
  14. /********** Test Block *********/
  15. DEFINE VARIABLE iNumBins AS INTEGER NO-UNDO.
  16. DEFINE VARIABLE iaBinID AS CHARACTER NO-UNDO EXTENT.
  17. DEFINE VARIABLE caBinNames AS CHARACTER NO-UNDO EXTENT.
  18. DEFINE VARIABLE iBin AS INTEGER NO-UNDO.
  19. RUN GetPrinterBins( SESSION:PRINTER-NAME ,
  20. SESSION:PRINTER-PORT ,
  21. OUTPUT iNumBins ,
  22. OUTPUT iaBinID ,
  23. OUTPUT caBinNames ).
  24. REPEAT iBin = 1 TO iNumBins:
  25. DISPLAY
  26. iaBinID[ iBin ] " = " caBinNames[ iBin ] FORMAT "X(30)" .
  27. END.
  28. /********** End Test Block *********/
  29. PROCEDURE GetPrinterBins:
  30. DEFINE INPUT PARAMETER pcPrinterName AS CHARACTER NO-UNDO.
  31. DEFINE INPUT PARAMETER pcPrinterPort AS CHARACTER NO-UNDO.
  32. DEFINE OUTPUT PARAMETER piNumBins AS INTEGER NO-UNDO.
  33. /* Set our extent to 20 bins! Warning: Under windows, some printers
  34. allow you to define virtual bins for different types of papers, which
  35. means this procedure will return more bins than you expect */
  36. DEFINE OUTPUT PARAMETER piaBinIDs AS INTEGER NO-UNDO EXTENT 40.
  37. DEFINE OUTPUT PARAMETER pcaBinNames AS CHARACTER NO-UNDO EXTENT 40.
  38. DEFINE VARIABLE mBins AS MEMPTR NO-UNDO.
  39. DEFINE VARIABLE mBinNames AS MEMPTR NO-UNDO.
  40. DEFINE VARIABLE iTmp AS INTEGER NO-UNDO.
  41. &SCOPED MAXBINNAMESIZE 24
  42. &SCOPED WORD 2
  43. /* First get the number of bins, with it we correctly
  44. allocate enough memory for the arrays */
  45. RUN DeviceCapabilities( pcPrinterName ,
  46. pcPrinterPort ,
  47. 6 , /*DC_BINS*/
  48. 0,
  49. 0 ,
  50. OUTPUT piNumBins ).
  51. IF piNumBins < 1 THEN DO:
  52. piNumBins = 0.
  53. RETURN.
  54. END.
  55. /* mBins will be filled with an array of Bin IDs */
  56. SET-SIZE( mBins ) = piNumBins * {&WORD}.
  57. RUN DeviceCapabilities( pcPrinterName ,
  58. pcPrinterPort ,
  59. 6 , /*DC_BINS*/
  60. GET-POINTER-VALUE( mBins ),
  61. 0 ,
  62. OUTPUT piNumBins ).
  63. /* mBinNames is filled with an array of Bin Names */
  64. SET-SIZE( mBinNames ) = {&MAXBINNAMESIZE} * piNumBins.
  65. RUN DeviceCapabilities( pcPrinterName ,
  66. pcPrinterPort ,
  67. 12 , /* DB_BINNAMES */
  68. GET-POINTER-VALUE( mBinNames ),
  69. 0 ,
  70. OUTPUT piNumBins ).
  71. /* Parse our return values and store it in an easy to read array */
  72. DO iTmp = 0 TO piNumBins - 1:
  73. ASSIGN
  74. piaBinIDs[ 1 + iTmp ] = GET-SHORT( mBins , 1 + ( iTmp * {&WORD} ) )
  75. pcaBinNames[ 1 + iTmp ] = GET-STRING( mBinNames , 1 + ( iTmp * {&MAXBINNAMESIZE} ) ).
  76. END.
  77. SET-SIZE( mBins ) = 0.
  78. SET-SIZE( mBinNames ) = 0.
  79. END PROCEDURE.
  80. PROCEDURE DeviceCapabilities EXTERNAL "Winspool.drv":U:
  81. DEFINE INPUT PARAMETER pDevice AS CHARACTER.
  82. DEFINE INPUT PARAMETER pPort AS CHARACTER.
  83. DEFINE INPUT PARAMETER fwCapability AS LONG.
  84. DEFINE INPUT PARAMETER pOutput AS LONG.
  85. DEFINE INPUT PARAMETER pDevMode AS LONG.
  86. DEFINE RETURN PARAMETER pResult AS LONG.
  87. END.