fb:porticula NoPaste
stringmod
Uploader: | grindstone |
Datum/Zeit: | 01.08.2014 14:05:34 |
Declare Function stringmod(text As String) As String
Dim As String text
Do 'hier ein paar beispiele für die funktionsweise
text = "aller Anfang ist schwer"
text = stringmod(text)
Print
Print text
text = ""
text = stringmod(text)
Print
Print text
text = "Beispiel"
text = stringmod(text)
Print
Print text
Locate CsrLin,20
Print "Eingabe: ";
text = stringmod("anderes Beispiel")
Print
Print text
Loop Until text = "ende"
Function stringmod(text As String) As String
Dim As Integer ze, sp, co, gi
Dim As String g, merken, txt
txt = text + " "
merken = txt
co = Pos(8) 'cursor offset
ze = CsrLin
sp = Len(txt) 'zeiger auf zeichen unter cursor
Locate ze, co, 1
Print txt;
Locate ze, sp+co-1, 1 'blinkender cursor
Do 'eingabeschleife
g = InKey
If Len(g) = 1 Then 'normales zeichen
If g[0] > 31 Then 'normaler buchstabe
txt = Left(txt, sp - 1) + g + Mid(txt, sp)
sp += 1
Locate ze, co, 0
Print txt;
Locate ze, sp+co-1, 1
Else 'steuerzeichen
Select Case g[0]
Case 8 ' Rücktaste
If sp > 1 Then
txt = Left(txt, sp - 2) + Mid(txt, sp)
sp -= 1
Locate ze, co, 0
Print txt;
Locate ze, sp+co-1, 1
End If
Case 13
'return
Case 27 'esc
txt = merken 'alter string
g = Chr$(13) 'beenden
'Case Else
'Print "*"; g; "*"; ASC(g) 'code von unbekannter taste anzeigen
End Select
End If
ElseIf Len(g) = 2 Then 'steuerzeichen
gi = g[1]
Select Case gi 'steuerzeichen
Case 75 'pfeil nach links -> cursor nach links
If sp > 1 Then
sp -= 1
Locate ze, sp+co-1, 1
End If
Case 77 'pfeil nach rechts -> cursor nach rechts
If sp < Len(txt) Then
sp += 1
Locate ze, sp+co-1, 1
End If
Case 14 'rücktaste -> zeichen vor cursor löschen
If sp > 1 Then
txt = Left$(txt, sp - 1) + Mid$(txt, sp)
sp -= 1
Locate ze, co, 0
Print txt;
Locate ze, sp+co-1, 1
End If
Case 83 'entf -> zeichen hinter cursor löschen
If sp < Len(txt) Then
txt = Left$(txt, sp - 1) + Mid$(txt, sp + 1)
Locate ze, co, 0
Print txt;
Locate ze, sp+co-1, 1
End If
Case 71 'pos1 -> cursor an stringanfang setzen
sp = 1
Locate ze, sp+co-1, 1
Case 79 'ende -> cursor an stringende setzen
sp = Len(txt)
Locate ze, sp+co-1, 1
'Case Else
'Print "*"; g; "*";Asc(Right$(g,1)) 'code von unbekannter taste anzeigen
End Select
Else 'keine taste
Sleep 1 'zur ressourcenschonung
End If
Loop Until g = Chr$(13) 'return
Return Left(txt, Len(txt) - 1)
Locate ze, sp+co-1, 0 'cursor aus
End Function