Home

Add

Edit

Without Linenumbers

Code in Textfield

Download

  1. '##############################################################################################################
    
  2. Type Form_Type
    
  3.     V_Next          As Form_Type Ptr
    
  4.     V_Prev          As Form_Type Ptr
    
  5.     
    
  6.     V_WinID         As Uinteger
    
  7.     V_PosX         As Integer
    
  8.     V_PosY         As Integer
    
  9.     V_Width         As Uinteger
    
  10.     V_Height        As Uinteger
    
  11. End Type
    
  12. '--------------------------------------------------------------------------------------------------------------
    
  13. Dim Shared G_Form_First     As Form_Type Ptr
    
  14. Dim Shared G_Form_Last      As Form_Type Ptr
    
  15. Dim Shared G_FormC          As Uinteger
    
  16. Dim Shared G_FormIDC        As Uinteger
    
  17. 
    
  18. 
    
  19. 
    
  20. '##############################################################################################################
    
  21. Function F_Form_Add(V_PosX As Integer, V_PosY As Integer, V_Width As Uinteger, V_Height As Uinteger) As Uinteger
    
  22. 'Ein Neues Fenster muss an das ende der Liste anhängt werden.
    
  23. If G_Form_Last <> 0 Then
    
  24.     G_Form_Last->V_Next = Callocate(Sizeof(Form_Type))
    
  25.     G_Form_Last->V_Next->V_Prev = G_Form_Last
    
  26.     G_Form_Last = G_Form_Last->V_Next
    
  27. Else
    
  28.     G_Form_Last = Callocate(Sizeof(Form_Type))
    
  29.     G_Form_First = G_Form_Last
    
  30. End If
    
  31. 'fenster-id hoch zählen
    
  32. G_FormIDC += 1
    
  33. 'parameter in die typenstruktur eintragen
    
  34. With *G_Form_Last
    
  35.     .V_WinID    = G_FormIDC
    
  36.     .V_PosX     = V_PosX
    
  37.     .V_PosY     = V_PosY
    
  38.     .V_Width    = V_Width
    
  39.     .V_Height   = V_Height
    
  40. End With
    
  41. Return G_FormIDC
    
  42. End Function
    
  43. 
    
  44. 
    
  45. 
    
  46. '##############################################################################################################
    
  47. Sub F_Form_SetFocus(V_FID As Uinteger)
    
  48. Dim TPtr As Form_Type Ptr = G_Form_First
    
  49. 'Zuerst muss der Pointer des Fensters gesucht werden, welches ganznach oben muss
    
  50. 'Die Suchreihenfolge (vorwerts, rückwerts) ist hier egal. Hier geht es nur um die Fenster-ID
    
  51. Do Until TPtr = 0
    
  52.     If TPtr->V_WinID = V_FID Then Exit Do
    
  53.     TPtr = TPtr->V_Next
    
  54. Loop
    
  55. If TPtr = 0 Then Exit Sub 'Wenn kein Pointer gefunden wurde, dann kann die sub verlassen werden
    
  56. If TPtr->V_Next = 0 Then Exit Sub 'Wenn das Fenster bereits ganz oben ist, brauchen wir es nicht verschieben -> sub verlassen
    
  57. 
    
  58. 'Den Pointer aus der LinkedList heraus nehmen
    
  59. If TPtr->V_Prev <> 0 Then TPtr->V_Prev->V_Next = TPtr->V_Next
    
  60. If TPtr->V_Next <> 0 Then TPtr->V_Next->V_Prev = TPtr->V_Prev
    
  61. If G_Form_First = TPtr Then G_Form_First = TPtr->V_Next
    
  62. 
    
  63. 'Ausgeschnittenen Pointer am ende wieder einfügen
    
  64. G_Form_Last->V_Next = TPtr
    
  65. TPtr->V_Prev = G_Form_Last
    
  66. TPtr->V_Next = 0
    
  67. G_Form_Last = TPtr
    
  68. End Sub
    
  69. 
    
  70. 
    
  71. 
    
  72. '##############################################################################################################
    
  73. Sub F_Form_Redraw()
    
  74. Screenlock()
    
  75. Cls()
    
  76. Dim TPtr As Form_Type Ptr = G_Form_First
    
  77. 'Hier muss die LL vorwerts durchlaufen werden
    
  78. Do Until TPtr = 0
    
  79.     With *TPtr
    
  80.         'füllung / rahmen / text
    
  81.         Line(.V_PosX, .V_PosY)-(.V_PosX + .V_Width, .V_PosY + .V_Height), &HFFFFFF, BF
    
  82.         Line(.V_PosX, .V_PosY)-(.V_PosX + .V_Width, .V_PosY + .V_Height), &H0000FF, B
    
  83.         Draw String (.V_PosX + 5, .V_PosY + 5), Str(.V_WinID), &H000000
    
  84.     End With
    
  85.     TPtr = TPtr->V_Next
    
  86. Loop
    
  87. Screenunlock()
    
  88. End Sub
    
  89. 
    
  90. 
    
  91. 
    
  92. '##############################################################################################################
    
  93. Sub F_Form_CheckMouse()
    
  94. Dim MX As Integer
    
  95. Dim MY As Integer
    
  96. Dim MZ As Integer
    
  97. Dim MB As Integer
    
  98. Dim BV As Integer
    
  99. BV = Getmouse(MX, MY, MZ, MB)
    
  100. If BV <> 0 Then Exit Sub 'unbekannter Fehler
    
  101. If MB = -1 Then Exit Sub 'Keine Maus gefunden
    
  102. If MB = 0 Then Exit Sub 'wenn kein Button gedrückt
    
  103. 'liste RÜCKWÄRTS!!! durchlaufen
    
  104. Dim TPtr As Form_Type Ptr = G_Form_Last
    
  105. Do Until TPtr = 0
    
  106.     With *TPtr
    
  107.         'ist maus im fenster?
    
  108.         If (MX >= .V_PosX) And (MX <= .V_PosX + .V_Width) Then
    
  109.             If (MY >= .V_PosY) And (MY <= .V_PosY + .V_Height) Then
    
  110.                 'dann fokusieren
    
  111.                 F_Form_SetFocus(.V_WinID)
    
  112.                 'und sub verlassen, da fertig
    
  113.                 Exit Sub
    
  114.             End If
    
  115.         End If
    
  116.     End With
    
  117.     TPtr = TPtr->V_Prev
    
  118. Loop
    
  119. End Sub
    
  120. 
    
  121. 
    
  122. 
    
  123. 
    
  124. 
    
  125. '##############################################################################################################
    
  126. Screenres 1024, 768, 24
    
  127. '10 fenster erzeugen
    
  128. For X As Uinteger = 1 To 10
    
  129.     F_Form_Add(X * 25, X * 25, 100, 100)
    
  130. Next
    
  131. 'hauptschleife
    
  132. Do Until Inkey() = Chr(27) 'auf ESC warten
    
  133.     F_Form_CheckMouse() 'mausereignisse prüfen
    
  134.     F_Form_Redraw() 'neuzeichnen
    
  135.     Sleep 10, 1
    
  136. Loop
    
  137. Screen 0
    
  138. End
    
  139. 
    
  140.