home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / OS2BAS.ZIP / GPIAREA.BAS < prev    next >
BASIC Source File  |  1989-08-26  |  7KB  |  210 lines
  1. '***********************************************************
  2. '*
  3. '* Program Name: GpiArea.BAS
  4. '*
  5. '* Include File: GpiArea.BI
  6. '*
  7. '* Functions   : GpiSetPattern
  8. '*               GpiQueryPattern
  9. '*               GpiBeginArea
  10. '*               GpiEndArea
  11. '*               GpiSetPatternSet
  12. '*               GpiQueryPatternSet
  13. '*               GpiSetPatternRefPoint
  14. '*               GpiQueryPatternRefPoint
  15. '*               GpiSetMix
  16. '*               GpiQueryMix
  17. '*               GpiSetBackMix
  18. '*               GpiQueryBackMix
  19. '*
  20. '* Description : GpiArea.BAS fills the window with 16 diamonds
  21. '*               drawn proportionally to the size of the Client
  22. '*               window, and paints each diamond with a different
  23. '*               pattern.  CALLs to routines in GpiArea.BI not
  24. '*               used in the SUBprogram "ScreenPaint" are
  25. '*               demonstrated in the SUBprogram following "ScreenPaint"
  26. '***********************************************************
  27.  
  28. '*********         Initialization section        ***********
  29.  
  30. REM $INCLUDE: 'OS2Def.BI'
  31. REM $INCLUDE: 'PMBase.BI'
  32. REM $INCLUDE: 'WinMan1.BI'   Needed for WinInvalidateRect
  33. REM $INCLUDE: 'GpiCont.BI'   Needed for GpiErase
  34. REM $INCLUDE: 'GpiLine.BI'   Needed for GpiPolyLine & GpiMove
  35. REM $INCLUDE: 'GpiArea.BI'
  36.  
  37. DECLARE SUB ScreenPaint(hwnd&)
  38. DECLARE SUB DemonstrateCallsNotUsedInScreenPaint(hwnd&)
  39.  
  40. DIM aqmsg AS QMSG
  41. DIM SHARED ClientRect as RECTL
  42.  
  43. flFrameFlags& =  FCFTITLEBAR      OR FCFSYSMENU OR _
  44.                  FCFSIZEBORDER    OR FCFMINMAX  OR _
  45.                  FCFSHELLPOSITION OR FCFTASKLIST
  46.  
  47. szClientClass$ = "ClassName" + CHR$(0)
  48.  
  49. hab&  = WinInitialize    (0)
  50. hmq&  = WinCreateMsgQueue(hab&, 0)
  51.  
  52. bool% = WinRegisterClass(_
  53.         hab&,_
  54.         MakeLong(VARSEG(szClientClass$), SADD(szClientClass$)),_
  55.         RegBas,_
  56.         CSSIZEREDRAW,_
  57.         0)
  58.  
  59. hwndFrame& = WinCreateStdWindow (_
  60.              HWNDDESKTOP,_
  61.              WSVISIBLE,_
  62.              MakeLong (VARSEG(flFrameFlags&),  VARPTR(flFrameFlags&)),_
  63.              MakeLong (VARSEG(szClientClass$), SADD(szClientClass$)),_
  64.              0,_
  65.              0,_
  66.              0,_
  67.              0,_
  68.              MakeLong (VARSEG(hwndClient&), VARPTR(hwndClient&)))
  69.  
  70. '**************         Message loop         ***************
  71.  
  72. WHILE WinGetMsg(hab&, MakeLong(VARSEG(aqmsg), VARPTR(aqmsg)), 0, 0, 0)
  73.   bool% = WinDispatchMsg(hab&, MakeLong(VARSEG(aqmsg), VARPTR(aqmsg)))
  74. WEND
  75.  
  76. '***********         Finalize section        ***************
  77.  
  78. bool% = WinDestroyWindow  (hwndFrame&)
  79. bool% = WinDestroyMsgQueue(hmq&)
  80. bool% = WinTerminate      (hab&)
  81. END
  82.  
  83. '***********         Window procedure        ***************
  84.  
  85. FUNCTION ClientWndProc& (hwnd&, msg%, mp1&, mp2&) STATIC
  86.  
  87.   ClientWndProc& = 0
  88.   SELECT CASE msg%
  89.     CASE WMCREATE
  90.       CALL DemonstrateCallsNotUsedInScreenPaint(hwnd&)
  91.     CASE WMPAINT
  92.       bool% = WinInvalidateRect%(hwnd&, 0, 0)
  93.       CALL ScreenPaint(hwnd&)
  94.     CASE ELSE        'Pass control to system for other messages
  95.       ClientWndProc& = WinDefWindowProc(hwnd&, msg%, mp1&, mp2&)
  96.   END SELECT
  97.  
  98. END FUNCTION
  99.  
  100. '*
  101. '* SUBprogram ScreenPaint:  Called from ClientWndProc& when a WMPAINT
  102. '*                          message is received.
  103. '*
  104. SUB ScreenPaint(hwnd&)
  105. DIM aptl(4) AS POINTL
  106.  
  107.   hps&  = WinBeginPaint(hwnd&, 0,_
  108.           MakeLong(VARSEG(ClientRect), VARPTR(ClientRect)))
  109.   bool% = GpiErase(hps&)
  110.  
  111.   patterncntr& = 1
  112. '*
  113. '* Divide Window by 8th's and 4th's
  114. '*
  115.   xdiv8& = ClientRect.xRight / 8
  116.   ydiv8& = ClientRect.yTop / 8
  117.   xdiv4& = ClientRect.xRight / 4
  118.   ydiv4& = ClientRect.yTop / 4
  119.   row& = ydiv8&
  120.  
  121.   FOR I%    = 1 TO 4
  122.     column& = 0
  123.     FOR N%  = 1 TO 4
  124. '*
  125. '* Set Fill Pattern.  The pattern is set the Queried to
  126. '* demonstrate both GpiSetPattern and GpiQueryPattern
  127. '* The Query is not neccessary.  Skip Pattern 15 since it is
  128. '* the same as the background color.  "patterncntr&" corresponds
  129. '* to the CONSTants for the pattern names in GpiArea.BI:
  130. '*
  131. '*    CONST  PATSYMDENSE1    =      1
  132. '*    CONST  PATSYMDENSE2    =      2
  133. '*    CONST  PATSYMDENSE3    =      3
  134. '*    CONST  PATSYMDENSE4    =      4
  135. '*    CONST  PATSYMDENSE5    =      5
  136. '*    CONST  PATSYMDENSE6    =      6
  137. '*    CONST  PATSYMDENSE7    =      7
  138. '*    CONST  PATSYMDENSE8    =      8
  139. '*    CONST  PATSYMVERT      =      9
  140. '*    CONST  PATSYMHORIZ     =      10
  141. '*    CONST  PATSYMDIAG1     =      11
  142. '*    CONST  PATSYMDIAG2     =      12
  143. '*    CONST  PATSYMDIAG3     =      13
  144. '*    CONST  PATSYMDIAG4     =      14
  145. '*    CONST  PATSYMNOSHADE   =      15
  146. '*    CONST  PATSYMSOLID     =      16
  147. '*    CONST  PATSYMHALFTONE  =      17
  148. '*
  149.       bool%       = GpiSetPattern  (hps&, patterncntr&)
  150.       pattercntr& = GpiQueryPattern(hps&)
  151.  
  152.       patterncntr& = patterncntr& + 1&
  153.       if patterncntr& = 15 then patterncntr& = 16
  154. '*
  155. '* Initialize aptl() with points for polygon to be
  156. '* drawn with GpiPolyLine
  157. '*
  158.       aptl(1).x = column&          : aptl(1).y = row&
  159.       aptl(2).x = column& + xdiv8& : aptl(2).y = row& + ydiv8&
  160.       aptl(3).x = column& + xdiv4& : aptl(3).y = row&
  161.       aptl(4).x = column& + xdiv8& : aptl(4).y = row& - ydiv8&
  162. '*
  163. '* Mark Beginning of area to be filled
  164. '*
  165.       bool% = GpiBeginArea(hps&, BAALTERNATE OR BABOUNDARY)
  166. '*
  167. '* Move to first point of polygon then draw polygon
  168. '*
  169.       bool% = GpiMove    (hps&, MakeLong(VARSEG(aptl(1)), VARPTR(aptl(1))))
  170.       bool% = GpiPolyLine(hps&, 3,_
  171.               MakeLong(VARSEG(aptl(2)), VARPTR(aptl(2))))
  172. '*
  173. '* Mark end of area to be filled and fill area
  174. '*
  175.       bool%   = GpiEndArea(hps&)
  176.  
  177.       column& = column& + xdiv4&
  178.     NEXT N%
  179.     row& = row& + ydiv4&
  180.   NEXT I%
  181.  
  182.   bool% = WinEndPaint(hps&)
  183.  
  184. END SUB
  185. '*
  186. '* The SUBprogram is called when the WMCREATE message is received.
  187. '* It simply Sets then Querys values used in GpiArea.BI to
  188. '* demonstrate GpiArea.BI calls not used in ScreenPaint
  189. '*
  190. SUB DemonstrateCallsNotUsedInScreenPaint(hwnd&)
  191. DIM pptl AS POINTL
  192.  
  193.   hps&  = WinGetPS(hwnd&)
  194.  
  195.     bool% = GpiSetPatternSet  (hps&, LCIDDEFAULT)
  196.     pat&  = GpiQueryPatternSet(hps&)
  197.  
  198.     bool% = GpiSetPatternRefPoint  (hps&, MakeLong(VARSEG(pptl), VARPTR(pptl)))
  199.     bool% = GpiQueryPatternRefPoint(hps&, MakeLong(VARSEG(pptl), VARPTR(pptl)))
  200.  
  201.     bool% = GpiSetMix  (hps&, FMDEFAULT)
  202.     mix&  = GpiQueryMix(hps&)
  203.  
  204.     bool% = GpiSetBackMix  (hps&, BMDEFAULT)
  205.     bmix& = GpiQueryBackMix(hps&)
  206.  
  207.   bool% = WinReleasePS(hps&)
  208.  
  209. END SUB
  210.