home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / OS2BAS.ZIP / GPIARC.BAS < prev    next >
Encoding:
BASIC Source File  |  1989-08-26  |  8.5 KB  |  239 lines
  1. '***********************************************************
  2. '*
  3. '* Program Name: GpiArc.BAS
  4. '*
  5. '* Include File: GpiArc.BI
  6. '*
  7. '* Functions   : GpiSetArcParams
  8. '*               GpiQueryArcParams
  9. '*               GpiPointArc
  10. '*               GpiFullArc
  11. '*               GpiPartialArc
  12. '*               GpiPolyFilletSharp
  13. '*               GpiPolySpline
  14. '*               GpiPolyFillet
  15. '*
  16. '* Description : This program demonstrates how to call the various
  17. '*               routines contained in GpiArc.BI.  Multiple arcs
  18. '*               are displayed using each of the GpiArc routines.
  19. '*               The arcs are not calculated to be drawn proportional
  20. '*               to the current size of the Client window.  For proper
  21. '*               display, the Client window must be maximized.  The
  22. '*               Client window is initially maximized using
  23. '*               WinSetWindowPos.  The arcs displayed are created
  24. '*               with and positioned on the screen as follows:
  25. '*             +---------------------------------------------------+
  26. '*             | GpiPartialArc   GpiFullArc     GpiPointArc        |
  27. '*             |                                                   |
  28. '*             | GpiPolySpline   GpiPolyFillet  GpiPolyFilletSharp |
  29. '*             +---------------------------------------------------+
  30. '***********************************************************
  31.  
  32. '*********         Initialization section        ***********
  33.  
  34. REM $INCLUDE: 'OS2Def.BI'
  35. REM $INCLUDE: 'PMBase.BI'
  36. REM $INCLUDE: 'WinMan1.BI'   Needed for WinInvalidateRect
  37. REM $INCLUDE: 'GpiCont.BI'   Needed for GpiErase
  38. REM $INCLUDE: 'GpiLine.BI'   Needed for GpiMove
  39. REM $INCLUDE: 'GpiArea.BI'   Needed for CONST used by GpiFullArc
  40. REM $INCLUDE: 'GpiArc.BI'
  41.  
  42. DECLARE SUB ScreenPaint(hwnd&)
  43. DECLARE FUNCTION MakeFixed&(realnum#)
  44.  
  45. DIM aqmsg AS QMSG
  46.  
  47. flFrameFlags& =  FCFTITLEBAR      OR FCFSYSMENU OR _
  48.                  FCFSIZEBORDER    OR FCFMINBUTTON OR _
  49.                  FCFSHELLPOSITION OR FCFTASKLIST
  50.  
  51. szClientClass$ = "ClassName" + CHR$(0)
  52.  
  53. hab&  = WinInitialize    (0)
  54. hmq&  = WinCreateMsgQueue(hab&, 0)
  55.  
  56. bool% = WinRegisterClass(_
  57.         hab&,_
  58.         MakeLong(VARSEG(szClientClass$), SADD(szClientClass$)),_
  59.         RegBas,_
  60.         0,_
  61.         0)
  62.  
  63. hwndFrame& = WinCreateStdWindow (_
  64.              HWNDDESKTOP,_
  65.              WSVISIBLE,_
  66.              MakeLong (VARSEG(flFrameFlags&),  VARPTR(flFrameFlags&)),_
  67.              MakeLong (VARSEG(szClientClass$), SADD(szClientClass$)),_
  68.              0,_
  69.              0,_
  70.              0,_
  71.              0,_
  72.              MakeLong (VARSEG(hwndClient&), VARPTR(hwndClient&)))
  73.  
  74. bool% = WinSetWindowPos(hwndFrame&, 0, 0, 0, 0, 0, SWPMAXIMIZE)
  75.  
  76. '**************         Message loop         ***************
  77.  
  78. WHILE WinGetMsg(hab&, MakeLong(VARSEG(aqmsg), VARPTR(aqmsg)), 0, 0, 0)
  79.   bool% = WinDispatchMsg(hab&, MakeLong(VARSEG(aqmsg), VARPTR(aqmsg)))
  80. WEND
  81.  
  82. '***********         Finalize section        ***************
  83.  
  84. bool% = WinDestroyWindow  (hwndFrame&)
  85. bool% = WinDestroyMsgQueue(hmq&)
  86. bool% = WinTerminate      (hab&)
  87. END
  88.  
  89. '***********         Window procedure        ***************
  90.  
  91. FUNCTION ClientWndProc& (hwnd&, msg%, mp1&, mp2&) STATIC
  92. SHARED cxClient%, cyClient%
  93.  
  94.   ClientWndProc&=0
  95.   SELECT CASE msg%
  96.     CASE WMSIZE
  97.       CALL BreakLong(mp2&, cyClient%, cxClient%)
  98.     CASE WMPAINT
  99.       bool% = WinInvalidateRect%(hwnd&, 0, 0)
  100.       CALL ScreenPaint(hwnd&)
  101.     CASE ELSE        'Pass control to system for other messages
  102.       ClientWndProc& = WinDefWindowProc(hwnd&, msg%, mp1&, mp2&)
  103.   END SELECT
  104.  
  105. END FUNCTION
  106.  
  107. '**********************************************************************
  108. '*                                                                    *
  109. '* SUBprogram ScreenPaint:  Called from ClientWndProc& when a WMPAINT *
  110. '*                          message is received.                      *
  111. '*                                                                    *
  112. '**********************************************************************
  113. SUB ScreenPaint(hwnd&)
  114. SHARED cxClient%, cyClient%
  115. DIM ptl(3) AS POINTL, arcp AS ARCPARAMS
  116.  
  117.   hps&  = WinBeginPaint(hwnd&, 0, 0)
  118.   bool% = GpiErase     (hps&)
  119. '*
  120. '* Set Arc parameters to be used by GpiArc, GpiFullArc, GpiPartialArc,
  121. '* then Query the Arc parameters to demonstrate GpiQueryArcParams.
  122. '* The below parameters will produce a unit circle.
  123. '*
  124.   arcp.LP = 1
  125.   arcp.LQ = 1
  126.   arcp.LR = 0
  127.   arcp.LS = 0
  128.   bool%   = GpiSetArcParams  (hps&, MakeLong(VARSEG(arcp), VARPTR(arcp)))
  129.   bool%   = GpiQueryArcParams(hps&, MakeLong(VARSEG(arcp), VARPTR(arcp)))
  130. '*
  131. '* Initialize ptl() with starting points for GpiPointArc
  132. '*
  133.   ptl(0).x = cxClient% / 3 * 2 : ptl(0).y = cyClient% / 3 * 2
  134.   ptl(1).x = cxClient% / 6 * 5
  135.   ptl(2).x = cxClient%         : ptl(2).y = ptl(0).y
  136.   Ystart&  = cyClient%
  137.   Yend&    = ptl(0).y
  138. '*
  139. '* Draw multiple arcs, decreasing first control point after each arc.
  140. '*
  141.   FOR Y& = cyClient% TO ptl(0).y STEP - 5
  142.     ptl(1).y = Y&
  143.     bool%    = GpiMove    (hps&, MakeLong(VARSEG(ptl(0)), VARPTR(ptl(0))))
  144.     bool%    = GpiPointArc(hps&, MakeLong(VARSEG(ptl(1)), VARPTR(ptl(1))))
  145.   NEXT Y&
  146. '*
  147. '* Set ptl() to center point of circle for GpiFullArc, then draw multiple
  148. '* circles using same center point but increasing size of each circle.
  149. '*
  150.   ptl(1).x = cxClient% / 2 - 7
  151.   ptl(1).y = cyClient% / 4 * 3
  152.   bool%    = GpiMove(hps&, MakeLong(VARSEG(ptl(1)), VARPTR(ptl(1))))
  153.   FOR I#   = 1 to 106 step 5
  154.     bool%  = GpiFullArc(hps&, DROOUTLINE, MakeFixed(I#))
  155.   NEXT
  156. '*
  157. '* Initialize ptl() to center of arc for GpiPartialArc, then draw
  158. '* multiple arcs using same start angle, but decreasing sweep angle.
  159. '*
  160.   ptl(1).x = 0
  161.   startA&  = MakeFixed(315)
  162.   FOR I%   = 1 to 24
  163.     multiplier& = MakeFixed(210 - I% * 4)
  164.     sweepA&     = MakeFixed(99 - I% * 4)
  165.     bool%       = GpiMove      (hps&, MakeLong(VARSEG(ptl(1)), VARPTR(ptl(1))))
  166.     bool%       = GpiPartialArc(hps&,_
  167.                   MakeLong(VARSEG(ptl(1)), VARPTR(ptl(1))),_
  168.                   multiplier&, startA&, sweepA&)
  169.   NEXT I%
  170. '*
  171. '* Initialize ptl() to starting control points GpiSpline
  172. '*
  173.   ptl(0).x = 0   : ptl(0).y = 0
  174.   ptl(1).x = 20  : ptl(1).y = cyClient% * 1.08
  175.   ptl(2).x = 142 : ptl(2).y = 80
  176.   ptl(3).x = 213 : ptl(3).y = 80
  177. '*
  178. '* Draw multiple Splines, using same start and end points, with
  179. '* decreasing first and second control points
  180. '*
  181.   FOR I% = 1 to 30
  182.     bool%    = GpiMove      (hps&, MakeLong(VARSEG(ptl(0)), VARPTR(ptl(0))))
  183.     bool%    = GpiPolySpline(hps&, 3, MakeLong(VARSEG(ptl(1)), VARPTR(ptl(1))))
  184.     ptl(1).y = ptl(1).y - 8
  185.     ptl(2).y = ptl(2).y - 8
  186.   NEXT
  187. '*
  188. '* Initialize ptl() to starting control points for GpiPolyFillet
  189. '*
  190.   ptl(0).x = cxClient% / 3     : ptl(0).y = cyClient% / 2
  191.   ptl(1).x = cxClient% / 3 * 2 : ptl(1).y = ptl(0).y
  192.   ptl(2).x = ptl(1).x          : ptl(2).y = 0
  193.   ptl(3).x = ptl(0).x          : ptl(3).y = 0
  194. '*
  195. '* Draw multiple Fillets within a rectangle decreasing in size
  196. '* with the lower left corner remaining constant
  197. '*
  198.   FOR I% = 1 to 30
  199.     bool%    = GpiMove      (hps&,    MakeLong(VARSEG(ptl(3)), VARPTR(ptl(3))))
  200.     bool%    = GpiPolyFillet(hps&, 4, MakeLong(VARSEG(ptl(0)), VARPTR(ptl(0))))
  201.     ptl(0).y = ptl(0).y - 6
  202.     ptl(1).x = ptl(1).x - 6
  203.     ptl(1).y = ptl(1).y - 6
  204.     ptl(2).x = ptl(2).x - 6
  205.   NEXT
  206. '*
  207. '* Initialize ptl() to control points for GpiPolyFilletSharp
  208. '*
  209.   ptl(0).x = cxClient% / 3 * 2 : ptl(0).y = 0
  210.   ptl(1).x = ptl(0).x          : ptl(1).y = cyClient% / 3 * 2
  211.   ptl(2).x = cxClient%         : ptl(2).y = cyClient% / 3
  212.   sharpness# = 6#
  213. '*
  214. '* Draw multiple Fillets using same control points, but with
  215. '* decrease sharpness value
  216. '*
  217.   FOR I% = 1 to 30
  218.     sharp& = MakeFixed(sharpness#)
  219.     bool%  = GpiMove           (hps&, MakeLong(VARSEG(ptl(0)), VARPTR(ptl(0))))
  220.     bool%  = GpiPolyFilletSharp(hps&, 2&,_
  221.              MakeLong(VARSEG(ptl(1)), VARPTR(ptl(1))),_
  222.              MakeLong(VARSEG(sharp&), VARPTR(sharp&)))
  223.     sharpness# = sharpness# - .2#
  224.   NEXT
  225.  
  226.   bool% = WinEndPaint(hps&)
  227.  
  228. END SUB
  229.  
  230. '**********************************************************************
  231. '*                                                                    *
  232. '* FUNCTION MakeFixed:  Make a fixed-point, 32-bit real number needed *
  233. '*                      for several functions in GpiArc.BI            *
  234. '*                                                                    *
  235. '**********************************************************************
  236. FUNCTION MakeFixed&(realnum#)
  237.   MakeFixed& = realnum# * 2 ^ 16
  238. END FUNCTION
  239.