home *** CD-ROM | disk | FTP | other *** search
/ Dan Appleman's Visual Bas…s Guide to the Win32 API / Dan.Applmans.Visual.Basic.5.0.Programmers.Guide.To.The.Win32.API.1997.Ziff-Davis.Press.CD / VB5PG32.mdf / classlib / desaware / dwrect.cls < prev    next >
Encoding:
Text File  |  1996-04-05  |  9.7 KB  |  223 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "dwRECT"
  6. Attribute VB_Creatable = True
  7. Attribute VB_Exposed = True
  8. Option Explicit
  9.  
  10. ' Class dwRECT
  11. ' Desaware API Class library
  12. ' Copyright (c) 1996 by Desaware Inc.
  13. ' All rights reserved
  14.  
  15. Private InternalRect As RECT
  16.  
  17. #If Win32 Then
  18. Private Declare Function apiAdjustWindowRect& Lib "user32" Alias "AdjustWindowRect" (lpRect As RECT, ByVal dwStyle As Long, ByVal bMenu As Long)
  19. Private Declare Function apiSetRect& Lib "user32" Alias "SetRect" (lpRect As RECT, ByVal x1 As Long, ByVal y1 As Long, ByVal x2 As Long, ByVal y2 As Long)
  20. Private Declare Function apiCopyRect& Lib "user32" Alias "CopyRect" (lpDestRect As RECT, lpSourceRect As RECT)
  21. Private Declare Function apiInflateRect& Lib "user32" Alias "InflateRect" (lpRect As RECT, ByVal x As Long, ByVal y As Long)
  22. Private Declare Function apiIntersectRect& Lib "user32" Alias "IntersectRect" (lpDestRect As RECT, lpSrc1Rect As RECT, lpSrc2Rect As RECT)
  23. Private Declare Function apiUnionRect& Lib "user32" Alias "UnionRect" (lpDestRect As RECT, lpSrc1Rect As RECT, lpSrc2Rect As RECT)
  24. Private Declare Function apiSubtractRect& Lib "user32" Alias "SubtractRect" (lprcDst As RECT, lprcSrc1 As RECT, lprcSrc2 As RECT)
  25. Private Declare Function apiOffsetRect& Lib "user32" Alias "OffsetRect" (lpRect As RECT, ByVal x As Long, ByVal y As Long)
  26. Private Declare Function apiEqualRect& Lib "user32" Alias "EqualRect" (lpRect1 As RECT, lpRect2 As RECT)
  27. Private Declare Function apiPtInRect& Lib "user32" Alias "PtInRect" (lpRect As RECT, ByVal ptx As Long, ByVal pty As Long)
  28. Private Declare Function apiAdjustWindowRectEx& Lib "user32" Alias "AdjustWindowRectEx" (lpRect As RECT, ByVal dsStyle As Long, ByVal bMenu As Long, ByVal dwEsStyle As Long)
  29. Private Declare Function apiSetRectEmpty& Lib "user32" Alias "SetRectEmpty" (lpRect As RECT)
  30. Private Declare Function apiIsRectEmpty& Lib "user32" Alias "IsRectEmpty" (lpRect As RECT)
  31. #Else   ' WIN16
  32. Private Declare Function apiAdjustWindowRect% Lib "user" Alias "AdjustWindowRect" (lpRect As RECT, ByVal dwStyle As Long, ByVal bMenu As Integer)
  33. Private Declare Function apiSetRect% Lib "user" Alias "SetRect" (lpRect As RECT, ByVal x1 As Integer, ByVal y1 As Integer, ByVal x2 As Integer, ByVal y2 As Integer)
  34. Private Declare Function apiCopyRect% Lib "user" Alias "CopyRect" (lpDestRect As RECT, lpSourceRect As RECT)
  35. Private Declare Function apiInflateRect% Lib "user" Alias "InflateRect" (lpRect As RECT, ByVal x As Integer, ByVal y As Integer)
  36. Private Declare Function apiIntersectRect% Lib "user" Alias "IntersectRect" (lpDestRect As RECT, lpSrc1Rect As RECT, lpSrc2Rect As RECT)
  37. Private Declare Function apiUnionRect% Lib "user" Alias "UnionRect" (lpDestRect As RECT, lpSrc1Rect As RECT, lpSrc2Rect As RECT)
  38. Private Declare Function apiSubtractRect% Lib "user" Alias "SubtractRect" (lprcDest As RECT, lprcSource1 As RECT, lprcSource2 As RECT)
  39. Private Declare Function apiOffsetRect% Lib "user" Alias "OffsetRect" (lpRect As RECT, ByVal x As Integer, ByVal y As Integer)
  40. Private Declare Function apiEqualRect% Lib "user" Alias "EqualRect" (lpRect1 As RECT, lpRect2 As RECT)
  41. Private Declare Function apiPtInRect% Lib "user" Alias "PtInRect" (lpRect As RECT, ByVal pnt As Long)
  42. Private Declare Function apiAdjustWindowRectEx% Lib "user" Alias "AdjustWindowRectEx" (lpRect As RECT, ByVal dsStyle As Long, ByVal bMenu As Integer, ByVal dwEsStyle As Long)
  43. Private Declare Function apiSetRectEmpty% Lib "user" Alias "SetRectEmpty" (lpRect As RECT)
  44. Private Declare Function apiIsRectEmpty% Lib "user" Alias "IsRectEmpty" (lpRect As RECT)
  45. #End If 'WIN16
  46.  
  47. Private Sub Class_Initialize()
  48.     ' Initialization is not actually necessary because
  49.     ' class variables are all set to zero. Here's how it could be done:
  50.     ' Call apiSetRectEmpty(InternalRect)
  51. End Sub
  52.  
  53. Public Property Get left() As Long
  54.     left = InternalRect.left
  55. End Property
  56.  
  57. Public Property Let left(vNewValue As Long)
  58.     InternalRect.left = vNewValue
  59. End Property
  60.  
  61. Public Property Get right() As Long
  62.     right = InternalRect.right
  63. End Property
  64.  
  65. Public Property Let right(vNewValue As Long)
  66.     InternalRect.right = vNewValue
  67. End Property
  68.  
  69. Public Property Get top() As Long
  70.     top = InternalRect.top
  71. End Property
  72.  
  73. Public Property Let top(vNewValue As Long)
  74.     InternalRect.top = vNewValue
  75. End Property
  76.  
  77. Public Property Get bottom() As Long
  78.     bottom = InternalRect.bottom
  79. End Property
  80.  
  81. Public Property Let bottom(vNewValue As Long)
  82.     InternalRect.bottom = vNewValue
  83. End Property
  84.  
  85. Public Sub AdjustWindowRect(ByVal dwStyle&, ByVal bMenu As Boolean)
  86. Attribute AdjustWindowRect.VB_HelpID = 2956
  87. Attribute AdjustWindowRect.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  88.     Dim dl&
  89.     dl& = apiAdjustWindowRect(InternalRect, dwStyle, bMenu)
  90.     If dl = 0 Then RaiseRectError
  91. End Sub
  92.  
  93. Public Sub AdjustWindowRectEx(ByVal dwStyle&, ByVal bMenu As Boolean, ByVal dwEsStyle&)
  94. Attribute AdjustWindowRectEx.VB_HelpID = 2957
  95. Attribute AdjustWindowRectEx.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  96.     Dim dl&
  97.     dl& = apiAdjustWindowRectEx(InternalRect, dwStyle, bMenu, dwEsStyle)
  98.     If dl = 0 Then RaiseRectError
  99. End Sub
  100.  
  101. Public Function PtInRect(pnt As dwPoint) As Boolean
  102. Attribute PtInRect.VB_HelpID = 2998
  103. Attribute PtInRect.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  104.     Dim dl&
  105.     
  106.     #If Win32 Then
  107.         PtInRect = apiPtInRect(InternalRect, pnt.x, pnt.y)
  108.     #Else
  109.         Dim lPnt As Long
  110.  
  111.         lPnt = (pnt.x * 65536) + pnt.y ' convert point coordinates into a long integer
  112.         PtInRect = apiPtInRect(InternalRect, lPnt)
  113.     #End If
  114. End Function
  115.  
  116. Private Sub RaiseRectError(Optional errval)
  117.     Dim useerr%
  118.     If IsMissing(errval) Then
  119.         RaiseRectError DWERR_APIRESULT
  120.     Else
  121.         Err.Raise errval, "dwRECT"
  122.     End If
  123. End Sub
  124.  
  125. Public Sub SetRect(ByVal x1 As Long, ByVal y1 As Long, ByVal x2 As Long, ByVal y2 As Long)
  126. Attribute SetRect.VB_HelpID = 2988
  127. Attribute SetRect.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  128.     InternalRect.left = x1
  129.     InternalRect.top = y1
  130.     InternalRect.right = x2
  131.     InternalRect.bottom = y2
  132. End Sub
  133.  
  134. Public Sub CopyRect(rc As dwRECT)
  135. Attribute CopyRect.VB_HelpID = 2990
  136.     agCopyData ByVal rc.GetAddress, ByVal GetAddress(), LenB(InternalRect)
  137. End Sub
  138.  
  139. Public Function EqualRect(rcSrc1 As dwRECT, rcSrc2 As dwRECT) As Boolean
  140. Attribute EqualRect.VB_HelpID = 2997
  141. Attribute EqualRect.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  142.     Dim rc1 As RECT
  143.     Dim rc2 As RECT
  144.     rcSrc1.CopyToRECT agGetAddressForObject(rc1.left)
  145.     rcSrc2.CopyToRECT agGetAddressForObject(rc2.left)
  146.     EqualRect = apiEqualRect(rc1, rc2)
  147. End Function
  148.  
  149. Public Sub InflateRect(ByVal x As Long, ByVal y As Long)
  150. Attribute InflateRect.VB_HelpID = 2991
  151. Attribute InflateRect.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  152.     Dim dl&
  153.     #If Win32 Then
  154.         dl& = apiInflateRect(InternalRect, x, y)
  155.         If dl = 0 Then RaiseRectError
  156.     #Else
  157.         Call apiInflateRect(InternalRect, x, y)
  158.     #End If
  159. End Sub
  160.  
  161. Public Sub OffsetRect(ByVal x As Long, ByVal y As Long)
  162. Attribute OffsetRect.VB_HelpID = 2995
  163. Attribute OffsetRect.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  164.     Dim dl&
  165.     #If Win32 Then
  166.         dl& = apiOffsetRect(InternalRect, x, y)
  167.         If dl = 0 Then RaiseRectError
  168.     #Else
  169.         apiOffsetRect InternalRect, x, y
  170.     #End If
  171. End Sub
  172.  
  173. Public Function IntersectRect(rcSrc1 As dwRECT, rcSrc2 As dwRECT) As Boolean
  174. Attribute IntersectRect.VB_HelpID = 2992
  175. Attribute IntersectRect.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  176.     Dim rc1 As RECT
  177.     Dim rc2 As RECT
  178.     rcSrc1.CopyToRECT agGetAddressForObject(rc1.left)
  179.     rcSrc2.CopyToRECT agGetAddressForObject(rc2.left)
  180.     IntersectRect = apiIntersectRect(InternalRect, rc1, rc2)
  181. End Function
  182.  
  183. Public Function SubtractRect(rcSrc1 As dwRECT, rcSrc2 As dwRECT) As Boolean
  184. Attribute SubtractRect.VB_HelpID = 2994
  185. Attribute SubtractRect.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  186.     Dim rc1 As RECT
  187.     Dim rc2 As RECT
  188.     rcSrc1.CopyToRECT agGetAddressForObject(rc1.left)
  189.     rcSrc2.CopyToRECT agGetAddressForObject(rc2.left)
  190.     SubtractRect = apiSubtractRect(InternalRect, rc1, rc2)
  191. End Function
  192.  
  193. Public Function UnionRect(rcSrc1 As dwRECT, rcSrc2 As dwRECT) As Boolean
  194. Attribute UnionRect.VB_HelpID = 2993
  195. Attribute UnionRect.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  196.     Dim rc1 As RECT
  197.     Dim rc2 As RECT
  198.     rcSrc1.CopyToRECT agGetAddressForObject(rc1.left)
  199.     rcSrc2.CopyToRECT agGetAddressForObject(rc2.left)
  200.     UnionRect = apiUnionRect(InternalRect, rc1, rc2)
  201. End Function
  202.  
  203. Public Sub CopyToRECT(ByVal lprc As Long)
  204.     If lprc = 0 Then RaiseRectError 5
  205.     agCopyData InternalRect, ByVal lprc, Len(InternalRect)
  206. End Sub
  207.  
  208. Public Function GetAddress() As Long
  209.     GetAddress = agGetAddressForObject(InternalRect.left)
  210. End Function
  211.  
  212. Public Sub SetRectEmpty()
  213. Attribute SetRectEmpty.VB_HelpID = 2989
  214. Attribute SetRectEmpty.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  215.     apiSetRectEmpty InternalRect
  216. End Sub
  217.  
  218. Public Function IsRectEmpty() As Boolean
  219. Attribute IsRectEmpty.VB_HelpID = 2996
  220. Attribute IsRectEmpty.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  221.     IsRectEmpty = apiIsRectEmpty(InternalRect)
  222. End Function
  223.