VB 5/6-Tipp 0393: Schnittpunkte und -fläche zweier rechteckiger Objekte ermitteln
von ActiveVB
Beschreibung
Die Windows-API bietet eigens für die Schnittpunktfrage eine Funktion. Einschränkende Bedingung: Die Objekte müssen rechteckig und waagerecht im Raum sein. Sie gibt an ob sich zwei Flächen schneiden und übergibt zudem die resultierende Schnittfläche.
Schwierigkeitsgrad: | Verwendete API-Aufrufe: | Download: |
'Dieser Quellcode stammt von http://www.activevb.de 'und kann frei verwendet werden. Für eventuelle Schäden 'wird nicht gehaftet. 'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum. 'Ansonsten viel Spaß und Erfolg mit diesem Source! '------------- Anfang Projektdatei Project1.vbp ------------- '--------- Anfang Formular "Form1" alias Form1.frm --------- ' Steuerelement: Timersteuerelement "Timer1" ' Steuerelement: Beschriftungsfeld "Label9" ' Steuerelement: Beschriftungsfeld "Label2" ' Steuerelement: Beschriftungsfeld "Label4" ' Steuerelement: Beschriftungsfeld "Label3" ' Steuerelement: Beschriftungsfeld "Label1" ' Steuerelement: Beschriftungsfeld "Label8" ' Steuerelement: Beschriftungsfeld "Label7" ' Steuerelement: Beschriftungsfeld "Label6" ' Steuerelement: Beschriftungsfeld "Label5" Option Explicit Private Declare Function GetWindowRect Lib "user32.dll" (ByVal _ hwnd As Long, lpRect As RECT) As Long Private Declare Function IntersectRect Lib "user32.dll" _ (lpDestRect As RECT, lpSrc1Rect As RECT, lpSrc2Rect As _ RECT) As Long Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Private Sub Form_Load() Form2.Show Timer1.Interval = 50 Timer1.Enabled = True End Sub Private Sub Form_Unload(Cancel As Integer) Unload Form2 End Sub Private Sub Timer1_Timer() Dim RectIntersect As RECT Dim RectForm1 As RECT Dim RectForm2 As RECT Dim Result As Long Call GetWindowRect(Form1.hwnd, RectForm1) Call GetWindowRect(Form2.hwnd, RectForm2) Result = IntersectRect(RectIntersect, _ RectForm1, RectForm2) If Result <> 0 Then Form1.Caption = "Schnittpunkt!" Form2.Caption = "Schnittpunkt!" Label1.Caption = RectIntersect.Left Label2.Caption = RectIntersect.Top Label3.Caption = RectIntersect.Right Label4.Caption = RectIntersect.Bottom Else Form1.Caption = "Nebeneinander" Form2.Caption = "Nebeneinander" Label1.Caption = "" Label2.Caption = "" Label3.Caption = "" Label4.Caption = "" End If End Sub '---------- Ende Formular "Form1" alias Form1.frm ---------- '--------- Anfang Formular "Form2" alias Form2.frm --------- Option Explicit Private Sub Form_Unload(Cancel As Integer) Unload Form1 End Sub '---------- Ende Formular "Form2" alias Form2.frm ---------- '-------------- Ende Projektdatei Project1.vbp --------------
Tipp-Kompatibilität:
Windows/VB-Version | Win32s | Win95 | Win98 | WinME | WinNT4 | Win2000 | WinXP |
VB4 | |||||||
VB5 | |||||||
VB6 |
Ihre Meinung
Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.
Archivierte Nutzerkommentare
Klicken Sie diesen Text an, wenn Sie die 1 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.