home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / OS2BAS.ZIP / AREAMOD.BAS < prev    next >
BASIC Source File  |  1989-08-13  |  10KB  |  267 lines
  1. '│*****************************************************************
  2. '│
  3. '│ Module:       AreaMod.bas
  4. '│
  5. '│ Subprograms:  DemoPatterns
  6. '│               DemoBeginEndArea
  7. '│               - ClientWndProc1 - DialogBox procedure used in
  8. '│                                  DemoBeginEndArea
  9. '│
  10. '│ Description:  AreaMod contains many different Presentation Manager
  11. '│               CALL, however, it essentially demonstrates only two
  12. '│               areas: Fill patters & colors, and the Begin/End Area
  13. '│               CALLS, i.e. "DemoPatterns" and "DemoBeginEndArea".
  14. '│               "ClientWndProc1" is a SUBprogram CALLed externally
  15. '│               by the Presentation Manager.  "ClientWndProc1" is
  16. '│               registered from within "DemoBeginEndArea" with the
  17. '│               CALL to WinDlgBox.  This SUBprogram is the controling
  18. '│               procedure for the DialogBox used in the DemoBeginArea
  19. '│               SUBprogram.
  20. '│
  21. '│*********************************************************************
  22.  
  23. REM $INCLUDE: 'os2def.bi'
  24. REM $INCLUDE: 'pmbase.bi'
  25. REM $INCLUDE: 'windialg.bi'
  26. REM $INCLUDE: 'winmisc.bi'
  27. REM $INCLUDE: 'gpiline.bi'
  28. REM $INCLUDE: 'gpiarea.bi'
  29. REM $INCLUDE: 'gpiarc.bi'
  30. REM $INCLUDE: 'gpicolor.bi'
  31.  
  32. DECLARE FUNCTION DisplayMessageBox%(message$, caption$)
  33.  
  34. COMMON /Gdemo/ cxClient%, cyClient%
  35. CONST       IDMAREA      = 30
  36. CONST       IDDGETPOINTS = 1
  37.  
  38.  
  39. '│**************************************************************
  40. '│ DemoPattern divides the Client window into 15 rows and columns
  41. '│ and then fill each row with a different color from the default color
  42. '│ table.  Each column represents a different fill pattern from the
  43. '│ default pattern set.  Each box in the window is actually draw and
  44. '│ filled separately, starting at the lower left hand corner of the
  45. '│ window, ending at the upper right hand corner.
  46. '│
  47. SUB DemoPatterns(hps&)
  48. SHARED cxClient%, cyClient%
  49. DIM ptl(1) AS POINTL
  50.   '│
  51.   '│ Divide Client window into 15 rows and columns
  52.   '│
  53.   xdiv15& = cxClient% / 15
  54.   ydiv15& = cyClient% / 15
  55.   '│
  56.   '│ Step through colors
  57.   '│
  58.   FOR fcolor% = 1 to 15
  59.     bool% = GpiSetColor(hps&, fcolor%)
  60.     ptl(0).y = ptl(0).Y + ydiv15&
  61.     ptl(0).x = 0
  62.     '│
  63.     '│ Step through patterns
  64.     '│
  65.     FOR pattern& = 0 to 14
  66.       bool% = GpiSetPattern(hps&, pattern&)
  67.       '│
  68.       '│ ptl(0) is upper right hand corner of box
  69.       '│ ptl(1) is lower left hand corner of box
  70.       '│
  71.       ptl(1).x = ptl(0).x : ptl(1).y = ptl(0).y - ydiv15&
  72.       ptl(0).x = ptl(0).x + xdiv15&
  73.  
  74.       bool% = GpiMove(hps&, MakeLong(Varseg(ptl(0)), Varptr(ptl(0))))
  75.       bool% = GpiBox(hps&, DROOUTLINEFILL,_
  76.                      MakeLong(Varseg(ptl(1)), Varptr(ptl(1))),0,0)
  77.  
  78.     NEXT pattern&
  79.   NEXT fcolor%
  80.  
  81. END SUB
  82.  
  83.  
  84. '│**************************************************************
  85. '│ DemoBeginEndArea demonstrates the ability of GpiBegin & End area
  86. '│ to fill a very complex area.  A random design generated from one
  87. '│ of three different Gpi CALLS:
  88. '│
  89. '│          GpiPolyLine - generates a design from straight lines
  90. '│        GpiPolyFillet - generates a design from continuous randomly
  91. '│                         curving line.
  92. '│   GpiPolyFilletSharp - generates a design from many individual curved
  93. '│                        lines.
  94. '│
  95. '│ A number of random points are generated and then stored in the array
  96. '│ "aptl().  The number of points used is selected by the user, which
  97. '│ is inputed through the use of a dialog box, which is control by the
  98. '│ procudure ClientWndProc1.  The default number of points if 50.
  99. '│ Once the points are generated, the pattern is drawn and filled, using
  100. '│ one of the above Gpi routines, depending on which item was selected
  101. '│ from the menu.  If this routine is called due to a WMPAINT message
  102. '│ the dialog box is not displayed and the window is simply repainted
  103. '│ using the previous set of points, this is flagged by a negative
  104. '│ value in "hwnd&".  The dclicked% value determines if a set of new
  105. '│ points should be generated.  If the routine is CALLed due to a
  106. '│ WMCOMMAND message (selected from the menu), or if the user clicked
  107. '│ on the Client window with a design already displayed, then a new set
  108. '│ of points is generated, giving a new design.  Clicking on the Client
  109. '│ window with a design already displayed will allow a new design to
  110. '│ be generated without going through the menu selection.
  111. '│
  112. SUB DemoBeginEndArea(hwnd&, hps&, lastgpi%, dclicked%) STATIC
  113. SHARED cxClient%, cyClient%, points&
  114. DIM aptl(100) AS POINTL
  115.   '│
  116.   '│ If this is first CALL set default number of points
  117.   '│
  118.   IF points& = 0 THEN points& = 50
  119.   '│
  120.   '│ If hwnd& > 0 then allow user to select new number of points
  121.   '│
  122.   IF hwnd& > 0 THEN bool% = WinDlgBox(HWNDDESKTOP, hwnd&,_
  123.                                       RegBas1, 0, IDDGETPOINTS, 0)
  124.   '│
  125.   '│ Set new seed for RND function then generate the select number
  126.   '│ of points to be used for the design.
  127.   '│
  128.   RANDOMIZE TIMER
  129.   IF dclicked% = 1 THEN
  130.     FOR I% = 0 to points&
  131.       aptl(I%).x = INT((cxClient% + 1) * RND)
  132.       aptl(I%).y = INT((cyClient% + 1) * RND)
  133.     NEXT I%
  134.   END IF
  135.   '│
  136.   '│ Set last point equal to first point so that the pattern is
  137.   '│ enclosed.  GpiEndArea will actually close a figure for you if
  138.   '│ you don't explicitly do it yourself.
  139.   '│
  140.   aptl(points&).x = aptl(0).x
  141.   aptl(points&).y = aptl(0).y
  142.   '│
  143.   '│ Move to starting point
  144.   '│
  145.   bool% = GpiMove(hps&, MakeLong(Varseg(aptl(0)), Varptr(aptl(0))))
  146.   '│
  147.   '│ Mark begining of area to be filled
  148.   '│
  149.   bool% = GpiBeginArea(hps&,BAALTERNATE OR BANOBOUNDARY)
  150.   '│
  151.   '│ "lastgpi%" contains ID of menuitem selected.  Use "lastgpi%"
  152.   '│ to determine which Gpi routine to use to generated the design.
  153.   '│
  154.   SELECT CASE lastgpi%
  155.     CASE IDMAREA+3
  156.       bool% = GpiPolyLine(hps&, points&,_
  157.                           MakeLong(Varseg(aptl(1)), Varptr(aptl(1))))
  158.     CASE IDMAREA+4
  159.       bool% = GpiPolyFillet(hps&, points&,_
  160.                             MakeLong(Varseg(aptl(1)), Varptr(aptl(1))))
  161.     CASE IDMAREA+5             
  162.       sharp& =  2 ^ 16
  163.       bool% = GpiPolyFilletSharp(hps&, points&,_
  164.                                  MakeLong(VARSEG(aptl(1)), VARPTR(aptl(1))),_
  165.                                  MakeLong(VARSEG(sharp&), VARPTR(sharp&)))
  166.   END SELECT
  167.   '│
  168.   '│ Mark end of area, and fill it using current color and pattern
  169.   '│
  170.   bool% = GpiEndArea(hps&)
  171.  
  172. END SUB
  173.  
  174. '│**************************************************************
  175. '│ ClientWndProc1 controls the use of the dialog box registered and displayed
  176. '│ with the CALL to WinDlgBox in DemoBeginEndArea.  It consists simply of
  177. '│ a title, a static display field which displays current number of points
  178. '│ selected, a horizontal scrollbar which is used to select points by sliding
  179. '│ left to decrease number and sliding right to increase number ( minimum
  180. '│ number is 3, maximum number is 100), and an "OK" pushbutton used to
  181. '│ enter your selection.
  182. '│
  183. FUNCTION ClientWndProc1& (hwnd&, msg%, mp1&, mp2&)
  184. SHARED points&
  185.  
  186.   SELECT CASE msg%
  187.   '│
  188.   '│ Initialize dialogbox before it is displayed
  189.   '│
  190.     CASE WMINITDLG
  191.       c$ = ltrim$(str$(points&))+chr$(0)
  192.     '│
  193.     '│ Set display field to current number of points selected
  194.     '│
  195.       bool% = WinSetDlgItemText(hwnd&,IDDGETPOINTS+2,_
  196.                                 MakeLong(VARSEG(c$), SADD(c$)))
  197.     '│
  198.     '│ Set scrollbar to relative position for current number of points
  199.     '│ and set the low and upper bounds for the scrollbar, 3 to 100
  200.     '│
  201.       bool& = WinSendDlgItemMsg(hwnd&, IDDGETPOINTS+1,_
  202.                                 SBMSETSCROLLBAR,_
  203.                                 points&,_
  204.                                 MakeLong(100,3))
  205.       ClientWndProc1& = 0
  206.     '│
  207.     '│ Exit and erase dialogbox.  This occurs when the "OK" pushbutton
  208.     '│ is selected
  209.     '│
  210.     CASE WMCOMMAND
  211.       bool% = WinDismissDlg(hwnd&, TRUE)
  212.       ClientWndProc1& = 0
  213.     '│
  214.     '│ When any part of the scrollbar is clicked, this section of code
  215.     '│ is executed, due to the WMHSCROLL message.  The ID of the actual
  216.     '│ part of the scrollbar that was clicked is contained in the highword
  217.     '│ mp2& and extracted to hcommand%.  The point value (3 to 100) for
  218.     '│ the current location of the scrollbar slider is contained in the
  219.     '│ lowword of mp2& and extracted to lowword%.
  220.     '│
  221.     CASE WMHSCROLL
  222.       CALL BreakLong(mp2&, hcommand%, lowword%)
  223.       SELECT CASE hcommand%
  224.         CASE SBLINELEFT
  225.           points& = points& - 1
  226.           if points& = 2 then points& = 3
  227.         CASE SBPAGELEFT
  228.           points& = points& - 10
  229.           if points& < 3 then points& = 3
  230.         CASE SBLINERIGHT
  231.           points& = points& + 1
  232.           IF points& = 101 THEN points& = 100
  233.         CASE SBPAGERIGHT
  234.           points& = points& + 10
  235.           IF points& > 100 THEN points& = 100
  236.         CASE SBSLIDERTRACK
  237.           points& = lowword%
  238.         CASE ELSE
  239.       END SELECT
  240.       '│
  241.       '│ Do not update scrollbar slider if user has clicked on the slider
  242.       '│ itself and is sliding it from left to right.  Once the mouse
  243.       '│ button is released, then update the scrollbar slider to its
  244.       '│ position.  If this is not done, random garbage lines are left
  245.       '│ on the scrollbar as it is move from left to right.
  246.       '│
  247.       IF hcommand% <> SBSLIDERTRACK THEN
  248.         bool& = WinSendDlgItemMsg(hwnd&, IDDGETPOINTS+1,_
  249.                                   SBMSETPOS,_
  250.                                   points&,_
  251.                                   0)
  252.       END IF
  253.       '│
  254.       '│ Set display field to new number of points
  255.       '│
  256.       C$ = LTRIM$(STR$(points&))+CHR$(0)
  257.       bool% = WinSetDlgItemText(hwnd&,IDDGETPOINTS+2,_
  258.                                 MakeLong(VARSEG(c$), SADD(c$)))
  259.       ClientWndProc1& = 0
  260.  
  261.     CASE ELSE
  262.       ClientWndProc1& = WinDefDlgProc(hwnd&, msg%, mp1&, mp2&)
  263.  
  264.   END SELECT
  265. END FUNCTION
  266.  
  267.