home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / OS2BAS.ZIP / LINEMOD.BAS < prev    next >
BASIC Source File  |  1989-08-13  |  3KB  |  90 lines
  1. '│*****************************************************************
  2. '│
  3. '│ Module:       LineMod.bas
  4. '│
  5. '│ Subprograms:  DemoLine
  6. '│
  7. '│ Description:  DemoLine initially fills the Client window with
  8. '│               lines a varying types and colors.  A blue transparent
  9. '│               blue box is then drawn in the middle of the window,
  10. '│               and then a ren diamond is drawn in the middle of the
  11. '│               box.  This is the same routine found in GpiLine.BAS
  12. '│               minus all the CALLs that do not have a visible affect.
  13. '│
  14. '│******************************************************************
  15.  
  16. REM $INCLUDE: 'os2def.bi'
  17. REM $INCLUDE: 'pmbase.bi'
  18. REM $INCLUDE: 'gpiline.bi'
  19. REM $INCLUDE: 'gpiarea.bi'
  20. REM $INCLUDE: 'gpicolor.bi'
  21.  
  22. COMMON /Gdemo/ cxClient%, cyClient%
  23.  
  24. SUB DemoLine(hps&)
  25. SHARED cxClient%, cyClient%
  26. DIM ppnt AS POINTL, appnt(3) AS POINTL
  27.  
  28. '│
  29. '│ The following FOR NEXT loop, fills the Client window with
  30. '│ horizontal lines of varying Line types and colors.
  31. '│
  32.   colorcntr% = 1
  33.   FOR I% = 0 TO cyClient% STEP 3
  34.     bool% = GpiSetColor(hps&, colorcntr%)
  35.     colorcntr% = colorcntr% + 1
  36.     IF colorcntr% = 16 THEN colorcntr% = 1    'CHECK IF AT END OF COLOR TABLE
  37.     bool% = GpiSetLineType(hps&, linetype%)
  38.     linetype% = linetype% + 1                 'INCRIMENT LINETYPE COUTER AND
  39.     If linetype% = 10 then linetype% = 0      'AND CHECK RESET IF AT LAST TYPE
  40.     ppnt.x = 0
  41.     ppnt.y = I%
  42.     bool% = GpiMove(hps&, MakeLong(Varseg(ppnt), Varptr(ppnt)))
  43.     ppnt.x = cxClient%
  44.     along& = GpiLine(hps&, MakeLong(Varseg(ppnt), Varptr(ppnt)))
  45.   NEXT
  46. '│
  47. '│ Draws a Box and fills it using the GpiBox routine.  The box is filled
  48. '│ a halftone pattern and the color blue, which makes it appear transparent.
  49. '│
  50.   ppnt.x = cxClient% \ 8      'LOWER LEFT HAND CORNER OF BOX
  51.   ppnt.y = cyClient% \ 8
  52.   bool% = GpiMove(hps&, MakeLong(Varseg(ppnt), Varptr(ppnt)))
  53.   ppnt.x = 7 * ppnt.x
  54.   ppnt.y = 7 * ppnt.y         'UPPER RIGHT HAND CORNER OF BOX
  55. '│
  56. '│ Sets fill pattern and draws box
  57. '│
  58.   bool% = GpiSetColor(hps&, CLRBLUE)
  59.   bool% = GpiSetPattern(hps&, PATSYMHALFTONE)
  60.   along& = GpiBox(hps&, DROOUTLINEFILL,_
  61.                   MakeLong(Varseg(ppnt), Varptr(ppnt)), 0, 0)
  62. '│
  63. '│ Sets patten and marks beginning of area to be filled when the
  64. '│ GpiEndArea is executed
  65. '│
  66.   bool% = GpiSetColor(hps&, CLRRED)
  67.   bool% = GpiSetPattern(hps&, PATSYMSOLID)
  68.   bool% = GpiBeginArea(hps&,(BAALTERNATE OR BABOUNDARY))
  69. '│
  70. '│ Initializes array with points that define polygon to be draw
  71. '│ points are calculated using the current Client window coordinates
  72. '│ so that the polygon is always draw proportional to the Client window
  73. '│
  74.   appnt(0).x = (cxClient% \ 8) * 2 : appnt(0).y = cyClient% \ 2
  75.   appnt(1).x = cxClient% \ 2       : appnt(1).y = (cyClient% \ 8) * 6
  76.   appnt(2).x = (cxClient% \ 8) * 6 : appnt(2).y = cyClient% \ 2
  77.   appnt(3).x = cxClient% \ 2       : appnt(3).y = (cyClient% \ 8) * 2
  78. '│
  79. '│ Moves to first point of polygon then draws polygon
  80. '│
  81.   bool% = GpiMove(hps&, MakeLong(Varseg(appnt(0)), Varptr(appnt(0))))
  82.   bool% = GpiPolyLine(hps&, 3&, MakeLong(Varseg(appnt(1)), Varptr(appnt(1))))
  83. '│
  84. '│ Marks end of Area and fills polygon with current pattern and color
  85. '│
  86.   bool% = GpiEndArea(hps&)
  87.  
  88. END SUB
  89.  
  90.