Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
MultiLine_Textfield
| Uploader: |  ThePuppetMaster |
| Datum/Zeit: | 24.06.2011 17:13:21 |
Type TextLine
V_Next as TextLine Ptr
V_Prex as TextLine Ptr
V_Data as String
End Type
Dim Shared TextLine_FirstPtr as TextLine Ptr
Dim Shared TextLine_LastPtr as TextLine Ptr
Dim Shared TextLine_CurPtr as TextLine Ptr
Dim Shared TextLine_CurPos as UInteger
Sub NextLine()
If TextLine_CurPtr->V_Next <> 0 Then
Dim TNewPtr as TextLine Ptr = CAllocate(SizeOf(TextLine))
TNewPtr->V_Prev = TextLine_CurPtr
TNewPtr->V_Next = TextLine_CurPtr->V_Next
If TNewPtr->V_Prev <> 0 Then TNewPtr->V_Prev->V_Next = TNewPtr
If TNewPtr->V_Next <> 0 Then TNewPtr->V_Next->V_Prev = TNewPtr
TextLine_CurPtr = TNewPtr
TextLine_CurPos = 0
Else
TextLine_LastPtr->V_Next = CAllocate(SizeOf(TextLine))
TextLine_LastPtr->V_Next->V_Prev = TextLine_LastPtr
TextLine_LastPtr = TextLine_LastPtr->V_Next
TextLine_CurPtr = TextLine_LastPtr
End If
End Sub
Sub KeyCheck(V_KeyASCII)
'hier werden die eingegebenen KeyCodes von der Tastatur ausgewertet und in den 3L Speicher kopiert
Dim TDoReDraw as UByte
Select Case V_KeyASCII
Case 13 'Cursor zurückfahren (CR = Carier Return)
'Wenn es n Terminal ähnliches Textfield werden soll, dann muss auch 13 ausgewertet werden
'Unter Linux wird 13 nicht versand
TDoReDraw = 1
Case 10 'Nächste Zeile (LF = Line Feed)
NextLine()
TDoReDraw = 1
'Case Cursor_Up
If TextLine_CurPtr->V_Prev <> 0 Then
TextLine_CurPtr = TextLine_CurPtr->V_Prev
If TextLine_CurPos > Len(TextLine_CurPtr->V_Data) Then TextLine_CurPtr = Len(TextLine_CurPtr->V_Data)
TDoReDraw = 1
Else
'Mann kann diesen ELSE Teil auskommentieren, wenn man nicht möchte, das bei erreichen der letzten zeile
'und dem erneutem Druck auf UP der Cursor nicht an das ende der zeile geschoben werden soll.
If TextLine_CurPos <> Len(TextLine_CurPtr->V_Data) - 1 Then
TextLine_CurPos = Len(TextLine_CurPtr->V_Data) - 1
TDoReDraw = 1
End If
End If
'Case Cursor_Down
If TextLine_CurPtr->V_Next <> 0 Then
TextLine_CurPtr = TextLine_CurPtr->V_Next
If TextLine_CurPos > Len(TextLine_CurPtr->V_Data) + 1 Then TextLine_CurPtr = Len(TextLine_CurPtr->V_Data)
TDoReDraw = 1
Else
'Selbes Für Down und dem anfang der Zeile
If TextLine_CurPos <> 0 Then
TextLine_CurPos = 0
TDoReDraw = 1
End If
End If
'Case Cursor_Left
If TextLine_CurPos = 0 Then
If TextLine_CurPtr->V_Prev <> 0 Then
TextLine_CurPtr = TextLine_CurPtr->V_Prev
TextLine_CurPos = Len(TextLine_CurPtr->V_Data) - 1
TDoReDraw = 1
End If
Else
TextLine_CurPos -= 1
TDoReDraw = 1
End If
'Case Cursor_Right
If TextLine_CurPos >= Len(TextLine_CurPtr->V_Data) - 1 Then
If TextLine_CurPtr->V_Next <> 0 Then
TextLine_CurPtr = TextLine_CurPtr->V_Next
TextLine_CurPos = 0
TDoReDraw = 1
End If
Else
TextLine_CurPos += 1
TDoReDraw = 1
End If
Case 8 '(Backspace) 'Rückwerts löschen
If TextLine_CurPtr = 0 Then
If TextLine_CurPtr->V_Next <> 0 Then
If TextLine_CurPtr->V_Prev <> 0 Then TextLine_CurPtr->V_Prev->V_Next = TextLine_CurPtr->V_Next
If TextLine_CurPtr->V_Next <> 0 Then TextLine_CurPtr->V_Next->V_Prev = TextLine_CurPtr->V_Prev
If TextLine_FirstPtr = TextLine_CurPtr Then TextLine_FirstPtr = TextLine_CurPtr->V_Next
If TextLine_LastPtr = TextLine_CurPtr Then TextLine_LastPtr = TextLine_CurPtr->V_Prev
Dim TDelPtr as TextLine Ptr = TextLine_CurPtr
TextLine_CurPtr = TextLine_CurPtr->V_Prev
DeAllocate(TextLine_CurPtr)
TextLine_CurPos = Len(TextLine_CurPtr->V_Data)
End If
Else
TextLine_CurPtr->V_Data = Left(TextLine_CurPtr->V_Data, TextLine_CurPos - 1) & Mid(TextLine_CurPtr->V_Data, TextLine_CurPos + 1)
TextLine_CurPos -= 1
TDoReDraw = 1
End If
'Case '(enft) 'Vorwerts löschen
If TextLine_CurPtr = Len(TextLine_CurPtr->V_Data) - 1 Then
If TextLine_CurPtr->V_Next <> 0 Then
If TextLine_CurPtr->V_Prev <> 0 Then TextLine_CurPtr->V_Prev->V_Next = TextLine_CurPtr->V_Next
If TextLine_CurPtr->V_Next <> 0 Then TextLine_CurPtr->V_Next->V_Prev = TextLine_CurPtr->V_Prev
If TextLine_FirstPtr = TextLine_CurPtr Then TextLine_FirstPtr = TextLine_CurPtr->V_Next
If TextLine_LastPtr = TextLine_CurPtr Then TextLine_LastPtr = TextLine_CurPtr->V_Prev
Dim TDelPtr as TextLine Ptr = TextLine_CurPtr
TextLine_CurPtr = TextLine_CurPtr->V_Next
DeAllocate(TextLine_CurPtr)
TextLine_CurPos = Len(TextLine_CurPtr->V_Data)
End If
Else
TextLine_CurPtr->V_Data = Left(TextLine_CurPtr->V_Data, TextLine_CurPos) & Mid(TextLine_CurPtr->V_Data, TextLine_CurPos + 2)
TDoReDraw = 1
End If
Case 48 to 57, 65 to 90, 97 to 122 '... '0-9, A-Z, a-z, ...
'Hier kann man jedes Zeichen eintragen, das als reguläres Zeichen in den 3L Textspeicher hinzugefügt werden soll.
TextLine_CurPtr->V_Data = Left(TextLine_CurPtr->V_Data, TextLine_CurPos) & Chr(KeyASCII) & Mid(TextLine_CurPtr->V_Data, TextLine_CurPos + 1)
TDoReDraw = 1
End Select
If TDoReDraw = 1 Then
TDoReDraw = 0
'Wenn dieses Flag gesetzt ist, muss neu gezeichnet werden.
'Um nicht das system in die knie zu zwingen, kann man ein Timing verwenden, das zyklich alle 20ms neu zeichnet, falls lötig
End If
End Sub
Sub TextFiled Init()
'Nötig um eine erste Zeile zu erzeugen
TextLine_LastPtr = CAllocate(SizeOf(TextLine))
TextLine_FirstPtr = TextLine_LastPtr
TextLine_CurPtr = TextLine_LastPtr
End Sub