home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / OS2BAS.ZIP / WINRECT.BAS < prev    next >
BASIC Source File  |  1989-08-27  |  8KB  |  223 lines
  1. '***********************************************************
  2. '* 
  3. '* Program Name: WinRect.BAS
  4. '*
  5. '* Include File: WinRect.BI
  6. '*
  7. '* Functions   :
  8. '*               WinIsRectEmpty
  9. '*               WinSetRect
  10. '*               WinCopyRect
  11. '*               WinEqualRect
  12. '*               WinOffsetRect
  13. '*               WinIntersectRect
  14. '*               WinUnionRect
  15. '*               WinSubtractRect
  16. '*               WinInflateRect
  17. '*               WinSetRectEmpty
  18. '*               WinMakeRect        Not demonstrated
  19. '*               WinMakePoints      Not demonstrated
  20. '*
  21. '* Description : This program demonstrates the rectangle
  22. '*               utility routines built into the Presentation
  23. '*               Manager.  Due to the nature of these calls
  24. '*               (they have no visible effect), each function
  25. '*               is called (in a logical order) and the resulting
  26. '*               information is written to the file "WinRect.OUT".
  27. '*               Since all these routines use the RECTL type,
  28. '*               two routines (1 SUB, 1 FUNCTION) are written
  29. '*               to shorten repetitive code for printing and
  30. '*               getting addresses. WinMakeRect and WinMakePoints
  31. '*               are not demonstarted because they convert from
  32. '*               the WRECT and WPOINT types which are not used
  33. '*               for any existing PM calls.  For this same
  34. '*               reason, these functions have been left out of
  35. '*               "OS/2 Programmer's Reference" Version 1.1.
  36. '***********************************************************
  37.  
  38. '*********         Initialization section        ***********
  39.  
  40. REM $INCLUDE: 'PMBase.BI'
  41. REM $INCLUDE: 'OS2Def.BI'     Needed for POINTL
  42. REM $INCLUDE: 'WinRect.BI'
  43.  
  44. DECLARE FUNCTION Addr&(Rect AS RECTL)      'MakeLong(VARSEG(),VARPTR())
  45. DECLARE SUB PrintRect(Rect AS RECTL)      '(L,B)-(R,T)
  46.  
  47. DIM aqmsg AS QMSG
  48.  
  49. flFrameFlags& =  FCFTITLEBAR      OR FCFSYSMENU OR _
  50.                  FCFSIZEBORDER    OR FCFMINMAX  OR _
  51.                  FCFSHELLPOSITION OR FCFTASKLIST
  52.  
  53. szClientClass$ = "ClassName" + CHR$(0)
  54.  
  55. hab&  = WinInitialize    (0)
  56. hmq&  = WinCreateMsgQueue(hab&, 0)
  57.  
  58. bool% = WinRegisterClass(_
  59.         hab&,_
  60.         MakeLong(VARSEG(szClientClass$), SADD(szClientClass$)),_
  61.         RegBas,_
  62.         0,_
  63.         0)
  64.  
  65. hwndFrame& = WinCreateStdWindow (_
  66.              HWNDDESKTOP,_
  67.              WSVISIBLE,_
  68.              MakeLong (VARSEG(flFrameFlags&),  VARPTR(flFrameFlags&)),_
  69.              MakeLong (VARSEG(szClientClass$), SADD(szClientClass$)),_
  70.              0,_
  71.              0,_
  72.              0,_
  73.              0,_
  74.              MakeLong (VARSEG(hwndClient&), VARPTR(hwndClient&)))
  75.  
  76. '**************      Rectangle utilities       ***************
  77.  
  78. '*****
  79. '*** Order of calls is as follows:
  80. '***      1.  WinIsRectEmpty
  81. '***      2.  WinRectEmpty
  82. '***      3.  WinIsRectEmpty
  83. '***      4.  WinPtInRect
  84. '***      5.  WinCopyRect
  85. '***      6.  WinEqualRect
  86. '***      7.  WinOffsetRect
  87. '***      8.  WinEqualRect
  88. '***      9.  WinIntersectRect
  89. '***      10. WinUnionRect
  90. '***      11. WinSubtractRect
  91. '***      12. WinInflateRect
  92. '***      13. WinSetRectEmpty
  93. '***      14. WinIsRectEmpty
  94.  
  95. OPEN "WinRect.OUT" FOR OUTPUT AS #1
  96.  
  97.   DIM Rect1 AS RECTL, Rect2 AS RECTL, Rect3 AS RECTL
  98.   DIM Pt AS POINTL
  99.  
  100. '***      1.  WinIsRectEmpty
  101.   empty%    = WinIsRectEmpty (hab&, Addr(Rect1))
  102.   PRINT #1,  "WinIsRectEmpty:", empty%           'Yes (1)
  103.   CALL PrintRect(Rect1)                          '( 0, 0)-( 0, 0)
  104.  
  105. '***      2.  WinRectEmpty
  106.   set%      = WinSetRect (hab&, Addr(Rect1), 10, 20, 30, 40)
  107.   PRINT #1,  "WinSetRect:", set%
  108.   CALL PrintRect(Rect1)             '(10,20)-(30,40)
  109.  
  110. '***      3.  WinIsRectEmpty
  111.   empty%    = WinIsRectEmpty (hab&, Addr(Rect1))
  112.   PRINT #1,  "WinIsRectEmpty:", empty%          'No (0)
  113.   CALL PrintRect(Rect1)             '(10,20)-(30,40)
  114.  
  115. '***      4.  WinPtInRect
  116.   Pt.x = 20
  117.   Pt.y = 30
  118.   ptIn%     = WinPtInRect (hab&, Addr(Rect1), MakeLong(VARSEG(Pt), VARPTR(Pt)))
  119.   PRINT #1,  "WinPtInRect:", ptIn%              'Yes (1)
  120.   PRINT #1,  "(";Pt.x;",";Pt.y;")"              '(20,30)
  121.   CALL PrintRect(Rect1)             '(10,20)-(30,40)
  122.  
  123. '***      5.  WinCopyRect
  124.   copy%     = WinCopyRect (hab&, Addr(Rect2), Addr(Rect1))
  125.   PRINT #1,  "WinCopyRect:", copy%
  126.   CALL PrintRect(Rect1)             '(10,20)-(30,40)
  127.   CALL PrintRect(Rect2)             '(10,20)-(30,40)
  128.  
  129. '***      6.  WinEqualRect
  130.   equal%    = WinEqualRect (hab&, Addr(Rect1), Addr(Rect2))
  131.   PRINT #1,  "WinEqualRect:", equal%            'Yes (1)
  132.   CALL PrintRect(Rect1)             '(10,20)-(30,40)
  133.   CALL PrintRect(Rect2)             '(10,20)-(30,40)
  134.  
  135. '***      7.  WinOffsetRect
  136.   offsRect% = WinOffsetRect (hab&, Addr(Rect2), 5, 10)
  137.   PRINT #1,  "WinOffsetRect:", offsRect%
  138.   CALL PrintRect(Rect2)             '(15,30)-(35,50)
  139.  
  140. '***      8.  WinEqualRect
  141.   equal%    = WinEqualRect (hab&, Addr(Rect1), Addr(Rect2))
  142.   PRINT #1,  "WinEqualRect:", equal%            'No (0)
  143.   CALL PrintRect(Rect1)             '(10,20)-(30,40)
  144.   CALL PrintRect(Rect2)             '(15,30)-(35,50)
  145.  
  146. '***      9.  WinIntersectRect
  147.   inters%   = WinIntersectRect (hab&, Addr(Rect3), Addr(Rect1), Addr(Rect2))
  148.   PRINT #1,  "WinIntersectRect:", inters%
  149.   CALL PrintRect(Rect1)             '(10,20)-(30,40)
  150.   CALL PrintRect(Rect2)             '(15,30)-(35,50)
  151.   CALL PrintRect(Rect3)             '(15,30)-(30,40)
  152.  
  153. '***      10. WinUnionRect
  154.   union%    = WinUnionRect (hab&, Addr(Rect3), Addr(Rect1), Addr(Rect2))
  155.   PRINT #1, "WinUnionRect:", union%
  156.   CALL PrintRect(Rect1)             '(10,20)-(30,40)
  157.   CALL PrintRect(Rect2)             '(15,30)-(35,50)
  158.   CALL PrintRect(Rect3)             '(10,20)-(35,50)
  159.  
  160. '***      11. WinSubtractRect
  161.   subtract% = WinSubtractRect (hab&, Addr(Rect3), Addr(Rect1), Addr(Rect2))
  162.   PRINT #1,  "WinSubtractRect:", subtract%
  163.   CALL PrintRect(Rect1)             '(10,20)-(30,40)
  164.   CALL PrintRect(Rect2)             '(15,30)-(35,50)
  165.   CALL PrintRect(Rect3)             '(10,20)-(30,40)
  166.  
  167. '***      12. WinInflateRect
  168.   inflate%  = WinInflateRect (hab&, Addr(Rect1), 10, -5)
  169.   PRINT #1,  "WinInflateRect:", inflate%
  170.   CALL PrintRect(Rect1)             '( 0,25)-(40,35)
  171.  
  172. '***      13. WinSetRectEmpty
  173.   setEmpty% = WinSetRectEmpty (hab&, Addr(Rect1))
  174.   PRINT #1,  "WinSetRectEmpty:", setEmpty%
  175.   CALL PrintRect(Rect1)             '( 0, 0)-( 0, 0)
  176.  
  177. '***      14. WinIsRectEmpty
  178.   empty%    = WinIsRectEmpty (hab&, Addr(Rect1))
  179.   PRINT #1,  "WinIsRectEmpty:", empty%          'Yes (1)
  180.   CALL PrintRect(Rect1)             '( 0, 0)-( 0, 0)
  181.  
  182. CLOSE #1
  183.  
  184. '**************         Message loop         ***************
  185.  
  186. WHILE WinGetMsg(hab&, MakeLong(VARSEG(aqmsg), VARPTR(aqmsg)), 0, 0, 0)
  187.   bool% = WinDispatchMsg(hab&, MakeLong(VARSEG(aqmsg), VARPTR(aqmsg)))
  188. WEND
  189.  
  190. '***********         Finalize section        ***************
  191.  
  192. bool% = WinDestroyWindow   (hwndFrame&)
  193. bool% = WinDestroyMsgQueue (hmq&)
  194. bool% = WinTerminate       (hab&)
  195.  
  196. END
  197.  
  198. '***********         Window procedure        ***************
  199.  
  200. FUNCTION ClientWndProc& (hwnd&, msg%, mp1&, mp2&) STATIC
  201.      DIM ClientRect AS RECTL
  202.      ClientWndProc&=0
  203.      SELECT CASE msg%
  204.      CASE WMPAINT     'Paint the window with background color
  205.         hps&  = WinBeginPaint(hwnd&, 0,_
  206.                 MakeLong(VARSEG(ClientRect), VARPTR(ClientRect)))
  207.         bool% = WinFillRect(hps&,_
  208.                 MakeLong(VARSEG(ClientRect), VARPTR(ClientRect)),0)
  209.         bool% = WinEndPaint(hps&)
  210.      CASE ELSE        'Pass control to system for other messages
  211.         ClientWndProc& = WinDefWindowProc(hwnd&, msg%, mp1&, mp2&)
  212.      END SELECT
  213. END FUNCTION
  214.  
  215. FUNCTION Addr&(Rect AS RECTL)
  216.   Addr& = MakeLong(VARSEG(Rect), VARPTR(Rect))
  217. END FUNCTION
  218.  
  219. SUB PrintRect(Rect AS RECTL)
  220.   PRINT #1,"(";Rect.xLeft;",";Rect.yBottom;") - (";Rect.xRight;",";Rect.yTop;")"
  221.   PRINT #1,"-----------------------------"
  222. END SUB
  223.