VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "dwRECT"
Attribute VB_Creatable = True
Attribute VB_Exposed = True
Option Explicit

' Class dwRECT
' Desaware API Class library
' Copyright (c) 1996 by Desaware Inc.
' All rights reserved

Private InternalRect As RECT

#If Win32 Then
Private Declare Function apiAdjustWindowRect& Lib "user32" Alias "AdjustWindowRect" (lpRect As RECT, ByVal dwStyle As Long, ByVal bMenu As Long)
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)
Private Declare Function apiCopyRect& Lib "user32" Alias "CopyRect" (lpDestRect As RECT, lpSourceRect As RECT)
Private Declare Function apiInflateRect& Lib "user32" Alias "InflateRect" (lpRect As RECT, ByVal x As Long, ByVal y As Long)
Private Declare Function apiIntersectRect& Lib "user32" Alias "IntersectRect" (lpDestRect As RECT, lpSrc1Rect As RECT, lpSrc2Rect As RECT)
Private Declare Function apiUnionRect& Lib "user32" Alias "UnionRect" (lpDestRect As RECT, lpSrc1Rect As RECT, lpSrc2Rect As RECT)
Private Declare Function apiSubtractRect& Lib "user32" Alias "SubtractRect" (lprcDst As RECT, lprcSrc1 As RECT, lprcSrc2 As RECT)
Private Declare Function apiOffsetRect& Lib "user32" Alias "OffsetRect" (lpRect As RECT, ByVal x As Long, ByVal y As Long)
Private Declare Function apiEqualRect& Lib "user32" Alias "EqualRect" (lpRect1 As RECT, lpRect2 As RECT)
Private Declare Function apiPtInRect& Lib "user32" Alias "PtInRect" (lpRect As RECT, ByVal ptx As Long, ByVal pty As Long)
Private Declare Function apiAdjustWindowRectEx& Lib "user32" Alias "AdjustWindowRectEx" (lpRect As RECT, ByVal dsStyle As Long, ByVal bMenu As Long, ByVal dwEsStyle As Long)
Private Declare Function apiSetRectEmpty& Lib "user32" Alias "SetRectEmpty" (lpRect As RECT)
Private Declare Function apiIsRectEmpty& Lib "user32" Alias "IsRectEmpty" (lpRect As RECT)
#Else   ' WIN16
Private Declare Function apiAdjustWindowRect% Lib "user" Alias "AdjustWindowRect" (lpRect As RECT, ByVal dwStyle As Long, ByVal bMenu As Integer)
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)
Private Declare Function apiCopyRect% Lib "user" Alias "CopyRect" (lpDestRect As RECT, lpSourceRect As RECT)
Private Declare Function apiInflateRect% Lib "user" Alias "InflateRect" (lpRect As RECT, ByVal x As Integer, ByVal y As Integer)
Private Declare Function apiIntersectRect% Lib "user" Alias "IntersectRect" (lpDestRect As RECT, lpSrc1Rect As RECT, lpSrc2Rect As RECT)
Private Declare Function apiUnionRect% Lib "user" Alias "UnionRect" (lpDestRect As RECT, lpSrc1Rect As RECT, lpSrc2Rect As RECT)
Private Declare Function apiSubtractRect% Lib "user" Alias "SubtractRect" (lprcDest As RECT, lprcSource1 As RECT, lprcSource2 As RECT)
Private Declare Function apiOffsetRect% Lib "user" Alias "OffsetRect" (lpRect As RECT, ByVal x As Integer, ByVal y As Integer)
Private Declare Function apiEqualRect% Lib "user" Alias "EqualRect" (lpRect1 As RECT, lpRect2 As RECT)
Private Declare Function apiPtInRect% Lib "user" Alias "PtInRect" (lpRect As RECT, ByVal pnt As Long)
Private Declare Function apiAdjustWindowRectEx% Lib "user" Alias "AdjustWindowRectEx" (lpRect As RECT, ByVal dsStyle As Long, ByVal bMenu As Integer, ByVal dwEsStyle As Long)
Private Declare Function apiSetRectEmpty% Lib "user" Alias "SetRectEmpty" (lpRect As RECT)
Private Declare Function apiIsRectEmpty% Lib "user" Alias "IsRectEmpty" (lpRect As RECT)
#End If 'WIN16

Private Sub Class_Initialize()
    ' Initialization is not actually necessary because
    ' class variables are all set to zero. Here's how it could be done:
    ' Call apiSetRectEmpty(InternalRect)
End Sub

Public Property Get left() As Long
    left = InternalRect.left
End Property

Public Property Let left(vNewValue As Long)
    InternalRect.left = vNewValue
End Property

Public Property Get right() As Long
    right = InternalRect.right
End Property

Public Property Let right(vNewValue As Long)
    InternalRect.right = vNewValue
End Property

Public Property Get top() As Long
    top = InternalRect.top
End Property

Public Property Let top(vNewValue As Long)
    InternalRect.top = vNewValue
End Property

Public Property Get bottom() As Long
    bottom = InternalRect.bottom
End Property

Public Property Let bottom(vNewValue As Long)
    InternalRect.bottom = vNewValue
End Property

Public Sub AdjustWindowRect(ByVal dwStyle&, ByVal bMenu As Boolean)
Attribute AdjustWindowRect.VB_HelpID = 2956
Attribute AdjustWindowRect.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
    Dim dl&
    dl& = apiAdjustWindowRect(InternalRect, dwStyle, bMenu)
    If dl = 0 Then RaiseRectError
End Sub

Public Sub AdjustWindowRectEx(ByVal dwStyle&, ByVal bMenu As Boolean, ByVal dwEsStyle&)
Attribute AdjustWindowRectEx.VB_HelpID = 2957
Attribute AdjustWindowRectEx.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
    Dim dl&
    dl& = apiAdjustWindowRectEx(InternalRect, dwStyle, bMenu, dwEsStyle)
    If dl = 0 Then RaiseRectError
End Sub

Public Function PtInRect(pnt As dwPoint) As Boolean
Attribute PtInRect.VB_HelpID = 2998
Attribute PtInRect.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
    Dim dl&
    
    #If Win32 Then
        PtInRect = apiPtInRect(InternalRect, pnt.x, pnt.y)
    #Else
        Dim lPnt As Long

        lPnt = (pnt.x * 65536) + pnt.y ' convert point coordinates into a long integer
        PtInRect = apiPtInRect(InternalRect, lPnt)
    #End If
End Function

Private Sub RaiseRectError(Optional errval)
    Dim useerr%
    If IsMissing(errval) Then
        RaiseRectError DWERR_APIRESULT
    Else
        Err.Raise errval, "dwRECT"
    End If
End Sub

Public Sub SetRect(ByVal x1 As Long, ByVal y1 As Long, ByVal x2 As Long, ByVal y2 As Long)
Attribute SetRect.VB_HelpID = 2988
Attribute SetRect.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
    InternalRect.left = x1
    InternalRect.top = y1
    InternalRect.right = x2
    InternalRect.bottom = y2
End Sub

Public Sub CopyRect(rc As dwRECT)
Attribute CopyRect.VB_HelpID = 2990
    agCopyData ByVal rc.GetAddress, ByVal GetAddress(), LenB(InternalRect)
End Sub

Public Function EqualRect(rcSrc1 As dwRECT, rcSrc2 As dwRECT) As Boolean
Attribute EqualRect.VB_HelpID = 2997
Attribute EqualRect.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
    Dim rc1 As RECT
    Dim rc2 As RECT
    rcSrc1.CopyToRECT agGetAddressForObject(rc1.left)
    rcSrc2.CopyToRECT agGetAddressForObject(rc2.left)
    EqualRect = apiEqualRect(rc1, rc2)
End Function

Public Sub InflateRect(ByVal x As Long, ByVal y As Long)
Attribute InflateRect.VB_HelpID = 2991
Attribute InflateRect.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
    Dim dl&
    #If Win32 Then
        dl& = apiInflateRect(InternalRect, x, y)
        If dl = 0 Then RaiseRectError
    #Else
        Call apiInflateRect(InternalRect, x, y)
    #End If
End Sub

Public Sub OffsetRect(ByVal x As Long, ByVal y As Long)
Attribute OffsetRect.VB_HelpID = 2995
Attribute OffsetRect.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
    Dim dl&
    #If Win32 Then
        dl& = apiOffsetRect(InternalRect, x, y)
        If dl = 0 Then RaiseRectError
    #Else
        apiOffsetRect InternalRect, x, y
    #End If
End Sub

Public Function IntersectRect(rcSrc1 As dwRECT, rcSrc2 As dwRECT) As Boolean
Attribute IntersectRect.VB_HelpID = 2992
Attribute IntersectRect.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
    Dim rc1 As RECT
    Dim rc2 As RECT
    rcSrc1.CopyToRECT agGetAddressForObject(rc1.left)
    rcSrc2.CopyToRECT agGetAddressForObject(rc2.left)
    IntersectRect = apiIntersectRect(InternalRect, rc1, rc2)
End Function

Public Function SubtractRect(rcSrc1 As dwRECT, rcSrc2 As dwRECT) As Boolean
Attribute SubtractRect.VB_HelpID = 2994
Attribute SubtractRect.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
    Dim rc1 As RECT
    Dim rc2 As RECT
    rcSrc1.CopyToRECT agGetAddressForObject(rc1.left)
    rcSrc2.CopyToRECT agGetAddressForObject(rc2.left)
    SubtractRect = apiSubtractRect(InternalRect, rc1, rc2)
End Function

Public Function UnionRect(rcSrc1 As dwRECT, rcSrc2 As dwRECT) As Boolean
Attribute UnionRect.VB_HelpID = 2993
Attribute UnionRect.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
    Dim rc1 As RECT
    Dim rc2 As RECT
    rcSrc1.CopyToRECT agGetAddressForObject(rc1.left)
    rcSrc2.CopyToRECT agGetAddressForObject(rc2.left)
    UnionRect = apiUnionRect(InternalRect, rc1, rc2)
End Function

Public Sub CopyToRECT(ByVal lprc As Long)
    If lprc = 0 Then RaiseRectError 5
    agCopyData InternalRect, ByVal lprc, Len(InternalRect)
End Sub

Public Function GetAddress() As Long
    GetAddress = agGetAddressForObject(InternalRect.left)
End Function

Public Sub SetRectEmpty()
Attribute SetRectEmpty.VB_HelpID = 2989
Attribute SetRectEmpty.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
    apiSetRectEmpty InternalRect
End Sub

Public Function IsRectEmpty() As Boolean
Attribute IsRectEmpty.VB_HelpID = 2996
Attribute IsRectEmpty.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
    IsRectEmpty = apiIsRectEmpty(InternalRect)
End Function
