home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / OS2BAS.ZIP / BOUNCE.BAS < prev    next >
BASIC Source File  |  1989-07-29  |  24KB  |  661 lines

  1. '****************************************************************
  2. '* 
  3. '* Program Name: Bounce.BAS
  4. '*
  5. '* Description : This program demonstrates much of the interface
  6. '*               and graphics available to PM programs. In
  7. '*               particular, it uses several different resources
  8. '*               defined in Bounce.RC. These include menus,
  9. '*               accelerator tables and dialog boxes. There
  10. '*               are further controls in each dialog box.
  11. '*
  12. '*               This program also demonstrates using the extra
  13. '*               RegBas routines.  Notice the extra EXPORTS in
  14. '*               Bounce.DEF and the naming convention for the
  15. '*               corresponding ClientWndProc's.
  16. '*---------------------------------------------------------------
  17. '* Execution:    This program allows you to set a variety of
  18. '*               controls for a bouncing ball program. All of
  19. '*               the controls are accessible through either the
  20. '*               menus or through accelerators. The dialog boxes
  21. '*               for the various controls are very similar and
  22. '*               self-explanatory.
  23. '*
  24. '*               The following table lists the menu items,
  25. '*               accelerators, and effects for each control:
  26. '*
  27. '* Menu       Accel       Effect
  28. '* ----       -----       ------
  29. '* CONROL
  30. '* Start      SPACE       Erase window and start ball
  31. '* Stop       ESC         Stop ball and erase window
  32. '* Pause      CTRL+S      Pause ball (don't erase)
  33. '* Continue   CTRL+Q      Continue ball movement (don't erase)
  34. '* Exit       ALT+F4      Close window and exit
  35. '* OPTIONS
  36. '* Sound      SCROLL LOCK (toggle) Beeps on each bounce
  37. '* Size       CTRL+Z      Change size or choose random size
  38. '* Velosity   CTRL+V      Change speed of ball (amount movement per timer)
  39. '* Position   CTRL+P      Change current location of ball
  40. '* Trail      CTRL+T      (toggle) Show previous balls (preferred=yes)
  41. '* Angle      CTRL+A      Change angle of ball movement (degrees)
  42. '*
  43. '* Notes:        The program is more interesting with the trail
  44. '*               option chosen. This will leave all previous balls
  45. '*               instead of just the current. Program execution is
  46. '*               slower without trail.
  47. '*
  48. '*               When dialog boxes are displayed while the ball is
  49. '*               moving, the "white box effect" occurs. The symptom
  50. '*               of this effect is that when the dialog box is
  51. '*               removed, the window behind that is not redrawn.
  52. '*               This can not be avoided if the ball is to keep
  53. '*               moving during dialog (which is desired). To
  54. '*               prevent this effect, use CTRL+S to pause movement
  55. '*               before each dialog and CTRL+Q to continue after
  56. '*               each dialog.
  57. '*
  58. '*               Because this program does not have an icon, the
  59. '*               icon is the same as the normal window. This can
  60. '*               create animated icons, but it is not advised to
  61. '*               run more than one copy of Bounce as it will
  62. '*               monopolize your CPU. In fact, before you switch
  63. '*               to any other process, it is advised to pause
  64. '*               Bounce, or the response in the other process
  65. '*               will be exceedingly slow.
  66. '****************************************************************
  67.  
  68. '*********         Initialization section        ***********
  69.  
  70. REM $INCLUDE: 'Bounce.INC'
  71.  
  72. '***********************************************************************
  73. '*** Global variables fall into 3 categories:
  74. '***    1. Flags   -- boolean values (sound, trail, random size)
  75. '***    2. Values  -- scalar values (size, speed, angle, position, limits)
  76. '***    3. Handles -- handles (anchor block and client window; for StopTimer)
  77.  
  78. COMMON SHARED /Flags/ Audible%, Trail%, RandSize%
  79. COMMON SHARED /Values/ Size&, Delta%, Angle!, globalX%, globalY%, XMax%, YMax%
  80. COMMON SHARED /Handles/ hab&, hwndClient&
  81.  
  82. DIM aqmsg AS QMSG
  83.  
  84. flFrameFlags& = FCFTITLEBAR      OR FCFSYSMENU OR _
  85.                 FCFSIZEBORDER    OR FCFMINMAX  OR _
  86.                 FCFSHELLPOSITION OR FCFTASKLIST OR _
  87.                 FCFMENU          OR FCFACCELTABLE
  88.  
  89. szClientClass$ = "ClassName" + CHR$(0)
  90.  
  91. hab& = WinInitialize(0)
  92. hmq& = WinCreateMsgQueue(hab&, 0)
  93.  
  94. bool% = WinRegisterClass(_
  95.           hab&,_
  96.           MakeLong(VARSEG(szClientClass$), SADD(szClientClass$)),_
  97.           RegBas,_
  98.           CSSIZEREDRAW,_
  99.           0)
  100.  
  101. hwndFrame& = WinCreateStdWindow (_
  102.           HWNDDESKTOP,_
  103.           WSVISIBLE,_
  104.           MakeLong (VARSEG(flFrameFlags&), VARPTR(flFrameFlags&)),_
  105.           MakeLong (VARSEG(szClientClass$), SADD(szClientClass$)),_
  106.           0,_
  107.           0,_
  108.           0,_
  109.           IDMENU,_
  110.           MakeLong (VARSEG(hwndClient&), VARPTR(hwndClient&)))
  111.  
  112. '**************         Message loop         ***************
  113.  
  114. WHILE WinGetMsg(hab&, MakeLong(VARSEG(aqmsg), VARPTR(aqmsg)), 0, 0, 0)
  115.   bool% = WinDispatchMsg(hab&, MakeLong(VARSEG(aqmsg), VARPTR(aqmsg)))
  116. WEND
  117.  
  118. '***********         Finalize section        ***************
  119.  
  120.     bool% = WinStopTimer(hab&, hwndClient&, IDTIMER)
  121.  
  122. bool% = WinDestroyWindow(hwndFrame&)
  123. bool% = WinDestroyMsgQueue(hmq&)
  124. bool% = WinTerminate(hab&)
  125.  
  126. END
  127.  
  128. '***********         Window procedures        ***************
  129.  
  130. '*****
  131. '* ClientWndProc is the main window procedure. The messages do the following:
  132. '*
  133. '* WMCREATE:  Initializes global flags and values
  134. '* WMSIZE:    Sets XMax and YMax and causes a WMPAINT
  135. '* WMMOVE:    Causes WMPAINT
  136. '* WMCOMMAND: Transfers control to dialog or toggles flag
  137. '* WMPAINT:   Erases invalid rect
  138. '* WMTIMER:   Moves ball
  139.  
  140. FUNCTION ClientWndProc& (hwnd&, msg%, mp1&, mp2&) STATIC
  141.      ClientWndProc&=0
  142.      SELECT CASE msg%
  143. '* WMCREATE:  Initializes global flags and values
  144.      CASE WMCREATE
  145.         Audible%  = 0            'Sound (boolean)
  146.         Trail%    = 0            'Trail (boolean)
  147.         RandSize% = 0            'Random size (boolean)
  148.         Delta%    = 10           'Speed (delta p) (value)
  149.         Angle!    = 45 * Degree  'Angle (value)
  150.         GlobalX%  = 10           'Position (values)
  151.         GlobalY%  = 10
  152.         RANDOMIZE TIMER
  153. '* WMSIZE:    Sets XMax and YMax and causes a WMPAINT
  154.      CASE WMSIZE
  155.         CALL BreakLong(mp2&, YMax%, XMax%)
  156.         bool% = WinInvalidateRect(hwnd&, 0, 0)
  157. '* WMMOVE:    Causes WMPAINT
  158.      CASE WMMOVE
  159.         bool% = WinInvalidateRect(hwnd&, 0, 0)
  160. '* WMCOMMAND: Transfers control to dialog or toggles flag
  161.      CASE WMCOMMAND
  162.         CALL BreakLong(mp1&, HiWord%, LoWord%)
  163.        '*****
  164.        '* WMCOMMAND (Menu or acceltable)
  165.        '*
  166.        '* IDMCSTART:    Start timer and clear window
  167.        '* IDMCSTOP:     Stop timer and clear window
  168.        '* IDMCPAUSE:    Stop timer and leave window as is
  169.        '* IDMCCONT:     Start timer with window as is
  170.        '* IDMCEXIT:     Close window and exit program
  171.        '* IDMOSOUND:    Toggle sound flag
  172.        '* IDMOSIZE:     Display size dialog (ClientWndProc1)
  173.        '* IDMOVELOCITY: Display velocity dialog (ClientWndProc2)
  174.        '* IDMOPOS:      Display position dialog (ClientWndProc3)
  175.        '* IDMOANGLE:    Display angle dialog (ClientWndProc4)
  176.        '* IDMOTRAIL:    Toggle trail flag
  177.         SELECT CASE LoWord%                    'ID in Low word
  178.        '* IDMCSTART:    Start timer and clear window
  179.       CASE IDMCSTART
  180.         bool% = WinStartTimer(hab&, hwndClient&, IDTIMER, 10)
  181.             bool% = WinInvalidateRect(hwnd&, 0, 0)
  182.        '* IDMCSTOP:     Stop timer and clear window
  183.       CASE IDMCSTOP
  184.         bool% = WinStopTimer(hab&, hwndClient&, IDTIMER)
  185.             bool% = WinInvalidateRect(hwnd&, 0, 0)
  186.        '* IDMCPAUSE:    Stop timer and leave window as is
  187.       CASE IDMCPAUSE
  188.         bool% = WinStopTimer(hab&, hwndClient&, IDTIMER)
  189.        '* IDMCCONT:     Start timer with window as is
  190.       CASE IDMCCONT
  191.         bool% = WinStartTimer(hab&, hwndClient&, IDTIMER, 10)
  192.        '* IDMCEXIT:     Close window and exit program
  193.       CASE IDMCEXIT
  194.         bool% = WinSendMsg(hwnd&, WMCLOSE, 0, 0)
  195.        '* IDMOSOUND:    Toggle sound flag
  196.       CASE IDMOSOUND
  197.         Audible% = NOT(Audible%)
  198.        '* IDMOSIZE:     Display size dialog (ClientWndProc1)
  199.       CASE IDMOSIZE
  200.         bool% = WinDlgBox (HWNDDESKTOP, hwnd&, RegBas1, 0, LoWord%, 0)
  201.        '* IDMOVELOCITY: Display velocity dialog (ClientWndProc2)
  202.       CASE IDMOVELOCITY
  203.         bool% = WinDlgBox (HWNDDESKTOP, hwnd&, RegBas2, 0, LoWord%, 0)
  204.        '* IDMOPOS:      Display position dialog (ClientWndProc3)
  205.       CASE IDMOPOS
  206.         bool% = WinDlgBox (HWNDDESKTOP, hwnd&, RegBas3, 0, LoWord%, 0)
  207.        '* IDMOANGLE:    Display angle dialog (ClientWndProc4)
  208.       CASE IDMOANGLE
  209.         bool% = WinDlgBox (HWNDDESKTOP, hwnd&, RegBas4, 0, LoWord%, 0)
  210.        '* IDMOTRAIL:    Toggle trail flag
  211.       CASE IDMOTRAIL
  212.         Trail% = NOT(Trail%)
  213.       CASE ELSE
  214.     END SELECT
  215. '* WMPAINT:   Erases invalid rect
  216.      CASE WMPAINT
  217.         hps&  = WinBeginPaint(hwnd&, 0,_
  218.                 MakeLong(VARSEG(ClientRect), VARPTR(ClientRect)))
  219.         bool% = WinFillRect(hps&,_
  220.                 MakeLong(VARSEG(ClientRect), VARPTR(ClientRect)),0)
  221.         bool% = WinEndPaint(hps&)
  222. '* WMTIMER:   Moves ball
  223.      CASE WMTIMER
  224.         bool% = WinInvalidateRect(hwnd&, 0, 0)
  225.         CALL MoveBall(hwnd&)
  226.      CASE ELSE        'Pass control to system for other messages
  227.         ClientWndProc& = WinDefWindowProc(hwnd&, msg%, mp1&, mp2&)
  228.      END SELECT
  229. END FUNCTION
  230.  
  231. '************************************************
  232. '*  ClientWndProc1-4 are dialog procedures
  233. '*
  234. '*  ClientWndProc1 is size
  235. '*  ClientWndProc2 is velocity
  236. '*  ClientWndProc3 is position
  237. '*  ClientWndProc4 is angle
  238. '*
  239. '*  The main functionality of each is the same:
  240. '*      1. Initialize
  241. '*      2. Scrollbar
  242. '*      3. Dismiss
  243. '*
  244. '*  The main difference is the conversion of
  245. '*  the global variable to the scroll variable.
  246. '************************************************
  247.  
  248. '*****
  249. '* ClientWndProc1 is the size dialog procedure
  250. '*
  251. '* Features of size dialog are:
  252. '*
  253. '*        Text region to display current size
  254. '*        Scroll bar to change size
  255. '*        Check box to choose random size
  256. '*        Button to conclude dialog
  257. '*
  258. '* Global variable: Size&, RandSize%
  259. '*
  260. '* Conversion:      FIXED -> IEEE     <==> IEEE = FIXED / (2 ^ 16)
  261. '*                  IEEE -> 1 decimal <==> 1Dec = INT(10 * IEEE) / 10
  262. '*****
  263.  
  264. FUNCTION ClientWndProc1&(hwnd&, msg%, mp1&, mp2&) STATIC
  265.   ClientWndProc1& = 0
  266.   SELECT CASE msg%
  267.      CASE WMINITDLG
  268. '* Conversion:      FIXED -> IEEE     <==> IEEE = FIXED / (2 ^ 16)
  269. '*                  IEEE -> 1 decimal <==> 1Dec = INT(10 * IEEE) / 10
  270.         dialog$ = LTRIM$(STR$(INT(10 * Size& /  (2 ^ 16)) / 10)) + CHR$(0)
  271.         'Set number
  272.         bool% = WinSetDlgItemText (hwnd&,_
  273.                                    IDMOSCURRENT,_
  274.                                    MakeLong(VARSEG(dialog$), SADD(dialog$)))
  275.         'Set scroll bar
  276.         bool% = WinSendDlgItemMsg (hwnd&,_
  277.                                    IDMOSSCROLL,_
  278.                                    SBMSETSCROLLBAR,_
  279.                                    10 * Size& / (2 ^ 16),_
  280.                                    MakeLong(200, 0))
  281.         'Set check box
  282.         temp% = RandSize%
  283.         bool% = WinSendDlgItemMsg (hwnd&,_
  284.                                    IDMOSRAND,_
  285.                                    BMSETCHECK,_
  286.                                    temp%,_
  287.                                    0)
  288.      CASE WMHSCROLL
  289.     CALL BreakLong(mp2&, HiWord%, LoWord%)
  290.         SELECT CASE HiWord%
  291.        CASE SBLINELEFT
  292.               Size& = Size& - &H199A      '&H199A / &H10000 = .1
  293.        CASE SBPAGELEFT
  294.           Size& = Size& - &H10000
  295.        CASE SBLINERIGHT
  296.           Size& = Size& + &H199A
  297.        CASE SBPAGERIGHT
  298.           Size& = Size& + &H10000
  299.        CASE SBSLIDERTRACK
  300.               Size& = LoWord% * &H199A&
  301.        CASE ELSE
  302.         END SELECT
  303.  
  304.         'Bounds checking
  305.     IF Size& < &H1000 THEN Size& = &H1000
  306.         IF Size& > &H140000 THEN Size& = &H140000
  307.  
  308.         'Set number
  309.         dialog$ = LTRIM$(STR$(INT(10 * Size& /  (2 ^ 16)) / 10)) + CHR$(0)
  310.         bool% = WinSetDlgItemText (hwnd&,_
  311.                                    IDMOSCURRENT,_
  312.                                    MakeLong(VARSEG(dialog$), SADD(dialog$)))
  313.         'Set scrollbar if not already set (by sliding)
  314.         IF HiWord% <> SBSLIDERTRACK THEN
  315.           bool% = WinSendDlgItemMsg (hwnd&,_
  316.                                      IDMOSSCROLL,_
  317.                                      SBMSETSCROLLBAR,_
  318.                                      10 * Size& / (2 ^ 16),_
  319.                                      MakeLong(200, 0))
  320.         END IF
  321.      CASE WMCONTROL
  322.         'Toggle Random size flag
  323.         RandSize% = NOT(RandSize%)
  324.         'Set check box
  325.     temp% = RandSize%
  326.     bool% = WinSendDlgItemMsg(hwnd&, IDMOSRAND, BMSETCHECK, temp%, 0)
  327.      CASE WMCOMMAND
  328.     bool% = WinDismissDlg(hwnd&, 1)
  329.      CASE ELSE
  330.     ClientWndProc1& = WinDefDlgProc (hwnd&, msg%, mp1&, mp2&)
  331.   END SELECT
  332. END FUNCTION
  333.  
  334. '*****
  335. '* ClientWndProc2 is the velocity dialog procedure
  336. '*
  337. '* Features of velocity dialog are:
  338. '*
  339. '*        Text region to display current velocity
  340. '*        Scroll bar to change velocity
  341. '*        Button to conclude dialog
  342. '*
  343. '* Global variable: Delta%
  344. '*
  345. '* Conversion:      None
  346. '*****
  347.  
  348. FUNCTION ClientWndProc2&(hwnd&, msg%, mp1&, mp2&) STATIC
  349.   ClientWndProc2& = 0
  350.   SELECT CASE msg%
  351.      CASE WMINITDLG
  352.         dialog$ = LTRIM$(STR$(Delta%)) + CHR$(0)
  353.         'Set number
  354.         bool% = WinSetDlgItemText (hwnd&,_
  355.                                    IDMOVCURRENT,_
  356.                                    MakeLong(VARSEG(dialog$), SADD(dialog$)))
  357.         'Set scroll bar
  358.         bool% = WinSendDlgItemMsg(hwnd&,_
  359.                                   IDMOVSCROLL,_
  360.                                   SBMSETSCROLLBAR,_
  361.                                   Delta%,_
  362.                                   MakeLong(50,1))
  363.      CASE WMHSCROLL
  364.     CALL BreakLong(mp2&, HiWord%, LoWord%)
  365.     SELECT CASE HiWord%
  366.        CASE SBLINELEFT
  367.           Delta% = Delta% - 1
  368.        CASE SBPAGELEFT
  369.           Delta% = Delta% - 5
  370.        CASE SBLINERIGHT
  371.           Delta% = Delta% + 1
  372.        CASE SBPAGERIGHT
  373.           Delta% = Delta% + 5
  374.        CASE SBSLIDERTRACK
  375.           Delta% = LoWord%
  376.        CASE ELSE
  377.         END SELECT
  378.  
  379.         'Bounds checking
  380.     IF Delta% < 1 THEN Delta% = 1
  381.         IF Delta% > 50 THEN Delta% = 50
  382.  
  383.         dialog$ = LTRIM$(STR$(Delta%)) + CHR$(0)
  384.         'Set number
  385.         bool% = WinSetDlgItemText (hwnd&,_
  386.                                    IDMOVCURRENT,_
  387.                                    MakeLong(VARSEG(dialog$), SADD(dialog$)))
  388.         'Set scrollbar if not already set (by sliding)
  389.         IF HiWord% <> SBSLIDERTRACK THEN
  390.           bool% = WinSendDlgItemMsg (hwnd&,_
  391.                                      IDMOVSCROLL,_
  392.                                      SBMSETSCROLLBAR,_
  393.                                      VAL(dialog$),_
  394.                                      MakeLong(50,0))
  395.         END IF
  396.      CASE WMCOMMAND
  397.     bool% = WinDismissDlg(hwnd&, 1)
  398.      CASE ELSE
  399.     ClientWndProc2& = WinDefDlgProc (hwnd&, msg%, mp1&, mp2&)
  400.   END SELECT
  401. END FUNCTION
  402.  
  403. '*****
  404. '* ClientWndProc3 is the position dialog procedure
  405. '*
  406. '* Features of position dialog are:
  407. '*
  408. '*        Text regions to display current coordinates
  409. '*        Vertical scroll bar to change Y (note: values must be YMax-Y)
  410. '*        Horizontal scroll bar to change X
  411. '*        Button to conclude dialog
  412. '*
  413. '* Global variable: GlobalX%, GlobalY%
  414. '*
  415. '* Conversion:      X:none
  416. '*                  Y Scroll:YMax - Y
  417. '*****
  418.  
  419. FUNCTION ClientWndProc3&(hwnd&, msg%, mp1&, mp2&) STATIC
  420.   ClientWndProc3& = 0
  421.   SELECT CASE msg%
  422.      CASE WMINITDLG
  423.         dialog$ = LTRIM$(STR$(GlobalX%)) + CHR$(0)
  424.         'Set number
  425.         bool% = WinSetDlgItemText (hwnd&,_
  426.                                    IDMOPX,_
  427.                                    MakeLong(VARSEG(dialog$), SADD(dialog$)))
  428.         'Set scroll bar
  429.         bool% = WinSendDlgItemMsg (hwnd&,_
  430.                                    IDMOPHSCROLL,_
  431.                                    SBMSETSCROLLBAR,_
  432.                                    GlobalX%,_
  433.                                    MakeLong(XMax%, 0))
  434.  
  435.     dialog$ = LTRIM$(STR$(GlobalY%)) + CHR$(0)
  436.         'Set number
  437.         bool% = WinSetDlgItemText (hwnd&,_
  438.                                    IDMOPY,_
  439.                                    MakeLong(VARSEG(dialog$), SADD(dialog$)))
  440.         'Set scroll bar
  441.         bool% = WinSendDlgItemMsg (hwnd&,_
  442.                                    IDMOPVSCROLL,_
  443.                                    SBMSETSCROLLBAR,_
  444.                                    YMax% - GlobalY%,_
  445.                                    MakeLong(YMax%, 0))
  446.      CASE WMHSCROLL
  447.     CALL BreakLong(mp2&, HiWord%, LoWord%)
  448.     SELECT CASE HiWord%
  449.        CASE SBLINELEFT
  450.           GlobalX% = GlobalX% - 1
  451.        CASE SBPAGELEFT
  452.           GlobalX% = GlobalX% - 10
  453.        CASE SBLINERIGHT
  454.           GlobalX% = GlobalX% + 1
  455.        CASE SBPAGERIGHT
  456.           GlobalX% = GlobalX% + 10
  457.        CASE SBSLIDERTRACK
  458.           GlobalX% = LoWord%
  459.        CASE ELSE
  460.         END SELECT
  461.  
  462.         'Bounds checking
  463.     IF GlobalX% < 0 THEN GlobalX% = 0
  464.         IF GlobalX% > XMax% THEN GlobalX% = XMax%
  465.  
  466.     dialog$ = LTRIM$(STR$(GlobalX%)) + CHR$(0)
  467.         'Set number
  468.         bool% = WinSetDlgItemText (hwnd&,_
  469.                                    IDMOPX,_
  470.                                    MakeLong(VARSEG(dialog$), SADD(dialog$)))
  471.         'Set scrollbar if not already set (by sliding)
  472.         IF HiWord% <> SBSLIDERTRACK THEN
  473.           bool% = WinSendDlgItemMsg (hwnd&,_
  474.                                      IDMOPHSCROLL,_
  475.                                      SBMSETSCROLLBAR,_
  476.                                      VAL(dialog$),_
  477.                                      MakeLong(XMax%,0))
  478.         END IF
  479.      CASE WMVSCROLL
  480.     CALL BreakLong(mp2&, HiWord%, LoWord%)
  481.     SELECT CASE HiWord%
  482.        CASE SBLINELEFT
  483.           GlobalY% = GlobalY% + 1
  484.        CASE SBPAGELEFT
  485.           GlobalY% = GlobalY% + 10
  486.        CASE SBLINERIGHT
  487.           GlobalY% = GlobalY% - 1
  488.        CASE SBPAGERIGHT
  489.           GlobalY% = GlobalY% - 10
  490.        CASE SBSLIDERTRACK
  491.           GlobalY% = YMax% - LoWord%
  492.        CASE ELSE
  493.         END SELECT
  494.  
  495.         'Bounds checking
  496.     IF GlobalY% < 0 THEN GlobalY% = 0
  497.         IF GlobalY% > YMax% THEN GlobalY% = YMax%
  498.  
  499.         dialog$ = LTRIM$(STR$(GlobalY%)) + CHR$(0)
  500.         'Set number
  501.         bool% = WinSetDlgItemText (hwnd&,_
  502.                                    IDMOPY,_
  503.                                    MakeLong(VARSEG(dialog$), SADD(dialog$)))
  504.         'Set scrollbar if not already set (by sliding)
  505.         IF HiWord% <> SBSLIDERTRACK THEN
  506.           bool% = WinSendDlgItemMsg (hwnd&,_
  507.                                      IDMOPVSCROLL,_
  508.                                      SBMSETSCROLLBAR,_
  509.                                      YMax% - VAL(dialog$),_
  510.                                      MakeLong(YMax%,0))
  511.         END IF
  512.      CASE WMCOMMAND
  513.     bool% = WinDismissDlg(hwnd&, 1)
  514.      CASE ELSE
  515.     ClientWndProc3& = WinDefDlgProc (hwnd&, msg%, mp1&, mp2&)
  516.   END SELECT
  517. END FUNCTION
  518.  
  519. '*****
  520. '* ClientWndProc4 is the angle dialog procedure
  521. '*
  522. '* Features of angle dialog are:
  523. '*
  524. '*        Text region to display current angle
  525. '*        Scroll bar to change angle
  526. '*        Button to conclude dialog
  527. '*
  528. '* Global variable: Angle!
  529. '*
  530. '* Conversion:      radian = delta * Degree (conversion constant Degree=PI/180)
  531. '*****
  532.  
  533. FUNCTION ClientWndProc4&(hwnd&, msg%, mp1&, mp2&) STATIC
  534.   ClientWndProc4& = 0
  535.   'Place Angle! between 0 and 360 degrees
  536.   WHILE Angle! < 0
  537.     Angle! = Angle! + 360 * Degree
  538.   WEND
  539.   SELECT CASE msg%
  540.      CASE WMINITDLG
  541.         dialog$ = LTRIM$(STR$(INT(Angle! / Degree) MOD 360)) + CHR$(0)
  542.         'Set number
  543.         bool% = WinSetDlgItemText (hwnd&,_
  544.                                    IDMOACURRENT,_
  545.                                    MakeLong(VARSEG(dialog$), SADD(dialog$)))
  546.         'Set scroll bar
  547.         bool% = WinSendDlgItemMsg (hwnd&,_
  548.                                    IDMOASCROLL,_
  549.                                    SBMSETSCROLLBAR,_
  550.                                    VAL(dialog$),_
  551.                                    MakeLong(359,0))
  552.      CASE WMHSCROLL
  553.     CALL BreakLong(mp2&, HiWord%, LoWord%)
  554.     SELECT CASE HiWord%
  555.        CASE SBLINELEFT
  556.           Angle! = Angle! - Degree
  557.        CASE SBPAGELEFT
  558.           Angle! = Angle! - 10 * Degree
  559.        CASE SBLINERIGHT
  560.           Angle! = Angle! + Degree
  561.        CASE SBPAGERIGHT
  562.           Angle! = Angle! + 10 * Degree
  563.        CASE SBSLIDERTRACK
  564.           Angle! = LoWord% * Degree
  565.        CASE ELSE
  566.         END SELECT
  567.  
  568.     dialog$ = LTRIM$(STR$(INT(Angle! / Degree) MOD 360)) + CHR$(0)
  569.         'Set number
  570.         bool% = WinSetDlgItemText (hwnd&,_
  571.                                    IDMOACURRENT,_
  572.                                    MakeLong(VARSEG(dialog$), SADD(dialog$)))
  573.         'Set scrollbar if not already set (by sliding)
  574.         IF HiWord% <> SBSLIDERTRACK THEN
  575.           bool% = WinSendDlgItemMsg (hwnd&,_
  576.                                      IDMOASCROLL,_
  577.                                      SBMSETSCROLLBAR,_
  578.                                      VAL(dialog$),_
  579.                                      MakeLong(359,0))
  580.         END IF
  581.      CASE WMCOMMAND
  582.     bool% = WinDismissDlg(hwnd&, 1)
  583.      CASE ELSE
  584.     ClientWndProc4& = WinDefDlgProc (hwnd&, msg%, mp1&, mp2&)
  585.   END SELECT
  586. END FUNCTION
  587.  
  588. '**************************************************************
  589. '* MoveBall is the procedure that handles the actual ball
  590. '* movement. This process is fairly simple:
  591. '*
  592. '*        1. Increment position
  593. '*        2. Check for bounce
  594. '*        3. Draw ball which entails:
  595. '*                a. Erasing previous ball if Trail is not set
  596. '*                b. Changing color if Wall (local flag) is set
  597. '*                c. Sounding beep if Audible and Wall are set
  598. '*                d. Computing size if RandSize is set
  599. '*                e. (Finally) Drawing current ball
  600. '**************************************************************
  601.  
  602. SUB MoveBall(hwnd&) STATIC
  603.     DIM ClientRect AS RECTL, Ball AS POINTL, PrevBall AS POINTL
  604.     hps&  = WinBeginPaint(hwnd&, 0,_
  605.         MakeLong(VARSEG(ClientRect), VARPTR(ClientRect)))
  606.     PrevBall.x = globalX%
  607.     PrevBall.y = globalY%
  608.  
  609. '*        1. Increment position
  610.         globalX% = globalX% + Delta% * COS(Angle!)
  611.         globalY% = globalY% + Delta% * SIN(Angle!)
  612.  
  613.  
  614. '*        2. Check for bounce
  615.     IF (globalY% > ClientRect.yTop) OR (globalY% < ClientRect.yBottom) THEN
  616.           Wall% = 1
  617.       Angle! = 2 * PI - Angle!
  618.       globalX% = globalX% + Delta% * COS(Angle!)
  619.       globalY% = globalY% + Delta% * SIN(Angle!)
  620.     END IF
  621.     IF (globalX% > ClientRect.xRight) OR (globalX% < ClientRect.xLeft) THEN
  622.           Wall% = 1
  623.       Angle! = PI - Angle!
  624.       globalX% = globalX% + Delta% * COS(Angle!)
  625.       globalY% = globalY% + Delta% * SIN(Angle!)
  626.         END IF
  627.  
  628. '*        3. Draw ball which entails:
  629. '*                a. Erasing previous ball if Trail is not set
  630.     IF Trail% = 0 THEN
  631.       bool% = GpiSetColor(hps&, 0)
  632.       bool% = GpiMove(hps&, MakeLong(VARSEG(PrevBall), VARPTR(PrevBall)))
  633.       GFA&    = GpiFullArc (hps&, 3, Size&)
  634.         END IF
  635.  
  636. '*                b. Changing color if Wall (local flag) is set
  637.         IF Wall% THEN
  638.           Wall% = 0
  639.           ColorIndex% = ((ColorIndex% + 1) MOD 15) + 1
  640.  
  641. '*                c. Sounding beep if Audible and Wall are set
  642.       IF Audible% THEN
  643.         x% = DosBeep(110*Size&/(2^16),1)
  644.         x% = DosBeep(108*Size&/(2^16),1)
  645.         x% = DosBeep(110*Size&/(2^16),1)
  646.           END IF
  647.  
  648.         END IF
  649.  
  650. '*                d. Computing size if RandSize is set
  651.         IF RandSize% THEN Size& = RND * &H200000
  652.  
  653. '*                e. (Finally) Drawing current ball
  654.     Ball.x = globalX%
  655.     Ball.y = globalY%
  656.     bool% = GpiMove(hps&, MakeLong(VARSEG(Ball), VARPTR(Ball)))
  657.     bool% = GpiSetColor(hps&, ColorIndex%)
  658.     GFA&  = GpiFullArc (hps&, 3, Size&)
  659.     bool% = WinEndPaint(hps&)
  660. END SUB
  661.