'##############################################################################################################
Type Form_Type
V_Next As Form_Type Ptr
V_Prev As Form_Type Ptr
V_WinID As Uinteger
V_PosX As Integer
V_PosY As Integer
V_Width As Uinteger
V_Height As Uinteger
End Type
'--------------------------------------------------------------------------------------------------------------
Dim Shared G_Form_First As Form_Type Ptr
Dim Shared G_Form_Last As Form_Type Ptr
Dim Shared G_FormC As Uinteger
Dim Shared G_FormIDC As Uinteger
'##############################################################################################################
Function F_Form_Add(V_PosX As Integer, V_PosY As Integer, V_Width As Uinteger, V_Height As Uinteger) As Uinteger
'Ein Neues Fenster muss an das ende der Liste anhängt werden.
If G_Form_Last <> 0 Then
G_Form_Last->V_Next = Callocate(Sizeof(Form_Type))
G_Form_Last->V_Next->V_Prev = G_Form_Last
G_Form_Last = G_Form_Last->V_Next
Else
G_Form_Last = Callocate(Sizeof(Form_Type))
G_Form_First = G_Form_Last
End If
'fenster-id hoch zählen
G_FormIDC += 1
'parameter in die typenstruktur eintragen
With *G_Form_Last
.V_WinID = G_FormIDC
.V_PosX = V_PosX
.V_PosY = V_PosY
.V_Width = V_Width
.V_Height = V_Height
End With
Return G_FormIDC
End Function
'##############################################################################################################
Sub F_Form_SetFocus(V_FID As Uinteger)
Dim TPtr As Form_Type Ptr = G_Form_First
'Zuerst muss der Pointer des Fensters gesucht werden, welches ganznach oben muss
'Die Suchreihenfolge (vorwerts, rückwerts) ist hier egal. Hier geht es nur um die Fenster-ID
Do Until TPtr = 0
If TPtr->V_WinID = V_FID Then Exit Do
TPtr = TPtr->V_Next
Loop
If TPtr = 0 Then Exit Sub 'Wenn kein Pointer gefunden wurde, dann kann die sub verlassen werden
If TPtr->V_Next = 0 Then Exit Sub 'Wenn das Fenster bereits ganz oben ist, brauchen wir es nicht verschieben -> sub verlassen
'Den Pointer aus der LinkedList heraus nehmen
If TPtr->V_Prev <> 0 Then TPtr->V_Prev->V_Next = TPtr->V_Next
If TPtr->V_Next <> 0 Then TPtr->V_Next->V_Prev = TPtr->V_Prev
If G_Form_First = TPtr Then G_Form_First = TPtr->V_Next
'Ausgeschnittenen Pointer am ende wieder einfügen
G_Form_Last->V_Next = TPtr
TPtr->V_Prev = G_Form_Last
TPtr->V_Next = 0
G_Form_Last = TPtr
End Sub
'##############################################################################################################
Sub F_Form_Redraw()
Screenlock()
Cls()
Dim TPtr As Form_Type Ptr = G_Form_First
'Hier muss die LL vorwerts durchlaufen werden
Do Until TPtr = 0
With *TPtr
'füllung / rahmen / text
Line(.V_PosX, .V_PosY)-(.V_PosX + .V_Width, .V_PosY + .V_Height), &HFFFFFF, BF
Line(.V_PosX, .V_PosY)-(.V_PosX + .V_Width, .V_PosY + .V_Height), &H0000FF, B
Draw String (.V_PosX + 5, .V_PosY + 5), Str(.V_WinID), &H000000
End With
TPtr = TPtr->V_Next
Loop
Screenunlock()
End Sub
'##############################################################################################################
Sub F_Form_CheckMouse()
Dim MX As Integer
Dim MY As Integer
Dim MZ As Integer
Dim MB As Integer
Dim BV As Integer
BV = Getmouse(MX, MY, MZ, MB)
If BV <> 0 Then Exit Sub 'unbekannter Fehler
If MB = -1 Then Exit Sub 'Keine Maus gefunden
If MB = 0 Then Exit Sub 'wenn kein Button gedrückt
'liste RÜCKWÄRTS!!! durchlaufen
Dim TPtr As Form_Type Ptr = G_Form_Last
Do Until TPtr = 0
With *TPtr
'ist maus im fenster?
If (MX >= .V_PosX) And (MX <= .V_PosX + .V_Width) Then
If (MY >= .V_PosY) And (MY <= .V_PosY + .V_Height) Then
'dann fokusieren
F_Form_SetFocus(.V_WinID)
'und sub verlassen, da fertig
Exit Sub
End If
End If
End With
TPtr = TPtr->V_Prev
Loop
End Sub
'##############################################################################################################
Screenres 1024, 768, 24
'10 fenster erzeugen
For X As Uinteger = 1 To 10
F_Form_Add(X * 25, X * 25, 100, 100)
Next
'hauptschleife
Do Until Inkey() = Chr(27) 'auf ESC warten
F_Form_CheckMouse() 'mausereignisse prüfen
F_Form_Redraw() 'neuzeichnen
Sleep 10, 1
Loop
Screen 0
End
