|
Mit Hilfe einiger weniger, schneller API-Funktionen können Sie
spielend leicht feststellen, ob sich zwei Objekte, wie
Steuerelemente oder Forms u.ä., überschneiden.
Als einzige Voraussetzung müssen diese Objekte über ein
Fenster-Handle verfügen (Eigenschaft hWnd), damit Sie über die
API-Funktion  GetWindowRect
bequem die umschließenden Rechtecke der Objekte ermitteln können.
GetWindowRect liefert praktischerweise die absolute, auf den
gesamten Bildschirm bezogene Position, so dass Sie auch problemlos
auch aus verschiedenen Forms (oder anderen Containern) stammende
Objekte prüfen können.
Die mit GetWindowRect ermittelten Rechtecke werden der
API-Funktion IntersectRect
übergeben, die im ersten Parameter ein Rechteck zurückgibt, das im
Falle einer Überschneidung den von beiden Rechtecken überdeckten
Bereich zurückgibt. Überschneiden sich die beiden Rechtecke nicht,
ist dieses resultierende Rechteck leer. Mit der API-Funktion IsRectEmpty
prüfen Sie nun, ob es sich um ein leeres Rechteck handelt oder
nicht.
Die Deklarationen lauten:
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function GetWindowRect Lib "user32" _
(ByVal hwnd As Long, Rect As RECT) As Long
Private Declare Function IntersectRect Lib "user32" _
(DestRect As RECT, Src1Rect As RECT, Src2Rect As RECT) As Long
Private Declare Function IsRectEmpty Lib "user32" _
(Rect As RECT) As Long
Der folgenden Funktion IntersectWindows übergeben sie die beiden
zu prüfenden Objekte, und erhalten True zurück, wenn sich diese
überschneiden:
Public Function IntersectWindows(Obj1 As Object, _
Obj2 As Object) As Boolean
Dim nRect1 As RECT
Dim nRect2 As RECT
Dim nRect3 As RECT
GetWindowRect Obj1.hwnd, nRect1
GetWindowRect Obj2.hwnd, nRect2
IntersectRect nRect3, nRect1, nRect2
IntersectWindows = Not (CBool(IsRectEmpty(nRect3)))
End Function
 |
Die Funktion IntersectWindows prüft, ob
sich zwei Objekte (Steuerelemente, Forms u.ä.) überschneiden
|
In dem Progrämmchen zur oben gezeigten kleinen Animation ruft
einfach ein Timer auf Form2 alle 100 Milliesekunden die Funktion
IntersectWindows auf und übergibt ihr die beiden Forms als
Parameter:
Private Sub tmr_Timer()
If IntersectWindows(Form1, Form2) Then
Me.BackColor = vbRed
Else
Me.BackColor = vbButtonFace
End If
End Sub
|