Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
Tastaturgestuetztes GUI
| Uploader: |  Lothar Schirm |
| Datum/Zeit: | 20.03.2009 17:44:34 |
'=========================================================================
' Tastaturgestuetztes Graphical User Interface
' GUI_Tastatur.BAS
' Erstellt 14.07.06
' Letzte Ueberarbeitung am 20.03.09
'=========================================================================
'Wichtige Tastaturabfragecodes, die von GETKEY zurueckgegeben werden:
CONST BKSP = &H08, TABKEY = &H09, SHIFT_TAB = &H0FFF, ENTER = &H0D, ESC = &H1B, _
LEFTARROW = &H4BFF, RIGHTARROW = &H4DFF, UPARROW = &H48FF, _
DOWNARROW = &H50FF, INS = &H52FF, DEL = &H53FF, ENDKEY = &H4FFF, _
HOME = &H47FF, _
F1 = &H3BFF, F2 = &H3CFF, F3 = &H3DFF, F4 = &H3EFF, F5 = &H3FFF, _
F6 = &H40FF, F7 = &H41FF, F8 = &H42FF, F9 = &H43FF, F10 = &H44FF, _
F11 = &H57FF, F12 = &H58FF
TYPE ScreenPos
' Zeichen und Farben einer Bildschirmposition (zum Abspeichern
' und Wiedereinfuegen des Bildschirm-Inhaltes mit den SUBs GetScreen und
' PutScreen)
Zeichen AS STRING*1
VFarbe AS INTEGER
HFarbe AS INTEGER
END TYPE
DECLARE SUB Zentriert(Zeile AS INTEGER, Text AS STRING)
DECLARE SUB ClScreen(o AS INTEGER, l AS INTEGER, u AS INTEGER, r AS INTEGER)
DECLARE SUB GetScreen(o AS INTEGER, l AS INTEGER, u AS INTEGER, r AS INTEGER, _
ScreenBuf() AS ScreenPos)
DECLARE SUB PutScreen(o AS INTEGER, l AS INTEGER, u AS INTEGER, r AS INTEGER, _
ScreenBuf() AS ScreenPos)
DECLARE SUB Rahmen(Titel AS STRING, Fusszeile AS STRING, o AS INTEGER, _
l AS INTEGER, u AS INTEGER, r AS INTEGER)
DECLARE SUB Cursor(vis AS INTEGER)
DECLARE SUB InString(BYREF s AS STRING, Laenge AS INTEGER, Mark AS INTEGER, _
BYREF ExitCode AS INTEGER)
DECLARE SUB Edit OVERLOAD (BYREF s AS STRING, Laenge AS INTEGER)
DECLARE SUB Edit(BYREF a AS DOUBLE)
DECLARE SUB Edit(BYREF k AS INTEGER)
DECLARE SUB EditLst(s() AS STRING, Laenge AS INTEGER, n AS INTEGER, _
Mark AS INTEGER)
DECLARE SUB EditTab(s() AS STRING, SpBreite() AS INTEGER, m AS INTEGER, _
n AS INTEGER, Mark AS INTEGER)
DECLARE SUB Eingabe(Maske() AS STRING, s() AS STRING, Laenge AS INTEGER, _
n AS INTEGER)
DECLARE SUB Auswahl(s() AS STRING, n AS INTEGER, BYREF sNr AS INTEGER)
SUB Zentriert(Zeile AS INTEGER, Text AS STRING)
' Zentrierter Text
DIM AS INTEGER Breite
Breite = LOWORD(WIDTH)
LOCATE Zeile, (Breite - LEN(Text)) / 2
PRINT Text
END SUB
SUB ClScreen(o AS INTEGER, l AS INTEGER, u AS INTEGER, r AS INTEGER)
' Loescht einen Bildschirmausschnitt durch Ueberschreiben mit der
' Hintergrundfarbe.
' - o = Position oberer Rand
' - l = Position linker Rand
' - u = Position unterer Rand
' - r = Position rechter Rand
DIM AS INTEGER Breite, y
Breite = r - l + 1
FOR y = o TO u
LOCATE y, l: PRINT SPACE(Breite);
NEXT y
END SUB
SUB GetScreen(o AS INTEGER, l AS INTEGER, u AS INTEGER, r AS INTEGER, _
ScreenBuf() AS ScreenPos)
' Prozedur zum Speichern eines Bildschirmausschnittes. ScreenBuf ist ein Array
' und sollte z.B. mit DIM AS ScreenPos ScreenBuf(1 TO 50, 1 TO 80) dimensioniert
' sein, wenn WIDTH 80, 50 gewahelt wurde.
DIM AS INTEGER row, col, colr
FOR row = o TO u
FOR col = l TO r
ScreenBuf(row, col).Zeichen = CHR(SCREEN(row, col, 0))
colr = SCREEN(row, col, 1)
ScreenBuf(row, col).VFarbe = colr AND &HF
ScreenBuf(row, col).HFarbe = (colr SHR 4) AND &HF
NEXT col
NEXT row
END SUB
SUB PutScreen(o AS INTEGER, l AS INTEGER, u AS INTEGER, r AS INTEGER, _
ScreenBuf() AS ScreenPos)
' Fuegt den gespeicherten Bildschirmausschnitt wieder ein
DIM AS INTEGER row, col
FOR row = o TO u
FOR col = l TO r
LOCATE row, col
COLOR ScreenBuf(row, col).VFarbe, ScreenBuf(row, col).HFarbe
PRINT ScreenBuf(row, col).Zeichen;
NEXT col
NEXT row
END SUB
SUB Rahmen(Titel AS STRING, Fusszeile AS STRING, o AS INTEGER, l AS INTEGER, _
u AS INTEGER, r AS INTEGER)
' Zeichnet einen Rahmen mit Titel.
' - Titel = Titel, zentriert (falls Titel <> "")
' - Fusszeile = Fusszeile, zentriert (falls Fusszeile <> "")
' - o = Position oberer Rand
' - l = Position linker Rand
' - u = Position unterer Rand
' - r = Position rechter Rand
' Der Rahmen wird mit aktuellen Hintergrundfarbe gefuellt. Erfolgt vorher eine
' entsprechende COLOR-Anweisung, wird ein farbiges Fenster mit Rahmen
' gezeichnet.
DIM AS INTEGER Breite, Hoehe, y
DIM AS STRING*1 eol, eor, eul, eur, hlin, vlin
eol = CHR(218)
eor = CHR(191)
eul = CHR(192)
eur = CHR(217)
hlin = CHR(196)
vlin = CHR(179)
' Hintergrund loeschen:
ClScreen(o, l, u, r)
' Rahmen zeichnen:
LOCATE o, l: PRINT eol; STRING(r - l - 1, hlin); eor;
FOR y = o + 1 TO u - 1
LOCATE y, l: PRINT vlin;
LOCATE y, r: PRINT vlin;
NEXT y
LOCATE u, l: PRINT eul; STRING(r - l - 1, hlin); eur;
' Titel und Fusszeile einfuegen:
Breite = r - l + 1
IF Titel <> "" THEN
LOCATE o, l + (Breite - LEN(Titel)) / 2 -1
PRINT SPACE(1); Titel; SPACE(1);
END IF
IF Fusszeile <> "" THEN
LOCATE u, l + (Breite - LEN(Fusszeile)) / 2 -1
PRINT SPACE(1); Fusszeile; SPACE(1);
END IF
END SUB
SUB Cursor(vis AS INTEGER)
' Setzt im Graphik-Mode (SCREEN > 0 oder SCREENRES) den Textcursor an der
' aktuellen Position. Hilfsprozedur zu SUB InString.
' vis = 0: Cursor unsichtbar (d.h. Cursor wird geloescht)
' vis <> 0: Cursor sichtbar (d.h. Cursor wird gesetzt)
DIM AS INTEGER row, col, fore, back, Zeichen
DIM AS STRING driver
SCREENINFO ,,,,,, driver
IF driver <> "" THEN
'Position, Farben und ASCII-Code des aktuellen Zeichens ermitteln:
row = CSRLIN
col = POS
fore = LOWORD(COLOR)
back = HIWORD(COLOR)
Zeichen = SCREEN(row, col, 0)
IF vis THEN
'Sichtbarer Cursor: Zeichen farblich invertiert darstellen
COLOR back, fore
PRINT CHR(Zeichen);
COLOR fore, back
ELSE
'Unsichtbarer Cursor: Zeichen nicht invertiert darstellen
PRINT CHR(Zeichen);
END IF
LOCATE row, col
END IF
END SUB
SUB InString(BYREF s AS STRING, Laenge AS INTEGER, Mark AS INTEGER, _
BYREF ExitCode AS INTEGER)
' Prozedur zum Editieren eines String mit Vorbelegung und Laengenbegrenzung,
' vgl. Datei INTEXT6.BAS aus QBMonFAQ.
' Parameter:
' - s = zu editierender String
' - Laenge = maximale Laenge von s
' - Mark <> 0: Eingabebalken wird waehrend des Editierens farblich markiert
' - ExitCode = Tastencode, mit dem die SUB verlassen wurde (ENTER, ESC, UPARROW,
' DOWNARROW, TABKEY oder SHIFT_TAB.
DIM AS INTEGER Zeile, Spalte, fore, back, Key, Cpos, length
Zeile = CSRLIN
Spalte = POS
fore = LOWORD(COLOR)
back = HIWORD(COLOR)
'(Markierter) Eingabebereich mit Vorbelegung fuer s:
IF Mark THEN
IF back = 7 THEN COLOR 7, 0 ELSE COLOR 0, 7
END IF
LOCATE Zeile, Spalte: PRINT SPACE(Laenge + 1); 'Eine Zeichenlaenge hinten fuer den Cursor!
LOCATE Zeile, Spalte: PRINT s;
LOCATE Zeile, Spalte: Cursor(1)
Cpos = 0
'Tastaturabfrage und -auswertung
DO
length = LEN(s)
Key = GETKEY
SELECT CASE Key
CASE ENTER, ESC, UPARROW, DOWNARROW, TABKEY, SHIFT_TAB
'Ende
ExitCode = key
EXIT DO
CASE LEFTARROW
'Eine Position nach links
IF Cpos > 0 THEN Cpos = Cpos - 1
CASE RIGHTARROW
'Eine Position nach rechts
IF Cpos < length THEN Cpos = Cpos + 1
CASE ENDKEY
'Zum Ende von s
Cpos = length
CASE HOME
'Zum Anfang von s
Cpos = 0
CASE DEL
IF (length > 0) AND (Cpos < length) THEN _
s = LEFT(s, Cpos) + RIGHT(s, length - Cpos - 1)
CASE BKSP
IF (length > 0) AND (Cpos > 0) THEN
s = LEFT(s, Cpos - 1) + RIGHT(s, (length - Cpos))
Cpos = Cpos - 1
END IF
CASE 32 TO 255
'druckbare Zeichen
IF length < Laenge THEN
s = LEFT(s, Cpos) + CHR(Key) + RIGHT(s, length - Cpos)
Cpos = Cpos + 1
END IF
END SELECT
Cursor(0)
LOCATE Zeile, Spalte: PRINT SPACE(Laenge + 1);
LOCATE Zeile, Spalte: PRINT s;
LOCATE Zeile, Spalte + Cpos: Cursor(1)
LOOP
'(Farben zuruecksetzen,) Text drucken und Ende
Cursor(0)
IF Mark THEN COLOR fore, back
LOCATE Zeile, Spalte: PRINT SPACE(Laenge + 1);
LOCATE Zeile, Spalte: PRINT s;
END SUB
SUB Edit(BYREF s AS STRING, Laenge AS INTEGER)
' Prozedur zum Editieren eines Strings mit Laengenbegrenzung und Vorbelegung
' (Ersatz fuer die INPUT-Anweisung). Beenden mit ENTER oder ESC
DIM AS INTEGER Zeile, Spalte, ExitCode
Zeile = CSRLIN
Spalte = POS
DO
LOCATE Zeile, Spalte
InString(s, Laenge, 1, ExitCode)
LOOP UNTIL ExitCode = ENTER OR ExitCode = ESC
PRINT 'neue Zeile
END SUB
SUB Edit(BYREF a AS DOUBLE)
' Eingabe einer Gleitkommazahl mit Vorbelegung
DIM AS STRING aStr
DIM AS INTEGER row, col, length
length = 25
row = CSRLIN
col = POS
IF a >= 0 THEN aStr = SPACE(1) + STR(a) ELSE aStr = STR(a)
Edit(aStr, length)
'Editierten String in Zahl umwandeln und zur Kontrolle anzeigen:
a = VAL(aStr)
LOCATE row, col: PRINT SPACE(length)
LOCATE row, col: PRINT a
END SUB
SUB Edit(BYREF k AS INTEGER)
' Editieren einer Ganzzahl mit Vorbelegung
DIM AS STRING kStr
DIM AS INTEGER row, col, length
length = 11
row = CSRLIN
col = POS
IF k >= 0 THEN kStr = SPACE(1) + STR(k) ELSE kStr = STR(k)
Edit(kStr, length)
'String in Zahl umwandeln und zur Kontrolle anzeigen:
k = VAL(kStr)
LOCATE row, col: PRINT SPACE(length)
LOCATE row, col: PRINT k
END SUB
SUB EditLst(s() AS STRING, Laenge AS INTEGER, n AS INTEGER, Mark AS INTEGER)
' Prozedur zum Editieren einer Variablenliste. Die obere linke Ecke des
' Eingabefeldes kann durch eine LOCATE-Anweisung festgelegt werden (gilt auch
' fuer die nachfolgenden Prozeduren).
' Parameter:
' - s(0) bis s(n) = Variablenliste
' - Laenge = maximale Eingabelaenge fuer jede Variable
' - Mark: Siehe SUB InString
' Verlassen der Prozedur erfolgt mit Esc.
DIM AS INTEGER Zeile, Spalte, i, ExitCode
Zeile = CSRLIN
Spalte = POS
FOR i = 0 TO n
LOCATE Zeile + i, Spalte: PRINT s(i)
NEXT i
i = 0
DO
LOCATE Zeile + i, Spalte
InString(s(i), Laenge, Mark, ExitCode)
SELECT CASE ExitCode
CASE UPARROW: IF i > 0 THEN i = i - 1 ELSE i = n
CASE DOWNARROW, ENTER: IF i < n THEN i = i + 1 ELSE i = 0
CASE ESC: EXIT DO
END SELECT
LOOP
END SUB
SUB EditTab(s() AS STRING, SpBreite() AS INTEGER, m AS INTEGER, n AS INTEGER, _
Mark AS INTEGER)
' Prozedur zum Editieren einer Tabelle.
' Parameter:
' - s(0, 0) bis s(m, n) = Variablen (Zeile 0 bis m, Spalte 0 bis n)
' - SpBreite(0) bis SpBreite(n) = Spaltenbreiten (maximale Eingabelaenge fuer
' jede Variable)
' - Mark: Siehe SUB InString
' Verlassen der Prozedur erfolgt mit Esc.
DIM AS INTEGER Zeile, Spalte, i, j, ExitCode
Zeile = CSRLIN
Spalte = POS
FOR i = 0 TO m
FOR j = 0 TO n
LOCATE Zeile + i, Spalte + j * SpBreite(j - 1): PRINT s(i, j)
NEXT j
NEXT i
i = 0
j = 0
DO
LOCATE Zeile + i, Spalte + j * SpBreite(j - 1)
InString(s(i, j), SpBreite(j), Mark, ExitCode)
SELECT CASE ExitCode
CASE ENTER
'Zeile fuer Zeile von einer Spalte zur naechsten:
IF j < n THEN
j = j + 1
ELSEIF i < m THEN
i = i + 1
j = 0
ELSE
i = 0
j = 0
END IF
CASE TABKEY: IF j < n THEN j = j + 1 ELSE j = 0
CASE SHIFT_TAB: IF j > 0 THEN j = j - 1 ELSE j = n
CASE UPARROW: IF i > 0 THEN i = i - 1 ELSE i = m
CASE DOWNARROW: IF i < m THEN i = i + 1 ELSE i = 0
CASE ESC: EXIT DO
END SELECT
LOOP
END SUB
SUB Eingabe(Maske() AS STRING, s() AS STRING, Laenge AS INTEGER, n AS INTEGER)
' Eingabemaske. Parameter:
' - Maske(0) bis Maske(n) = Eingabemaske (muessen alle gleich lang sein, z.B.
' mit Leerzeichen auffuellen).
' - s(0) bis s(n) = zu editierende Variablen
' - Laenge = maximale Eingabelaenge fuer s()
' Verlassen erfolgt mit ESC.
DIM AS INTEGER Zeile, Spalte, i, col, ExitCode
Zeile = CSRLIN
Spalte = POS
'Maske:
FOR i = 0 TO n
LOCATE Zeile + i, Spalte: PRINT Maske(i);
col = POS
NEXT i
'Variablen editieren:
LOCATE Zeile, col
EditLst(s(), Laenge, n, 1)
END SUB
SUB Auswahl(s() AS STRING, n AS INTEGER, BYREF sNr AS INTEGER)
' Auswahl-Liste (z.B. Menue). Parameter:
' - s(0) bis s(n) = Auswahl-Elemente, z.B. Menuepunkte (sollten alle gleich
' lang sein, z.B. mit Leerzeichen auffuellen)
' - sNr = Nummer des gewaehlten Elementes (z.B. Menuepunkt)
DIM AS INTEGER Zeile, Spalte, fore, back, i, key
Zeile = CSRLIN
Spalte = POS
fore = LOWORD(COLOR)
back = HIWORD(COLOR)
'Auswahlliste:
FOR i = 0 TO n
LOCATE Zeile + i, Spalte, 0: PRINT s(i) 'Cursor aus
NEXT i
i = 0
DO
'aktuelles Element hervorheben:
IF back = 7 THEN COLOR 7, 0 ELSE COLOR 0, 7
LOCATE Zeile + i, Spalte: PRINT s(i);
COLOR fore, back
'Tastendruck abwarten und auswerten:
key = GETKEY
SELECT CASE key
CASE UPARROW
LOCATE Zeile + i, Spalte: PRINT s(i)
IF i > 0 THEN i = i - 1 ELSE i = n
CASE DOWNARROW
LOCATE Zeile + i, Spalte: PRINT s(i)
IF i < n THEN i = i + 1 ELSE i = 0
CASE ENTER
'Element ist ausgewaehlt: Invertierung zuruecksetzen und Ende
sNr = i
IF back = 7 THEN COLOR 7, 0 ELSE COLOR 0, 7
LOCATE Zeile + SNr, Spalte, 1: PRINT s(SNr); 'Cursor wieder ein
COLOR fore, back
EXIT DO
END SELECT
LOOP
END SUB