home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / OS2BAS.ZIP / GPILINE.BAS < prev    next >
BASIC Source File  |  1989-08-26  |  7KB  |  215 lines
  1. '***********************************************************
  2. '*
  3. '* Program Name: GpiLine.BAS
  4. '*
  5. '* Include File: GpiLine.BI
  6. '*
  7. '* Functions   : GpiBox
  8. '*               GpiMove
  9. '*               Gpiline
  10. '*               GpiPolyLine
  11. '*               GpiSetLineType
  12. '*               GpiQueryLineType
  13. '*               GpiSetLineWidth    (Set/QueryLineWidth not shown
  14. '*               GpiQueryLineWidth   because they are not implemented
  15. '*                                   in OS/2 Version 1.10)
  16. '*               GpiPtVisible
  17. '*               GpiRectVisible
  18. '*               GpiSetCurrentPosition
  19. '*               GpiQueryCurrentPosition
  20. '*
  21. '*  << The remaining routines contained in the GpiLine.BI >>
  22. '*  << are demonstrated in GpiPath.BAS                    >>
  23. '*
  24. '* Description : This programs demonstrates the Drawing
  25. '*               routines contained in GpiLine.BI.  Some
  26. '*               routines do not have a visual effect so
  27. '*               return values from these CALLs are written
  28. '*               out to the file "GpiLine.OUT".
  29. '*
  30. '*               rouines demonstrated are contained in the
  31. '*               SUBprogram ScreenPaint which is called from
  32. '*               ClientWinProc when a WMPAINT message is received.
  33. '***********************************************************
  34.  
  35. '*********         Initialization section        ***********
  36.  
  37. REM $INCLUDE: 'OS2Def.BI'
  38. REM $INCLUDE: 'PMBase.BI'
  39. REM $INCLUDE: 'WinMan1.BI'
  40. REM $INCLUDE: 'GpiCont.BI'
  41. REM $INCLUDE: 'GpiArea.BI'
  42. REM $INCLUDE: 'GpiLine.BI'
  43.  
  44. DECLARE SUB ScreenPaint(hwnd&)
  45.  
  46. DIM aqmsg AS QMSG
  47. DIM SHARED ClientRect AS RECTL
  48.  
  49. OPEN "GpiLine.OUT" FOR OUTPUT AS #1
  50.  
  51. flFrameFlags& =  FCFTITLEBAR      OR FCFSYSMENU OR _
  52.                  FCFSIZEBORDER    OR FCFMINMAX  OR _
  53.                  FCFSHELLPOSITION OR FCFTASKLIST
  54.  
  55. szClientClass$ = "ClassName" + CHR$(0)
  56.  
  57. hab&  = WinInitialize    (0)
  58. hmq&  = WinCreateMsgQueue(hab&, 0)
  59.  
  60. bool% = WinRegisterClass(_
  61.         hab&,_
  62.         MakeLong(VARSEG(szClientClass$), SADD(szClientClass$)),_
  63.         RegBas,_
  64.         0,_
  65.         0)
  66.  
  67. hwndFrame& = WinCreateStdWindow (_
  68.              HWNDDESKTOP,_
  69.              WSVISIBLE,_
  70.              MakeLong(VARSEG(flFrameFlags&),  VARPTR(flFrameFlags&)),_
  71.              MakeLong(VARSEG(szClientClass$), SADD(szClientClass$)),_
  72.              0,_
  73.              0,_
  74.              0,_
  75.              0,_
  76.              MakeLong(VARSEG(hwndClient&), VARPTR(hwndClient&)))
  77.  
  78. '**************         Message loop         ***************
  79.  
  80. WHILE WinGetMsg(hab&, MakeLong(VARSEG(aqmsg), VARPTR(aqmsg)), 0, 0, 0)
  81.   bool% = WinDispatchMsg(hab&, MakeLong(VARSEG(aqmsg), VARPTR(aqmsg)))
  82. WEND
  83.  
  84. '***********         Finalize section        ***************
  85.  
  86. bool% = WinDestroyWindow   (hwndFrame&)
  87. bool% = WinDestroyMsgQueue (hmq&)
  88. bool% = WinTerminate       (hab&)
  89. CLOSE #1
  90.  
  91. END
  92.  
  93. '***********         Window procedure        ***************
  94.  
  95. FUNCTION ClientWndProc& (hwnd&, msg%, mp1&, mp2&)
  96.   ClientWndProc& = 0
  97.   SELECT CASE msg%
  98.     CASE WMPAINT
  99.       '**** WinInvalidateRect ensures entire window is repainted ****
  100.       bool% = WinInvalidateRect(hwnd&, 0, 0)
  101.       CALL ScreenPaint(hwnd&)
  102.     CASE ELSE
  103.       ClientWndProc& = WinDefWindowProc(hwnd&, msg%, mp1&, mp2&)
  104.   END SELECT
  105. END FUNCTION
  106.  
  107. '*
  108. '* SUBprogram ScreenPaint:  Called from ClientWndProc& when a WMPAINT
  109. '*                          message is received.
  110. '*
  111. SUB ScreenPaint(hwnd&)
  112. DIM ppnt AS POINTL, appnt(3) AS POINTL, rect AS RECTL
  113.   hps&  = WinBeginPaint (hwnd&, 0,_
  114.           MakeLong(VARSEG(ClientRect), VARPTR(ClientRect)))
  115.   bool% = GpiErase      (hps&)
  116. '*
  117. '* Check if a POINT (100,100) and the RECTANGLE (0,0)-(100,100) are
  118. '* visible (within the client area).
  119. '*
  120.     ppnt.x = 100
  121.     ppnt.y = 100
  122.     IF GpiPtVisible(hps&,_
  123.                     MakeLong(VARSEG(ppnt), VARPTR(ppnt))) = PVISVISIBLE THEN
  124.       PRINT #1,"Point 100,100 is VISIBLE"
  125.     ELSE
  126.       PRINT #1,"Point 100,100 is INVISIBLE"
  127.     END IF
  128.  
  129.     rect.xLeft   = 0
  130.     rect.yBottom = 0
  131.     rect.xRight  = 100
  132.     rect.yTop    = 100
  133.     SELECT CASE GpiRectVisible(hps&,_
  134.                                MakeLong(VARSEG(rect), VARPTR(rect)))
  135.       CASE RVISINVISIBLE
  136.     PRINT #1,"Rectangle is INVISIBLE"
  137.       CASE RVISVISIBLE
  138.     PRINT #1,"Rectangle is VISIBLE"
  139.       CASE RVISPARTIAL
  140.     PRINT #1,"Rectangle is PARTIALLY VISIBLE"
  141.       CASE ELSE
  142.     PRINT #1,"GpiRectVisible ERROR"
  143.     END SELECT
  144. '*
  145. '* Set then Query the current pixel position
  146. '*
  147.    ppnt.x = 100
  148.    ppnt.y = 100
  149.    bool% = GpiSetCurrentPosition   (hps&,_
  150.            MakeLong(VArSEG(ppnt), VARPTR(ppnt)))
  151.    bool% = GpiQueryCurrentPosition (hps&,_
  152.            MakeLong(VARSEG(ppnt), VARPTR(ppnt)))
  153.    PRINT #1,"Current postion is (";ppnt.x;",";ppnt.y;")"
  154. '*
  155. '*
  156. '* The following FOR NEXT loop, fills the Client window with
  157. '* horizontal lines of varying Line types.  Query Line Type and
  158. '* write Line type to file.
  159. '*
  160.   FOR I% = 0 TO ClientRect.yTop STEP 3
  161.     bool% = GpiSetLineType(hps&, linetype%)
  162.     PRINT #1,"GpiQueryLineType = "; GpiQueryLineType(hps&)
  163.  
  164.     linetype% = linetype% + 1
  165.     IF linetype% = 10 THEN linetype% = 0
  166.     ppnt.x = 0
  167.     ppnt.y = I%
  168.     bool%  = GpiMove(hps&, MakeLong(VARSEG(ppnt), VARPTR(ppnt)))
  169.     ppnt.x = ClientRect.xRight
  170.     along& = GpiLine(hps&, MakeLong(VARSEG(ppnt), VARPTR(ppnt)))
  171.   NEXT
  172. '*
  173. '* Initializes ppnt TYPE with lower left and upper right corners
  174. '* of box to be drawn.  Uses Client window coordinates so box is always
  175. '* drawn proportional to Client window
  176. '*
  177.   ppnt.x = ClientRect.xRight \ 8
  178.   ppnt.y = ClientRect.yTop \ 8
  179.   bool%  = GpiMove(hps&, MakeLong(VARSEG(ppnt), VARPTR(ppnt)))
  180.   ppnt.x = 7 * ppnt.x
  181.   ppnt.y = 7 * ppnt.y
  182. '*
  183. '* Sets fill pattern and draws box
  184. '*
  185.   bool%  = GpiSetPattern(hps&, PATSYMHALFTONE)
  186.   along& = GpiBox       (hps&, DROOUTLINEFILL,_
  187.        MakeLong(VARSEG(ppnt), VARPTR(ppnt)), 0, 0)
  188. '*
  189. '* Sets patten and marks beginning of area to be filled when the
  190. '* GpiEndArea is executed
  191. '*
  192.   bool% = GpiSetPattern(hps&, PATSYMSOLID)
  193.   bool% = GpiBeginArea (hps&,(BAALTERNATE OR BABOUNDARY))
  194. '*
  195. '* Initializes array with points that define polygon to be draw
  196. '* points are calculated using the current Client window coordinates
  197. '* so that the polygon is always draw proportional to the Client window
  198. '*
  199.   appnt(0).x = (ClientRect.xRight \ 8)*2 : appnt(0).y = ClientRect.yTop \ 2
  200.   appnt(1).x = ClientRect.xRight \ 2     : appnt(1).y = (ClientRect.yTop \ 8)*6
  201.   appnt(2).x = (ClientRect.xRight \ 8)*6 : appnt(2).y = ClientRect.yTop \ 2
  202.   appnt(3).x = ClientRect.xRight \ 2     : appnt(3).y = (ClientRect.yTop \ 8)*2
  203. '*
  204. '* Moves to first point of polygon then draws polygon
  205. '*
  206.   retn% = GpiMove    (hps&,    MakeLong(VARSEG(appnt(0)), VARPTR(appnt(0))))
  207.   retn% = GpiPolyLine(hps&, 3, MakeLong(VARSEG(appnt(1)), VARPTR(appnt(1))))
  208. '*
  209. '* Marks end of Area and fills polygon with current pattern and color
  210. '*
  211.   retn% = GpiEndArea (hps&)
  212.   retn% = WinEndPaint(hps&)
  213.  
  214. END SUB
  215.