home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / OS2BAS.ZIP / PMDEV.BAS < prev    next >
BASIC Source File  |  1989-08-26  |  10KB  |  268 lines
  1. '***********************************************************
  2. '* 
  3. '* Program Name: PMDev.BAS
  4. '*
  5. '* Include File: PMDev.BI
  6. '*
  7. '* Functions   :
  8. '*               DevOpenDC
  9. '*               DevCloseDC
  10. '*               DevEscape
  11. '*               DevQueryCaps
  12. '*               DevQueryHardcopyCaps
  13. '*               DevQueryDeviceNames
  14. '*               DevPostDeviceModes
  15. '*
  16. '* Description : This program demonstrates the device functions.
  17. '*               It opens a device context for the printer,
  18. '*               queries the various values, prints text and
  19. '*               graphics, and closes the device context.
  20. '*
  21. '*               NOTE: The output looks correct only with
  22. '*                     printers compatible with the IBM 4201
  23. '*                     Proprinter.
  24. '*
  25. '*               NOTE: This form of printing is VERY slow in
  26. '*                     OS/2 Version 1.1.  For normal text
  27. '*                     printing (no fonts), LPRINT or OPEN
  28. '*                     "LPT1:"... will be much faster.
  29. '***********************************************************
  30.  
  31. '*********         Initialization section        ***********
  32.  
  33. REM $INCLUDE: 'PMBase.BI'
  34. REM $INCLUDE: 'PMDev.BI'
  35. REM $INCLUDE: 'PMShl.BI'
  36. REM $INCLUDE: 'OS2Def.BI'
  37. REM $INCLUDE: 'WinErr.BI'
  38. REM $INCLUDE: 'GpiCont.BI'
  39. REM $INCLUDE: 'GpiChar.BI'
  40. DECLARE FUNCTION  GpiLoadBitmap&(BYVAL hps&, BYVAL hmod%, BYVAL id%, BYVAL lw&, BYVAL lh&)
  41. DECLARE FUNCTION  GpiBox&( BYVAL HPS AS LONG,_
  42.                BYVAL ALONG AS LONG,_
  43.                BYVAL PPOINTL AS LONG,_
  44.                BYVAL BLONG AS LONG,_
  45.                BYVAL CLONG AS LONG )
  46. DECLARE FUNCTION WinDrawBitmap%(BYVAL hpsDst AS LONG,_
  47.                                 BYVAL hbm AS LONG,_
  48.                                 BYVAL pwrcSrc AS LONG,_
  49.                                 BYVAL pptlDst AS LONG,_
  50.                                 BYVAL clrFore AS LONG,_
  51.                                 BYVAL clrBack AS LONG,_
  52.                                 BYVAL fs AS INTEGER)
  53.  
  54.  
  55. CONST MAXPRINTLEN = 1024
  56. CONST MAXSTRINGLEN = 512
  57.  
  58. DIM aqmsg AS QMSG
  59.  
  60. flFrameFlags& =  FCFTITLEBAR      OR FCFSYSMENU OR _
  61.                  FCFSIZEBORDER    OR FCFMINMAX  OR _
  62.                  FCFSHELLPOSITION OR FCFTASKLIST
  63.  
  64. szClientClass$ = "ClassName" + CHR$(0)
  65.  
  66. hab&  = WinInitialize    (0)
  67. hmq&  = WinCreateMsgQueue(hab&, 0)
  68.  
  69. bool% = WinRegisterClass(_
  70.         hab&,_
  71.         MakeLong(VARSEG(szClientClass$), SADD(szClientClass$)),_
  72.         RegBas,_
  73.         0,_
  74.         0)
  75.  
  76. hwndFrame& = WinCreateStdWindow (_
  77.              HWNDDESKTOP,_
  78.              WSVISIBLE,_
  79.              MakeLong (VARSEG(flFrameFlags&),  VARPTR(flFrameFlags&)),_
  80.              MakeLong (VARSEG(szClientClass$), SADD(szClientClass$)),_
  81.              0,_
  82.              0,_
  83.              0,_
  84.              0,_
  85.              MakeLong (VARSEG(hwndClient&), VARPTR(hwndClient&)))
  86.  
  87. '*********         PMDev Functions       ***********
  88.  
  89. OPEN "PMDev.OUT" FOR OUTPUT AS #1
  90.  
  91.    'Set up strings for WinQueryProfileString for port
  92.    PmSpooler$  = "PM_SPOOLER"        + CHR$(0)
  93.    Printer$    = "PRINTER"           + CHR$(0)
  94.    szPrinter$  = SPACE$(MAXPRINTLEN) + CHR$(0)
  95.    NullString$ = CHR$(0)
  96.  
  97.    'Get printer port
  98.    cch% = WinQueryProfileString(hab&,_
  99.           MakeLong(VARSEG(PmSpooler$),  SADD(PmSpooler$)),_
  100.           MakeLong(VARSEG(Printer$),    SADD(Printer$)),_
  101.           MakeLong(VARSEG(NullString$), SADD(NullString$)),_
  102.           MakeLong(VARSEG(szPrinter$),  SADD(szPrinter$)),_
  103.           MAXPRINTLEN)
  104.  
  105.    'Set up strings for WinQueryProfileString for details
  106.    szPrinter$ = LEFT$(szPrinter$,cch% - 2)+ CHR$(0)   'Remove last semicolon
  107.    PmSpooler$ = "PM_SPOOLER_PRINTER"      + CHR$(0)
  108.    szDetails$ = SPACE$(MAXPRINTLEN)       + CHR$(0)
  109.  
  110.    'Get printer details
  111.    cch% = WinQueryProfileString(hab&,_
  112.           MakeLong(VARSEG(PmSpooler$),  SADD(PmSpooler$)),_
  113.           MakeLong(VARSEG(szPrinter$),  SADD(szPrinter$)),_
  114.           MakeLong(VARSEG(NullString$), SADD(NullString$)),_
  115.           MakeLong(VARSEG(szDetails$),  SADD(szDetails$)),_
  116.           MAXPRINTLEN)
  117.  
  118.    'search for semicolon delimeters
  119.    first%  = INSTR(szDetails$, ";")
  120.    second% = INSTR(first%  + 1, szDetails$, ";")
  121.    third%  = INSTR(second% + 1, szDetails$, ";")
  122.  
  123.    'Driver is between 1st & 2nd semicolons. Logical address between 2nd & 3rd
  124.    Driver$     = MID$(szDetails$, first%  + 1, second% - first%  - 1) + CHR$(0)
  125.    LogAddress$ = MID$(szDetails$, second% + 1, third%  - second% - 1) + CHR$(0)
  126.    PRINT #1, "WinQueryProfileString:"
  127.    PRINT #1, "","Driver:",  Driver$
  128.    PRINT #1, "","Address:", LogAddress$
  129.  
  130.    '**** DevPostDeviceModes brings up dialog box; print info to file
  131.    DIM dd AS DRIVDATA
  132.    size& = DevPostDeviceModes(hab&,_
  133.            MakeLong(VARSEG(dd),          VARPTR(dd)),_
  134.            MakeLong(VARSEG(Driver$),     SADD(Driver$)), 0,_
  135.            MakeLong(VARSEG(LogAddress$), SADD(LogAddress$)), 0)
  136.    PRINT #1, "DevPostDeviceModes:", size&
  137.    PRINT #1, "", "cb:",             HEX$(dd.cb)
  138.    PRINT #1, "", "lVersion:",       HEX$(dd.lVersion)
  139.    PRINT #1, "", "szDeviceName:",   dd.szDeviceName
  140.    PRINT #1, "", "abGeneralData:",  dd.abGeneralData
  141.  
  142.    '**** DevQueryDeviceNames should return number of names and types,
  143.    '**   according to the function specifications, but there seems to
  144.    '**   be a problem with this function due to limited device names
  145.    '**   with the initial release.
  146.  
  147.    DIM achDeviceName AS STRING * 32
  148.    DIM achDeviceDesc AS STRING * 64
  149.    DIM achDataType   AS STRING * 16
  150.    pcMaxNames&       =  0
  151.    pcMaxDataTypes&   =  0
  152.    bool% = DevQueryDeviceNames(hab&,_
  153.            MakeLong(VARSEG(Driver$),         SADD(Driver$)),_
  154.            MakeLong(VARSEG(pcMaxNames&),     VARPTR(pcMaxNames&)),_
  155.            MakeLong(VARSEG(achDeviceName),   VARPTR(achDeviceName)),_
  156.            MakeLong(VARSEG(achDeviceDesc),   VARPTR(achDeviceDesc)),_
  157.            MakeLong(VARSEG(pcMaxDataTypes&), VARPTR(pcMaxDataTypes&)),_
  158.            MakeLong(VARSEG(achDataType),     VARPTR(achDataType)))
  159.    PRINT #1, "DevQueryDeviceNames:", bool%
  160.    PRINT #1, "", "MaxNames:",        pcMaxNames&
  161.    PRINT #1, "", "MaxTypes:",        pcMaxDataTypes&
  162.  
  163.    '**** DevOpenDC opens device context for printer
  164.    DIM dop AS DEVOPENSTRUC
  165.    dop.pszLogAddress = MakeLong(VARSEG(LogAddress$), SADD(LogAddress$))
  166.    dop.pszDriverName = MakeLong(VARSEG(Driver$),     SADD(Driver$))
  167.    dop.pdriv         = 0
  168.    dop.pszDataType   = 0
  169.    devInfo$          = "*" + CHR$(0)
  170.    hdcPrinter& = DevOpenDC(hab&, ODQUEUED,_
  171.                  MakeLong(VARSEG(devInfo$), SADD(devInfo$)), 4,_
  172.                  MakeLong(VARSEG(dop),      VARPTR(dop)),    0)
  173.       PRINT #1, "DevOpenDC:", HEX$(hdcPrinter&)
  174.  
  175.       '**** DevQueryCaps get height and width of printer page
  176.       bool% = DevQueryCaps(hdcPrinter&, CAPSHEIGHT, 1,_
  177.               MakeLong(VARSEG(h&), VARPTR(h&)))
  178.       bool% = DevQueryCaps(hdcPrinter&, CAPSWIDTH, 1,_
  179.               MakeLong(VARSEG(w&), VARPTR(w&)))
  180.       PRINT #1, "DevQueryCaps:", "("; w&; ","; h&; ")"
  181.  
  182.       '**** DevEscape starts the printer document
  183.       szBuf$ = SPACE$(MAXSTRINGLEN) + CHR$(0)
  184.       bool% = DevEscape(hdcPrinter&,   DEVESCSTARTDOC, MAXSTRINGLEN,_
  185.               MakeLong(VARSEG(szBuf&), SADD(szBuf$)),  0, 0)
  186.       PRINT #1, "DevEscape:",bool%
  187.  
  188.       '**** DevQueryHardcopyCaps returns the number of forms for device
  189.       DIM hci AS HCINFO
  190.       numForms& = DevQueryHardcopyCaps&(hdcPrinter&, 0, 0,_
  191.                   MakeLong(VARSEG(hci), VARPTR(hci)))
  192.       PRINT #1, "DevQueryHardcopyCaps:", numForms&
  193.  
  194.       'Create presentation space and put graphics and text to printer
  195.       DIM szl AS SIZEL
  196.       szl.cx = 0
  197.       szl.cy = 0
  198.       hpsPrinter& = GpiCreatePS(hab&, hdcPrinter&,_
  199.                     MakeLong(VARSEG(szl), VARPTR(szl)),_
  200.                     PUPELS OR GPIFDEFAULT OR GPITNORMAL OR GPIAASSOC)
  201.          PRINT #1, "GpiCreatePS: ",HEX$(hpsPrinter&)
  202.  
  203.          'Text
  204.          DIM ptl AS POINTL
  205.          ptl.x  = 10
  206.          ptl.y  = h& - 20
  207.          hello$ = "Hello from Presentation Manager!!!" + CHR$(0)
  208.          bool%  = GpiCharStringAt(hpsPrinter&,_
  209.                   MakeLong(VARSEG(ptl),    VARPTR(ptl)), LEN(hello$) - 1,_
  210.                   MakeLong(VARSEG(hello$), SADD(hello$)))
  211.  
  212.          'Box
  213.          ptl.y = ptl.y - 20
  214.          bool% = GpiBox(hpsPrinter&, 2,_
  215.                  MakeLong(VARSEG(ptl), VARPTR(ptl)), 0, 0)
  216.  
  217.          'Bitmap
  218.          hbmp& = GpiLoadBitmap(hpsPrinter&, 0, 1, 0, 0)
  219.          bool% = WinDrawBitmap(hpsPrinter&, hbmp&, 0,_
  220.                  MakeLong(VARSEG(ptl), VARPTR(ptl)), 1, 2, 0)
  221.  
  222.          'Disassociate and destroy the presentation space
  223.          bool% = GpiAssociate(hpsPrinter&, 0)
  224.       bool% = GpiDestroyPS(hpsPrinter&)
  225.  
  226.       '**** DevEscape ends document
  227.       szBuf$ = SPACE$(MAXSTRINGLEN) + CHR$(0)
  228.       bool% = DevEscape(hdcPrinter&, DEVESCENDDOC, 0, 0, MAXSTRINGLEN,_
  229.               MakeLong(VARSEG(szBuf&), SADD(szBuf$)))
  230.       PRINT #1, "DevEscape:",bool%
  231.  
  232.    '**** DevCloseDC closes printer device context
  233.    hmf& = DevCloseDC(hdcPrinter&)
  234.    PRINT #1, "DevCloseDC:",hmf&
  235.  
  236. '**************         Message loop         ***************
  237.  
  238. WHILE WinGetMsg(hab&, MakeLong(VARSEG(aqmsg), VARPTR(aqmsg)), 0, 0, 0)
  239.   bool% = WinDispatchMsg(hab&, MakeLong(VARSEG(aqmsg), VARPTR(aqmsg)))
  240. WEND
  241.  
  242. '***********         Finalize section        ***************
  243.  
  244. CLOSE #1
  245.  
  246. bool% = WinDestroyWindow  (hwndFrame&)
  247. bool% = WinDestroyMsgQueue(hmq&)
  248. bool% = WinTerminate      (hab&)
  249.  
  250. END
  251.  
  252. '***********         Window procedure        ***************
  253.  
  254. FUNCTION ClientWndProc& (hwnd&, msg%, mp1&, mp2&) STATIC
  255.      DIM ClientRect AS RECTL
  256.      ClientWndProc& = 0
  257.      SELECT CASE msg%
  258.      CASE WMPAINT     'Paint the window with background color
  259.         hps&  = WinBeginPaint(hwnd&, 0,_
  260.                 MakeLong(VARSEG(ClientRect), VARPTR(ClientRect)))
  261.         bool% = WinFillRect  (hps&,_
  262.                 MakeLong(VARSEG(ClientRect), VARPTR(ClientRect)),0)
  263.         bool% = WinEndPaint  (hps&)
  264.      CASE ELSE        'Pass control to system for other messages
  265.         ClientWndProc& = WinDefWindowProc(hwnd&, msg%, mp1&, mp2&)
  266.      END SELECT
  267. END FUNCTION
  268.