Home

Add

Edit

With Linenumbers

Code in Textfield

Download

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