fb:porticula NoPaste
Mal was nützliches
Uploader: | The_Muh |
Datum/Zeit: | 09.07.2008 01:21:42 |
'... eine Funktion! aus der not heraus selbst geschrieben,
'eigentlich nur eine erweiterte form von Input, hier ist eine
'positionierung unäbhängig von locate (außerhalb der
'funktion) möglich und ein vorgabe-wert
'schema: <variable> = eingabe("Name", "Max Mustermann", 1,1)
function eingabe(ByVal frage As String ,vorgabe As String, X as integer,Y as integer) as string
dim zeichen as string
dim zeichenkette as string
dim L as integer
dim Li as string
dim Re as string
dim ascR as integer
dim ascL as integer
dim einf as integer
dim spalte as integer
dim rest as string
einf = 0
zeichenkette = vorgabe
locate x, y
print frage & " " & Zeichenkette
spalte = len(zeichenkette)
y = len(frage)
do
cls
locate x : print frage,1
locate x, len(frage) + 1,1: print Zeichenkette
DRAW STRING ((y + spalte -1)*8 , (x-1)*8), "_", 'Cursor anzeigen
locate x, y+spalte,1
do : sleep 1 : zeichen = inkey : loop while zeichen = ""
Li = mid(zeichen, 1,1)
Re = mid(zeichen, 2.1)
ascL = asc(Li)
ascR = asc(Re)
L = len(zeichenkette)
select case ascR
case 82 'testen ob "einf" gedrückt wurde
if einf = 1 then 'der umschalter
einf = 0
else
einf = 1
end if
case 75: 'links
if spalte > 1 then spalte -= 1
case 77: 'rechts
if spalte < L then spalte += 1
end select
if ascL <> 255 then
'print "A"
select case ascL
case 8 'backspace
if L >= spalte then
rest = right(zeichenkette, (L - spalte))
MID(zeichenkette, spalte, len(rest)) = rest
zeichenkette=left(zeichenkette,len(zeichenkette)-1)
else
zeichenkette=left(zeichenkette,len(zeichenkette)-1)
end if
if spalte <> 1 then spalte -= 1
case 13 'enter
return zeichenkette
locate 3,1
exit function
case 127 'entf
if L >= spalte then
rest = right(zeichenkette, (L - spalte))
MID(zeichenkette, spalte, len(rest)) = rest
zeichenkette=left(zeichenkette,len(zeichenkette)-1)
end if
case else
if L >= spalte then
if einf = 0 then
MID(zeichenkette, spalte, 1) = zeichen
else
zeichenkette = left(zeichenkette, spalte -1) + zeichen + right(zeichenkette, (L - spalte +1) )
end if
else
zeichenkette = zeichenkette + zeichen
end if
spalte += 1
end select
end if
loop until zeichen = chr(13)
end function