home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / OS2BAS.ZIP / DEMO3.BAS < prev    next >
BASIC Source File  |  1989-07-30  |  8KB  |  213 lines
  1. '***********************************************************
  2. '* 
  3. '* Program Name: Demo3.BAS
  4. '*
  5. '* Description : This is the fully-converted version of
  6. '*               Demo3.BAS. It takes advantage of more PM
  7. '*               features. Specifically, it uses a menu
  8. '*               and message box instead of using WinPrint
  9. '*               and WinInkey$ for I/O.
  10. '*
  11. '* Changes:      Menu and message instead of WinPrint/Inkey
  12. '*               ClientWndProc modified for menu and msg box
  13. '*               Main control shifted from WMPAINT to WMCOMMAND
  14. '*               flFrameFlags& added OR FCFMENU
  15. '*               WinCreateStdWindow added IDMENU
  16. '*               Menu routine changed
  17. '*               FOR loops removed in sound routines
  18. '***********************************************************
  19.  
  20. '*********         Initialization section        ***********
  21.  
  22. REM $INCLUDE: 'PMBase.BI'
  23. REM $INCLUDE: 'WinMisc.BI'
  24. REM $INCLUDE: 'WinDialg.BI'      Needed for WinMessageBox
  25. REM $INCLUDE: 'BseDosPC.BI'      Needed for DosBeep
  26. CONST MsPerTick = 1000 / 18     'Needed to convert SOUND units to DosBeep
  27. CONST IDMENU       = 1            'Constants for Resource File
  28. CONST IDMSOUND     = 2
  29. CONST IDMBOUNCING  = 3
  30. CONST IDMFALLING   = 4
  31. CONST IDMKLAXON    = 5
  32. CONST IDMSIREN     = 6
  33. CONST IDMQUIT      = 7
  34.  
  35. DIM aqmsg AS QMSG
  36. COMMON SHARED /HANDLE/ Hab&,hwndClient&
  37.  
  38. flFrameFlags& = FCFTITLEBAR      OR FCFSYSMENU OR _
  39.                 FCFSIZEBORDER    OR FCFMINMAX  OR _
  40.                 FCFSHELLPOSITION OR FCFTASKLIST OR_
  41.                 FCFMENU
  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.           WSVISIBLE,_
  58.           MakeLong (VARSEG(flFrameFlags&), VARPTR(flFrameFlags&)),_
  59.           MakeLong (VARSEG(szClientClass$), SADD(szClientClass$)),_
  60.           0,_
  61.           0,_
  62.           0,_
  63.           IDMENU,_
  64.           MakeLong (VARSEG(hwndClient&), VARPTR(hwndClient&)))
  65.  
  66. '**************         Message loop         ***************
  67.  
  68. WHILE WinGetMsg(hab&,_
  69.        MakeLong(VARSEG(aqmsg), VARPTR(aqmsg)), 0, 0, 0)
  70.   bool% = WinDispatchMsg(hab&,_
  71.               MakeLong(VARSEG(aqmsg), VARPTR(aqmsg)))
  72. WEND
  73.      
  74. '***********         Finalize section        ***************
  75.  
  76. bool% = WinDestroyWindow(hwndFrame&)
  77. bool% = WinDestroyMsgQueue(hmq&)
  78. bool% = WinTerminate(hab&)
  79.  
  80. END
  81.  
  82. '***********         Window procedure        ***************
  83.  
  84. '****
  85. '** ClientWndProc has been rearranged to accomodate the menu.
  86. '** Thus, main control is from WMCOMMAND (caused by menu) instead
  87. '** of WMPAINT. WMTIMER still handles the sound, but is terminated
  88. '** immediately with message box.
  89.  
  90. FUNCTION ClientWndProc& (hwnd&, msg%, mp1&, mp2&) STATIC
  91.      DIM ClientRect AS RECTL
  92.  
  93.      ClientWndProc&=0
  94.      SELECT CASE msg%
  95.     CASE WMPAINT     'Paint the window with background color
  96.           hps&  = WinBeginPaint(hwnd&, 0,_
  97.                       MakeLong(VARSEG(ClientRect), VARPTR(ClientRect)))
  98.               bool% = WinFillRect(hps&,_
  99.                       MakeLong(VARSEG(ClientRect), VARPTR(ClientRect)),0)
  100.           bool% = WinEndPaint(hps&)
  101.         CASE WMCOMMAND             'Menu has main control
  102.               CALL BreakLong(mp1&, hiword%, loword%)
  103.               SELECT CASE loword%
  104.                    CASE IDMBOUNCING
  105.                         '** CurrSound and Timer must be before Message Box!
  106.                         CurrSound = 1
  107.                         Bool% = WinStartTimer (hab&,hwndClient&,1,10)
  108.  
  109.                         caption$ = "Bouncing" + CHR$(0)
  110.                         message$ = "Click OK for Silence" + CHR$(0)
  111.                         MsgBox% = WinMessageBox(HWNDDESKTOP,_
  112.                                   hwnd&,_
  113.                                   MakeLong(VARSEG(message$), SADD(message$)),_
  114.                                   MakeLong(VARSEG(caption$), SADD(caption$)),_
  115.                                   1,_
  116.                                   MBOK)
  117.            CASE IDMFALLING
  118.                         CurrSound = 2
  119.                         Bool% = WinStartTimer (hab&,hwndClient&,1,10)
  120.  
  121.                         caption$ = "Falling" + CHR$(0)
  122.                         message$ = "Click OK for Silence" + CHR$(0)
  123.                         MsgBox% = WinMessageBox(HWNDDESKTOP,_
  124.                                   hwnd&,_
  125.                                   MakeLong(VARSEG(message$), SADD(message$)),_
  126.                                   MakeLong(VARSEG(caption$), SADD(caption$)),_
  127.                                   1,_
  128.                                   MBOK)
  129.  
  130.                    CASE IDMSIREN
  131.                         CurrSound = 3
  132.                         Bool% = WinStartTimer (hab&,hwndClient&,1,10)
  133.  
  134.                         caption$ = "Wailing" + CHR$(0)
  135.                         message$ = "Click OK for Silence" + CHR$(0)
  136.                         MsgBox% = WinMessageBox(HWNDDESKTOP,_
  137.                                   hwnd&,_
  138.                                   MakeLong(VARSEG(message$), SADD(message$)),_
  139.                                   MakeLong(VARSEG(caption$), SADD(caption$)),_
  140.                                   1,_
  141.                                   MBOK)
  142.  
  143.                    CASE IDMKLAXON
  144.                         CurrSound = 4
  145.                         Bool% = WinStartTimer (hab&,hwndClient&,1,10)
  146.  
  147.                         caption$ = "Oscillating" + CHR$(0)
  148.                         message$ = "Click OK for Silence" + CHR$(0)
  149.                         MsgBox% = WinMessageBox(HWNDDESKTOP,_
  150.                                   hwnd&,_
  151.                                   MakeLong(VARSEG(message$), SADD(message$)),_
  152.                                   MakeLong(VARSEG(caption$), SADD(caption$)),_
  153.                                   1,_
  154.                                   MBOK)
  155.  
  156.                CASE IDMQUIT
  157.                      Quit& = WinSendMsg(HWND&,WMClose,0,0)
  158.                
  159.                CASE ELSE
  160.       END SELECT
  161.           IF MsgBox% = MBIDOK THEN                     'Stop timer when OK
  162.              bool% = WinStopTimer(hab&, hwndClient&, 1)
  163.           END IF
  164.      CASE WMTIMER                         'WMTIMER still has sound control
  165.       SELECT CASE CurrSound
  166.           CASE 1
  167.                         CALL Bounce (32767, 246)
  168.               CASE 2
  169.                         CALL Fall (2000, 550, 500)
  170.               CASE 3
  171.                         CALL Siren (780, 650)
  172.               CASE 4
  173.                         CALL Klaxon (987, 329, 50)
  174.           CASE ELSE
  175.       END SELECT
  176.      CASE ELSE       
  177.           ClientWndProc& = WinDefWindowProc(hwnd&, msg%, mp1&, mp2&)
  178.      END SELECT
  179. END FUNCTION
  180.  
  181.  
  182. '**** Original Demo3 SUBs. Changed to DosBeep and removed loops.
  183. DEFINT A-Z
  184.  
  185. ' Loop two sounds down at decreasing time intervals
  186. SUB Bounce (Hi, Low) STATIC
  187.    IF Count < 1 THEN Count = 60
  188.       X% = DosBeep ( Low - Count / 2, MsPerTick * Count / 20 )
  189.       X% = DosBeep ( Hi, MsPerTick * Count / 15 )
  190.    Count = Count - 2
  191. END SUB
  192.  
  193. ' Loop down from a high sound to a low sound
  194. SUB Fall (Hi, Low, Del) STATIC
  195.    IF Count < Low THEN Count = Hi
  196.       X% = DosBeep( Count, MsPerTick * Del / Count )
  197.    Count = Count - 10
  198. END SUB
  199.  
  200. ' Alternate two sounds until a key is pressed
  201. SUB Klaxon (Hi, Low, Dur) STATIC
  202.       X% = DosBeep ( Hi, MsPerTick * 5 )
  203.       X% = DosBeep ( Low, MsPerTick * 5 )
  204. END SUB
  205.  
  206. ' Loop a sound from low to high to low
  207. SUB Siren (Hi, Range) STATIC
  208.          IF Count < -Range THEN Count = Range
  209.             X% = DosBeep ( Hi - ABS(Count), MsPerTick * .3 )
  210.             Count = Count - 2 / Range
  211.          Count = Count - 4
  212. END SUB
  213.