home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / OS2BAS.ZIP / WINACCEL.BAS < prev    next >
Encoding:
BASIC Source File  |  1989-08-27  |  7.8 KB  |  210 lines
  1. '***********************************************************
  2. '* 
  3. '* Program Name: WinAccel.BAS
  4. '*
  5. '* Include File: WinAccel.BI, WinMenu.BI
  6. '*
  7. '* Functions   :
  8. '*               WinCreateMenu        Not Demonstrated,see below
  9. '*               WinLoadMenu
  10. '*               WinLoadAccelTable
  11. '*               WinSetAccelTable
  12. '*               WinQueryAccelTable
  13. '*               WinCopyAccelTable
  14. '*               WinDestroyAccelTable
  15. '*               WinCreateAccelTable
  16. '*               WinTranslateAccel    Not Demonstrated,see below
  17. '*
  18. '* Description : This program demonstrates loading a menu
  19. '*               (using WinLoadMenu) and an accelerator table
  20. '*               (using WinLoad/SetAccelTable) from a resource file
  21. '*               (WinAccel.RC). The accelerator table is dynamically
  22. '*               changed from using CTRL to ALT with 1, 2 and 3.
  23. '*               This utilizes virtually all of the other accelerator
  24. '*               functions (Query,Copy,Destroy and Create) and is
  25. '*               caused by pressing the 2nd button. WinTranslateAccel
  26. '*               is not demonstrated because it is rarely used, as it
  27. '*               states in the documentation for this function in "OS/2
  28. '*               Programmer's Reference Vol II". WinCreateMenu is not
  29. '*               demonstrated due to complexity of creating an area in
  30. '*               data memory to simulate a binary menu-template-resource.
  31. '*               It is advised touse WinLoadMenu, with a resouce compiled
  32. '*               with the RC resource compiler that comes with the PM
  33. '*               Toolkit or specify the resource ID in WinCreateStdWindow.
  34. '***********************************************************
  35.  
  36. '*********         Initialization section        ***********
  37.  
  38. REM $INCLUDE: 'PMBase.BI'
  39. REM $INCLUDE: 'BseDosPC.BI'     Needed for DOSBeep
  40. REM $INCLUDE: 'WinMan1.BI'     Needed for WinShowWindow
  41. REM $INCLUDE: 'WinInput.BI'     Needed for WMBUTTON2DOWN
  42. REM $INCLUDE: 'WinMenu.BI'
  43. REM $INCLUDE: 'WinAccel.BI'
  44.  
  45. TYPE MyACCELTABLE         'Accelerator table with 3 accelerators
  46.   cAccel AS INTEGER
  47.   codepage AS INTEGER
  48.   aaccel0 AS ACCEL
  49.   aaccel1 AS ACCEL
  50.   aaccel2 AS ACCEL
  51. END TYPE
  52.  
  53. CONST IDRESOURCE = 1        'Constants for Resource File
  54. CONST IDMBEEP     = 2
  55. CONST IDMBEEP1   = 3
  56. CONST IDMBEEP2   = 4
  57. CONST IDMBEEP3   = 5
  58. CONST IDMEXIT    = 6
  59. CONST IDMBYE     = 7 
  60. CONST IDACCEL     = 8
  61.  
  62. DIM aqmsg AS QMSG
  63.  
  64. flFrameFlags& =  FCFTITLEBAR      OR FCFSYSMENU OR _
  65.                  FCFSIZEBORDER    OR FCFMINMAX  OR _
  66.                  FCFSHELLPOSITION OR FCFTASKLIST
  67.  
  68. szClientClass$ = "ClassName" + CHR$(0)
  69.  
  70. hab&  = WinInitialize    (0)
  71. hmq&  = WinCreateMsgQueue(hab&, 0)
  72.  
  73. bool% = WinRegisterClass(_
  74.         hab&,_
  75.         MakeLong(VARSEG(szClientClass$), SADD(szClientClass$)),_
  76.         RegBas,_
  77.         0,_
  78.         0)
  79.  
  80. hwndFrame& = WinCreateStdWindow (_
  81.              HWNDDESKTOP,_
  82.              WSINVISIBLE,_
  83.              MakeLong(VARSEG(flFrameFlags&),  VARPTR(flFrameFlags&)),_
  84.              MakeLong(VARSEG(szClientClass$), SADD(szClientClass$)),_
  85.              0,_
  86.              0,_
  87.              0,_
  88.              0,_           'Optional: Specify Resource ID here
  89.              MakeLong(VARSEG(hwndClient&), VARPTR(hwndClient&)))
  90.  
  91. '***********      WinLoad/SetAccelTable    *****************
  92.  
  93. OPEN "WinAccel.OUT" FOR OUTPUT AS #1
  94.  
  95. DIM pAccelTable AS MyACCELTABLE        'Needed for Copy and CreateAccel
  96.  
  97. '*** WinLoadAccelTable returns a handle to an accelerator from a resource file
  98.    hAccel& = WinLoadAccelTable (hab&, 0, IDACCEL)
  99.    PRINT #1,"WinLoadAccelTable:", HEX$(hAccel&)
  100.  
  101. '*** WinSetAccelTable is required to associate an accelerator with a window
  102.    bool%  =  WinSetAccelTable (hab&, hAccel&, hwndFrame&)
  103.    PRINT #1,"WinSetAccelTable:",bool%
  104.  
  105.    hAccel& = 0          'Reset handle to make Query be necessary
  106.  
  107. '***********          WinLoadMenu          *****************
  108.  
  109. hMenu& = WinLoadMenu (hwndFrame&, 0, IDRESOURCE)
  110. Bool%  = WinShowWindow (hwndFrame&, 1)
  111.  
  112. '**************         Message loop         ***************
  113.  
  114. WHILE WinGetMsg(hab&, MakeLong(VARSEG(aqmsg), VARPTR(aqmsg)), 0, 0, 0)
  115.  
  116. '*** Check for button here (instead of ClientWndProc) to keep the anchor
  117. '    block handle available for Accel functions.
  118.   IF aqmsg.msg = WMBUTTON2DOWN THEN         'Change AccelTable on button 2
  119.  
  120. '*** WinQueryAccelTable returns accelerator handle for the window
  121.     hAccel& =  WinQueryAccelTable(hab&, hwndFrame&)
  122.     PRINT #1, "WinQueryAccelTable:", HEX$(hAccel&)
  123.  
  124. '*** WinCopyAccelTable copies the accelerator table for hAccel& to pAccelTable
  125.     size% = WinCopyAccelTable(hAccel&,_
  126.             MakeLong(VARSEG(pAccelTable), VARPTR(pAccelTable)),_
  127.             LEN(pAccelTable))
  128.     PRINT #1, "WinCopyAccelTable:",size%
  129.     PRINT #1, "AccelTable:"
  130.     PRINT #1, "cAccel:    ";pAccelTable.cAccel
  131.     PRINT #1, "codepage:  ";pAccelTable.codepage
  132.     PRINT #1, "Table entries: "
  133.     PRINT #1, "     Entry #";1
  134.     PRINT #1, "       Flags:   ";HEX$(pAccelTable.aaccel0.fs)
  135.     PRINT #1, "       Key:     ";CHR$(pAccelTable.aaccel0.akey)
  136.     PRINT #1, "       Command: ";pAccelTable.aaccel0.cmd
  137.     PRINT #1, "     Entry #";2
  138.     PRINT #1, "       Flags:   ";HEX$(pAccelTable.aaccel1.fs)
  139.     PRINT #1, "       Key:     ";CHR$(pAccelTable.aaccel1.akey)
  140.     PRINT #1, "       Command: ";pAccelTable.aaccel1.cmd
  141.     PRINT #1, "     Entry #";3
  142.     PRINT #1, "       Flags:   ";HEX$(pAccelTable.aaccel2.fs)
  143.     PRINT #1, "       Key:     ";CHR$(pAccelTable.aaccel2.akey)
  144.     PRINT #1, "       Command: ";pAccelTable.aaccel2.cmd
  145.     PRINT #1, ""
  146.  
  147. '*** WinDestroyAccelTable destroys current accelerator table so new can be made
  148.     bool%   =  WinDestroyAccelTable (hAccel&)
  149.     PRINT #1, "WinDestroyAccelTable:", bool%
  150.  
  151. '*** Change accelerator from CTRL n to ALT n
  152.     pAccelTable.aaccel0.fs = AFALT OR AFCHAR
  153.     pAccelTable.aaccel1.fs = AFALT OR AFCHAR
  154.     pAccelTable.aaccel2.fs = AFALT OR AFCHAR
  155.  
  156. '*** WinCreateAccelTable returns handle for new accelerator table
  157.     hAccel& = WinCreateAccelTable(hab&,_
  158.               MakeLong(VARSEG(pAccelTable), VARPTR(pAccelTable)))
  159.     PRINT #1, "WinCreateAccelTable:", HEX$(hAccel&)
  160.  
  161. '*** WinSetAccelTable is required to associate an accelerator with a window
  162.     bool%  =  WinSetAccelTable (hab&, hAccel&, hwndFrame&)
  163.     PRINT #1,"WinSetAccelTable:", bool%
  164.   END IF
  165.   bool% = WinDispatchMsg(hab&, MakeLong(VARSEG(aqmsg), VARPTR(aqmsg)))
  166. WEND
  167.      
  168. '***********         Finalize section        ***************
  169.  
  170. CLOSE #1
  171.  
  172. bool% = WinDestroyWindow   (hwndFrame&)
  173. bool% = WinDestroyMsgQueue (hmq&)
  174. bool% = WinTerminate       (hab&)
  175.  
  176. END
  177.  
  178. '***********         Window procedure        ***************
  179.  
  180. FUNCTION ClientWndProc& (hwnd&, msg%, mp1&, mp2&) STATIC
  181.      DIM ClientRect AS RECTL
  182.      ClientWndProc& = 0
  183.      SELECT CASE msg%
  184.      CASE WMPAINT     'Paint the window with background color
  185.         hps&  = WinBeginPaint(hwnd&, 0,_
  186.                 MakeLong(VARSEG(ClientRect), VARPTR(ClientRect)))
  187.         bool% = WinFillRect(hps&,_
  188.                 MakeLong(VARSEG(ClientRect), VARPTR(ClientRect)),0)
  189.         bool% = WinEndPaint(hps&)
  190.      CASE WMCOMMAND    'WMCOMMAND sent for any menu msg
  191.       CALL BreakLong(mp1&, HiWord%, LoWord%)
  192.       SELECT CASE LoWord%       'MenuItem ID is in low word of mp1
  193.                CASE IDMBEEP1
  194.              X% = DosBeep(110,100)
  195.                CASE IDMBEEP2
  196.              X% = DosBeep(110,100)
  197.              X% = DosBeep(220,100)
  198.                CASE IDMBEEP3
  199.              X% = DosBeep(110,100)
  200.              X% = DosBeep(220,100)
  201.              X% = DosBeep(440,100)
  202.                CASE IDMBYE
  203.                      Quit& = WinSendMsg(HWND&,WMClose,0,0)     
  204.            CASE ELSE       'Should never be any other case
  205.       END SELECT
  206.      CASE ELSE        'Pass control to system for other messages
  207.         ClientWndProc& = WinDefWindowProc(hwnd&, msg%, mp1&, mp2&)
  208.      END SELECT
  209. END FUNCTION
  210.