home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / OS2BAS.ZIP / GPIRGN.BAS < prev    next >
Encoding:
BASIC Source File  |  1989-08-26  |  9.6 KB  |  270 lines
  1. '***********************************************************
  2. '*
  3. '* Program Name:  GpiRgn.BAS
  4. '*
  5. '* Include File:  GpiRgn.BI
  6. '*
  7. '* Functions   :  GpiCreateRegion
  8. '*                GpiSetRegion
  9. '*                GpiDestroyRegion
  10. '*                GpiCombineRegion&
  11. '*                GpiEqualRegion
  12. '*                GpiOffsetRegion
  13. '*                GpiPtInRegion&
  14. '*                GpiRectInRegion
  15. '*                GpiQueryRegionBox
  16. '*                GpiQueryRegionRects
  17. '*                GpiIntersectClipRectangle
  18. '*                GpiPaintRegion
  19. '*                GpiSetClipRegion
  20. '*                GpiExcludeClipRectangle
  21. '*                GpiOffsetClipRegion
  22. '*                GpiQueryClipRegion&
  23. '*                GpiQueryClipBox
  24. '*
  25. '* Description :  This program demonstrates the region functions
  26. '*                contained in "GpiRgn.BI".  It stores the results
  27. '*                of the functions in the data file "GpiRgn.OUT".
  28. '***********************************************************
  29.  
  30. '*********         Initialization section        ***********
  31.  
  32. REM $INCLUDE: 'PMBase.BI'
  33. REM $INCLUDE: 'GpiRgn.BI'
  34. REM $INCLUDE: 'OS2Def.BI'         Needed for POINTL type
  35. REM $INCLUDE: 'WinRect.BI'        Needed for rectangle functions
  36. REM $INCLUDE: 'GpiColor.BI'       Needed for set colors to distinguish regions
  37. DIM aqmsg AS QMSG
  38.  
  39. flFrameFlags& =  FCFTITLEBAR      OR FCFSYSMENU OR _
  40.                  FCFSIZEBORDER    OR FCFMINMAX  OR _
  41.                  FCFSHELLPOSITION OR FCFTASKLIST
  42.  
  43. szClientClass$ = "ClassName" + CHR$(0)
  44.  
  45. hab&  = WinInitialize    (0)
  46. hmq&  = WinCreateMsgQueue(hab&, 0)
  47.  
  48. bool% = WinRegisterClass(_
  49.         hab&,_
  50.         MakeLong(VARSEG(szClientClass$), SADD(szClientClass$)),_
  51.         RegBas,_
  52.         CSSIZEREDRAW,_
  53.         0)
  54.  
  55. hwndFrame& = WinCreateStdWindow (_
  56.              HWNDDESKTOP,_
  57.              WSVISIBLE,_
  58.              MakeLong(VARSEG(flFrameFlags&),  VARPTR(flFrameFlags&)),_
  59.              MakeLong(VARSEG(szClientClass$), SADD(szClientClass$)),_
  60.              0,_
  61.              0,_
  62.              0,_
  63.              0,_
  64.              MakeLong(VARSEG(hwndClient&), VARPTR(hwndClient&)))
  65.  
  66. '**************         Message loop         ***************
  67.  
  68. WHILE WinGetMsg(hab&, MakeLong(VARSEG(aqmsg), VARPTR(aqmsg)), 0, 0, 0)
  69.   bool% = WinDispatchMsg(hab&, MakeLong(VARSEG(aqmsg), VARPTR(aqmsg)))
  70. WEND
  71.  
  72. '***********         Finalize section        ***************
  73.  
  74. bool% = WinDestroyWindow  (hwndFrame&)
  75. bool% = WinDestroyMsgQueue(hmq&)
  76. bool% = WinTerminate      (hab&)
  77.  
  78. END
  79.  
  80. '***********         Window procedure        ***************
  81.  
  82. FUNCTION ClientWndProc& (hwnd&, msg%, mp1&, mp2&) STATIC
  83.      DIM ClientRect AS RECTL
  84.      ClientWndProc&=0
  85.      SELECT CASE msg%
  86.      CASE WMPAINT     'Paint the window and perform region functions
  87.         hps&  = WinBeginPaint(hwnd&, 0,_
  88.                 MakeLong(VARSEG(ClientRect), VARPTR(ClientRect)))
  89.         bool% = WinFillRect(hps&,_
  90.         MakeLong(VARSEG(ClientRect), VARPTR(ClientRect)),0)
  91.         CALL    GpiRegion (hps&)
  92.     bool% = WinEndPaint(hps&)
  93.      CASE ELSE        'Pass control to system for other messages
  94.         ClientWndProc& = WinDefWindowProc(hwnd&, msg%, mp1&, mp2&)
  95.      END SELECT
  96. END FUNCTION
  97.  
  98. 'Data for initialization of regions
  99. DATA 137,115,177,165
  100. DATA 337,115,377,165
  101. DATA 232,220,272,270
  102. DATA 232,20,272,70
  103. DATA 157,40,357,240
  104. DATA 20,270,60,290
  105. DATA 430,0,475,20
  106.  
  107. '***************************************************************
  108. '** GpiRegion demonstrates each of the Region calls.  The first
  109. '** section creates several regions and paints them.  The rest
  110. '** of the section writes out info from the other miscellaneous
  111. '** region functions to "GpiRgn.OUT".
  112. '***************************************************************
  113. SUB GpiRegion (hps&)
  114.     DIM RectsForRgn(3) AS RECTL
  115.         DIM RectsRgn1(2)   AS RECTL
  116.         DIM RectsBound     AS RECTL
  117.         DIM RectsInRgn     AS RECTL
  118.         DIM RgnOffset      AS POINTL
  119.         DIM RGNPoint       AS POINTL
  120.         DIM RGNRectangle   AS RGNRECT
  121.     RESTORE
  122.     FOR i% = 0 TO 3
  123.        READ RectsForRgn(i%).xLeft
  124.        READ RectsForRgn(i%).yBottom
  125.        READ RectsForRgn(i%).xRight
  126.        READ RectsForRgn(i%).yTop
  127.     NEXT i%
  128.     FOR I% = 0 TO 2
  129.            READ RectsRgn1(i%).xLeft
  130.            READ RectsRgn1(i%).yBottom
  131.            READ RectsRgn1(i%).xRight
  132.            READ RectsRgn1(i%).yTop
  133.         NEXT I%
  134.  
  135.         hrgnsc& = GpiCreateRegion (hps&, 4,_
  136.                   MakeLong(VARSEG(RectsForRgn(0)), VARPTR(RectsForRgn(0))))
  137.         bool%   = GpiSetColor     (hps&, CLRDARKGREEN)
  138.         bool%   = GpiPaintRegion  (hps&, hrgnsc&)
  139.         SLEEP 1
  140.  
  141.         bool%   = GpiSetRegion   (hps&, hrgnsc&, 2,_
  142.                   MakeLong(VARSEG(RectsForRgn(0)), VARPTR(RectsForRgn(0))))
  143.         bool%   = GpiSetColor    (hps&, CLRDARKBLUE)
  144.         bool%   = GpiPaintRegion (hps&, hrgnsc&)
  145.         SLEEP 1
  146.  
  147.         hrgnds& = GpiCreateRegion (hps&, 3,_
  148.                   MakeLong(VARSEG(RectsRgn1(0)), VARPTR(RectsRgn1(0))))
  149.         bool%   = GpiSetColor     (hps&, CLRCYAN)
  150.         bool%   = GpiPaintRegion  (hps&, hrgnds&)
  151.         SLEEP 1
  152.  
  153.         Comb&   = GpiCombineRegion (hps&, hrgnds&, hrgnsc&, hrgnds&, CRGNAND)
  154.         bool%   = GpiSetColor      (hps&, CLRRED)
  155.         bool%   = GpiPaintRegion   (hps&, hrgnds&)
  156.         SLEEP 1
  157.  
  158.         RgnOffset.x = 50
  159.         RgnOffset.y = 50
  160.         bool%   = GpiOffsetRegion (hps&, hrgnsc&,_
  161.                   MakeLong(VARSEG(RgnOffset),VARPTR(RgnOffset)))
  162.         bool%   = GpiSetColor     (hps&, CLRYELLOW)
  163.         bool%   = GpiPaintRegion  (hps&, hrgnsc&)
  164.  
  165.         OPEN "GpiRgn.OUT" FOR OUTPUT AS #1
  166.  
  167.          PRINT #1,"******  GpiPtInRegion ******"
  168.          RGNPoint.x = 137
  169.          RGNPoint.y = 125
  170.              Result& = GpiPtInRegion (hps&, hrgnsc&,_
  171.                        MakeLong(VARSEG(RGNPoint), VARPTR(RGNPoint)))
  172.          SELECT CASE Result&
  173.           CASE PRGNOUTSIDE
  174.                        PRINT #1,"(";RGNPoint.x;",";RGNPoint.y;") outside region"
  175.           CASE PRGNINSIDE
  176.                        PRINT #1,"(";RGNPoint.x;",";RGNPoint.y;") inside region"
  177.           CASE PRGNERROR
  178.                PRINT #1,"Error!"
  179.           CASE ELSE
  180.              END SELECT
  181.  
  182.          PRINT #1,"****** GpiRectInRegion ******"
  183.              RectsInRgn.xLeft = 337
  184.              RectsInRgn.yBottom = 125
  185.              RectsInRgn.xRight = 377
  186.              RectsInRgn.yTop = 175
  187.              Result& = GpiRectInRegion (hps&, hrgnsc&,_
  188.                        MakeLong(VARSEG(RectsInRgn),VARPTR(RectsInRgn)))
  189.          SELECT CASE Result&
  190.           CASE RRGNOUTSIDE
  191.                PRINT #1,"The region specified is outside the region."
  192.           CASE RRGNINSIDE
  193.                PRINT #1,"The region specified is inside the region."
  194.           CASE RRGNERROR
  195.                PRINT #1,"Error!"
  196.           CASE ELSE
  197.              END SELECT
  198.  
  199.          PRINT #1,"****** GpiQueryRegionBox ******"
  200.              Result& = GpiQueryRegionBox (hps&, hrgnds&,_
  201.                        MakeLong(VARSEG(RectsInRgn),VARPTR(RectsInRgn)))
  202.              PRINT #1,"(";RectsInRgn.xLeft;",";RectsInRgn.yBottom;") - ";
  203.              PRINT #1,"(";RectsInRgn.xRight;",";RectsInRgn.yTop;")"
  204.  
  205.          PRINT #1,"****** GpiQueryRegionRects ******"
  206.              RectsBound.xLeft = 0
  207.              RectsBound.yBottom = 380
  208.              RectsBound.xRight = 640
  209.              RectsBound.yTop = 0
  210.              Result& = GpiQueryRegionRects (hps&,_
  211.                           hrgnds&,_
  212.               MakeLong(VARSEG(RectsBound),VARPTR(RectsBound)),_
  213.                           MakeLong(VARSEG(RGNRectangle),VARPTR(RGNRectangle)),_
  214.               MakeLong(VARSEG(RectsRgn1(0)),VARPTR(RectsRgn1(0))))
  215.              PRINT #1, "Result: ";Result&
  216.  
  217.              PRINT #1, "****** GpiSetClipRegion ******"
  218.              ClipRGN& = GpiSetClipRegion (hps&, hrgnsc&,_
  219.                         MakeLong(VARSEG(hrgnds&), VARPTR(hrgnds&)))
  220.              PRINT #1, "Result: ";ClipRGN&
  221.  
  222.          PRINT #1,"****** GpiQueryClipRegion ******"
  223.          Result& = GpiQueryClipRegion (hps&)
  224.              PRINT #1, "Result: ";Result&
  225.  
  226.          PRINT #1,"****** GpiQueryClipBox ******"
  227.              Result& = GpiQueryClipBox (hps&,_
  228.                        MakeLong(VARSEG(RectsInRgn), VARPTR(RectsInRgn)))
  229.              CALL OutcomeOfFunction (Result&)
  230.  
  231.          PRINT #1,"****** GpiIntersectClipRectangle ******"
  232.              Result& = GpiIntersectClipRectangle(hps&,_
  233.                        MakeLong(VARSEG(RectsInRgn), VARPTR(RectsInRgn)))
  234.              CALL OutcomeOfFunction (Result&)
  235.  
  236.          PRINT #1,"****** GpiExcludeClipRectangle ******"
  237.              Result& = GpiExcludeClipRectangle(hps&,_
  238.                        MakeLong(VARSEG(RectsInRgn), VARPTR(RectsInRgn)))
  239.              CALL OutcomeOfFunction (Result&)
  240.  
  241.          PRINT #1,"****** GpiOffsetClipRegion ******"
  242.          Result& = GpiOffsetClipRegion(hps&,_
  243.                        MakeLong(VARSEG(RGNPoint), VARPTR(RGNPoint)))
  244.              CALL OutcomeOfFunction (Result&)
  245.  
  246.          PRINT #1,"****** GpiQueryClipBox ******"
  247.              Result& = GpiQueryClipBox (hps&,_
  248.                        MakeLong(VARSEG(RectsInRgn), VARPTR(RectsInRgn)))
  249.              CALL OutcomeOfFunction (Result&)
  250.  
  251.     CLOSE #1
  252.     bool%    = GpiDestroyRegion(hps&, hrgrnsc&)
  253.     bool%    = GpiDestroyRegion(hps&, hrgrnds&)
  254. END SUB
  255.  
  256. '***** Sub procedure to check general results of RGN function calls *****
  257.  
  258. SUB OutcomeOfFunction (ResultOfFunction&)
  259.      SELECT CASE ResultOfFunction&
  260.      CASE RGNNULL
  261.              PRINT #1,"RGNNULL    -- Function Successful"
  262.      CASE RGNRECT
  263.              PRINT #1,"RGNRECT    -- Function Successful"
  264.      CASE RGNCOMPLEX
  265.              PRINT #1,"RGNCOMPLEX -- Function Successful"
  266.      CASE ELSE
  267.              PRINT #1,"RGNERROR   -- Function UnSuccessful"
  268.      END SELECT
  269. END SUB
  270.