home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / OS2BAS.ZIP / WINMENU.BAS < prev    next >
BASIC Source File  |  1989-08-27  |  4KB  |  117 lines
  1. '***********************************************************
  2. '* 
  3. '* Program Name: WinMenu.BAS
  4. '*
  5. '* Include File: WinMenu.BI
  6. '*
  7. '* Functions   :
  8. '*               WinCreateMenu   Not Demonstrated,see below
  9. '*               WinLoadMenu
  10. '*
  11. '* Description : This program demonstrates loading a menu
  12. '*               (using WinLoadMenu) from a resource file
  13. '*               (WinMenu.RC).  WinCreateMenu is not 
  14. '*               demonstrated because the menu template type
  15. '*               uses a variant record, which is not possible
  16. '*               in BASIC.  It is advised to use WinLoadMenu,
  17. '*               with a resouce compiled with the RC resource
  18. '*               compiler that comes with the PM Toolkit or
  19. '*               specify the resource ID in WinCreateStdWindow.
  20. '***********************************************************
  21.  
  22. '*********         Initialization section        ***********
  23.  
  24. REM $INCLUDE: 'PMBase.BI'
  25. REM $INCLUDE: 'WinMenu.BI'
  26. REM $INCLUDE: 'BseDosPC.BI'     Needed for DOSBeep
  27. REM $INCLUDE: 'WinMan1.BI'     Needed for WinShowWindow
  28.  
  29. CONST IDRESOURCE = 1        'Constants for Resource File
  30. CONST IDMBEEP     = 2
  31. CONST IDMBEEP1   = 3
  32. CONST IDMBEEP2   = 4
  33. CONST IDMBEEP3   = 5
  34. CONST IDMEXIT    = 6
  35. CONST IDMBYE     = 7 
  36.  
  37. DIM aqmsg AS QMSG
  38.  
  39. flFrameFlags& =  FCFTITLEBAR      OR FCFSYSMENU OR _
  40.                  FCFSIZEBORDER    OR FCFMINMAX  OR _
  41.                  FCFSHELLPOSITION OR FCFTASKLIST
  42.  
  43. szClientClass$ = "ClassName" + CHR$(0)
  44.  
  45. hab&  = WinInitialize    (0)
  46. hmq&  = WinCreateMsgQueue(hab&, 0)
  47.  
  48. bool% = WinRegisterClass(_
  49.         hab&,_
  50.         MakeLong(VARSEG(szClientClass$), SADD(szClientClass$)),_
  51.         RegBas,_
  52.         0,_
  53.         0)
  54.  
  55. hwndFrame& = WinCreateStdWindow (_
  56.              HWNDDESKTOP,_
  57.              WSINVISIBLE,_
  58.              MakeLong(VARSEG(flFrameFlags&),  VARPTR(flFrameFlags&)),_
  59.              MakeLong(VARSEG(szClientClass$), SADD(szClientClass$)),_
  60.              0,_
  61.              0,_
  62.              0,_
  63.              0,_           'Optional: Specify Resource ID here
  64.              MakeLong(VARSEG(hwndClient&), VARPTR(hwndClient&)))
  65.  
  66. '***********          WinLoadMenu          ***************
  67.  
  68. HwndMenu& = WinLoadMenu   (hwndFrame&,0,IDRESOURCE)
  69. Bool%     = WinShowWindow (hwndFrame&,1)
  70.  
  71. '**************         Message loop         ***************
  72.  
  73. WHILE WinGetMsg(hab&, MakeLong(VARSEG(aqmsg), VARPTR(aqmsg)), 0, 0, 0)
  74.   bool% = WinDispatchMsg(hab&, MakeLong(VARSEG(aqmsg), VARPTR(aqmsg)))
  75. WEND
  76.      
  77. '***********         Finalize section        ***************
  78.  
  79. bool% = WinDestroyWindow   (hwndFrame&)
  80. bool% = WinDestroyMsgQueue (hmq&)
  81. bool% = WinTerminate       (hab&)
  82.  
  83. END
  84.  
  85. '***********         Window procedure        ***************
  86.  
  87. FUNCTION ClientWndProc& (hwnd&, msg%, mp1&, mp2&) STATIC
  88.      DIM ClientRect AS RECTL
  89.      ClientWndProc& = 0
  90.      SELECT CASE msg%
  91.      CASE WMPAINT     'Paint the window with background color
  92.         hps&  = WinBeginPaint(hwnd&, 0,_
  93.                 MakeLong(VARSEG(ClientRect), VARPTR(ClientRect)))
  94.         bool% = WinFillRect(hps&,_
  95.                 MakeLong(VARSEG(ClientRect), VARPTR(ClientRect)),0)
  96.         bool% = WinEndPaint(hps&)
  97.      CASE WMCOMMAND    'WMCOMMAND sent for any menu msg
  98.       CALL BreakLong(mp1&, HiWord%, LoWord%)
  99.       SELECT CASE LoWord%       'MenuItem ID is in low word of mp1
  100.                CASE IDMBEEP1
  101.              X% = DosBeep(110,100)
  102.                CASE IDMBEEP2
  103.              X% = DosBeep(110,100)
  104.              X% = DosBeep(220,100)
  105.                CASE IDMBEEP3
  106.              X% = DosBeep(110,100)
  107.              X% = DosBeep(220,100)
  108.              X% = DosBeep(440,100)
  109.                CASE IDMBYE
  110.                      Quit& = WinSendMsg(HWND&,WMClose,0,0)     
  111.            CASE ELSE       'Should never be any other case
  112.       END SELECT
  113.      CASE ELSE        'Pass control to system for other messages
  114.         ClientWndProc& = WinDefWindowProc(hwnd&, msg%, mp1&, mp2&)
  115.      END SELECT
  116. END FUNCTION
  117.