Binaryworld - Example of rectangle APIs ... [ VB -> Graphics ]

This sample code will show you how to work with basic Rectangle manipulation APIs to do some math operations with Rectangles.

Step-By-Step Example

- Create a standard exe project
- Add one timer control on the form1
- Add the following code in form1

Click here to copy the following block

Option Explicit

Private Declare Function SetRect Lib "user32" ( _
    lpRect As RECT, _
    ByVal X1 As Long, _
    ByVal Y1 As Long, _
    ByVal X2 As Long, _
    ByVal Y2 As Long) As Long

Private Declare Function IntersectRect Lib "user32" ( _
    lpDestRect As RECT, _
    lpSrc1Rect As RECT, _
    lpSrc2Rect As RECT) As Long

Private Declare Function UnionRect Lib "user32" ( _
    lpDestRect As RECT, _
    lpSrc1Rect As RECT, _
    lpSrc2Rect As RECT) As Long

Private Declare Function SubtractRect Lib "user32" ( _
    lprcDst As RECT, _
    lprcSrc1 As RECT, _
    lprcSrc2 As RECT) As Long

Private Declare Function IsRectEmpty Lib "user32" ( _
    lpRect As RECT) As Long

Private Declare Function EqualRect Lib "user32" ( _
    lpRect1 As RECT, _
    lpRect2 As RECT) As Long

Private Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type

Private r1 As RECT, r2 As RECT
Private dx As Long, dy As Long, klr As Long

Private Sub Form_Load()
  Dim rTest As RECT

  Move Left, Top, 6800, 7000
  AutoRedraw = True
  ScaleMode = vbPixels
  SetRect r1, 150, 150, 300, 300
  SetRect r2, 10, 60, 40, 90
  SetRect rTest, 50, 50, 25, 100

  '//Both are valid rect
  Debug.Print IIf(IsRectEmpty(r1), "Rect is empty", "Rect is not empty")
  Debug.Print IIf(IsRectEmpty(r2), "Rect is empty", "Rect is not empty")

  '//Both are not equal
  Debug.Print IIf(EqualRect(r1, r2), "Both are equal", "Both are not equal")

  '//This is not valid Rect coz Left edge is less than right edge
  Debug.Print IIf(IsRectEmpty(rTest), "Rect is empty", "Rect is not empty")

  Line (r1.Left, r1.Top)-(r1.Right, r1.Bottom), vbBlack, BF

  AutoRedraw = False
  Timer1.Interval = 20
  dx = 2
  dy = 2
End Sub

Private Sub Timer1_Timer()
  Dim dmy As RECT

  r2.Left = r2.Left + dx
  r2.Right = r2.Right + dx
  r2.Top = r2.Top + dy
  r2.Bottom = r2.Bottom + dy

  If r2.Right >= ScaleWidth Or r2.Left <= 0 Then dx = dx * -1  '//Inverse the X increment
  If r2.Bottom >= ScaleHeight Or r2.Top <= 0 Then dy = dy * -1  '//Inverse the Y increment

  ' Square is normally white, but red when they intersect.
  klr = vbWhite

  If IntersectRect(dmy, r1, r2) Then klr = vbRed
  Cls
  Line (r2.Left, r2.Top)-(r2.Right, r2.Bottom), klr, BF

  If UnionRect(dmy, r1, r2) <> 0 Then
    Line (dmy.Left, dmy.Top)-(dmy.Right, dmy.Bottom), vbBlue, B
  End If

  If SubtractRect(dmy, r2, r1) <> 0 Then
    Line (dmy.Left, dmy.Top)-(dmy.Right, dmy.Bottom), vbMagenta, B
  End If
End Sub