Atlanta Custom Software Development 

   Search        Code/Page

User Login



Forgot the Password?
» Web Development
» Maintenance
» Data Integration/BI
» Information Management
» Regular Expr Tester
» Free Tools

Example of rectangle APIs

Total Hit ( 2322)

Rate this article:     Poor     Excellent 

 Submit Your Question/Comment about this article



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
  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

Submitted By : Nayan Patel  (Member Since : 5/26/2004 12:23:06 PM)

Job Description : He is the moderator of this site and currently working as an independent consultant. He works with, SQL Server and other MS technologies. He is, MCDBA and MCSE. In his free time he likes to watch funny movies and doing oil painting.
View all (893) submissions by this author  (Birth Date : 7/14/1981 )

Home   |  Comment   |  Contact Us   |  Privacy Policy   |  Terms & Conditions   |  BlogsZappySys

© 2008 BinaryWorld LLC. All rights reserved.