home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / sonderh1 / dffunk.inc < prev    next >
Encoding:
Text File  |  1987-06-10  |  3.9 KB  |  119 lines
  1. (*-------------------------------------------------------------------------*)
  2. (*                             DFFUNK.INC                                  *)
  3. (*              Modul zur Definition von Funktionstasten                   *)
  4.  
  5. OVERLAY PROCEDURE Funktionstasten;
  6.  
  7. CONST BACKSPACE = #8;     (* <--- Muss ggf. angepasst werden. Auf manchen *)
  8.                           (*      Rechner hat das Zeichen fuer den Rueck- *)
  9.                           (*      waertsschritt die Nummer 127 .          *)
  10.  
  11. VAR i, Zeichenzaehler : INTEGER;
  12.     Wahl, Zeichen     : CHAR;
  13.     Name, String1     : String255;
  14.     Fehler            : BOOLEAN;
  15.     f                 : FILE OF FunkStr;
  16.  
  17.  
  18. BEGIN
  19.   ClearKeyBuf;
  20.   ClrScr;
  21.   WriteLn(inv_ein,'FUNKTIONSTASTEN',inv_aus);
  22.   WriteLn;
  23.   WriteLn('Sie koennen 6 Funktionstasten belegen (Ctrl-A .. Ctrl-F)');
  24.   WriteLn('Erlaubt sind alle alphanumerischen Zeichen. ');
  25.   WriteLn('BACKSPACE (Ctrl-H) loescht das zuletzt eingegebene Zeichen.');
  26.   WriteLn('ENTER schliesst eine Zeile ab.');
  27.   WriteLn('Jeder String darf max. 40 Zeichen haben.');
  28.   WriteLn; WriteLn; WriteLn;
  29.  
  30.   (* Funktionstasten aus einer Datei einlesen *)
  31.   REPEAT
  32.     Write(' Funktionstastendefinition aus Datei einlesen ? (j/n) ');
  33.     ReadLn(Wahl)
  34.   UNTIL Wahl IN ['j','J','n','N'];
  35.   IF Wahl IN ['j','J'] THEN BEGIN
  36.     Fehler := TRUE;
  37.     REPEAT
  38.       Write(' Name der Datei (Abbruch mit leerer Eingabe) : ');
  39.       ReadLn(Name);
  40.       IF Length(Name) > 0 THEN BEGIN
  41.         Assign(f,Name);
  42. (*$I-*)
  43.         ReSet(f);
  44. (*$I+*)
  45.         Fehler := IOFehler
  46.       END
  47.     UNTIL (NOT Fehler) OR (Length(Name) = 0);
  48.     IF NOT Fehler THEN BEGIN
  49.       FOR i := 1 TO 6 DO
  50.         Read(f,FunkText[i]);
  51.       Close(f)
  52.     END
  53.   END;
  54.  
  55.   (* Funktionstasten definieren *)
  56.   IF (Length(Name) = 0) OR Fehler OR (Wahl IN ['n','N']) THEN BEGIN
  57.     FOR i := 1 TO 6 DO BEGIN
  58.       String1 := '';
  59.       GotoXY(2,12 + i);
  60.       Zeichenzaehler := 0;
  61.       Write('Funktionstaste Ctrl-',Chr(Pred(i) + Ord('A')):1,' --> ');
  62.       GotoXY(28,12 + i);
  63.       REPEAT
  64.         GotoXY(50,1); (* Oben rechts Zeichenzaehlerstand ausgeben *)
  65.         Write('Zeichen insg.: ',Zeichenzaehler:3);
  66.         GotoXY(28 + Zeichenzaehler,13 + i);
  67.         REPEAT
  68.            Zeichen := GetKey
  69.         UNTIL Zeichen IN [BACKSPACE,' '..'~',RETURN];
  70.         IF Zeichen = BACKSPACE THEN         (* Hinterstes Zeichen loeschen *)
  71.           IF Length(String1) > 0 THEN BEGIN
  72.             String1 := Copy(String1, 1, Pred(Length(String1)));
  73.             Zeichenzaehler := Pred(Zeichenzaehler)
  74.           END;
  75.         IF Zeichen IN [' '..'~'] THEN BEGIN  (* Ein Zeichen anhaengen *)
  76.           String1 := Concat(String1,Zeichen);
  77.           Zeichenzaehler := Succ(Zeichenzaehler)
  78.         END;
  79.         GotoXY(28,12 + i);
  80.         Write(String1);   (* String ausgeben und ggf.             *)
  81.         ClrEol            (* den Rest bis zum Zeilenende loeschen *)
  82.       UNTIL Zeichen = RETURN;
  83.       FunkText[i] := String1
  84.     END;
  85.  
  86.     (* Funktionstastendefinition abspeichern *)
  87.     GotoXY(1,20);
  88.     REPEAT
  89.       Write(' Funktionstastendefinition abspeichern ? (j/n) ');
  90.       ReadLn(Wahl)
  91.     UNTIL Wahl IN ['j','J','n','N'];
  92.     IF Wahl IN ['j','J'] THEN BEGIN
  93.       Fehler := TRUE;
  94.       REPEAT
  95.         Write(' Name der Datei (Abbruch mit leerer Eingabe) : ');
  96.         ReadLn(Name);
  97.         IF Length(Name) > 0 THEN BEGIN
  98.           Assign(f,Name);
  99. (*$I-*)
  100.           ReWrite(f);
  101. (*$I+*)
  102.           Fehler := IOFehler
  103.         END
  104.       UNTIL (NOT Fehler) OR (Length(Name) = 0);
  105.       IF NOT Fehler THEN BEGIN
  106.         FOR i := 1 TO 6 DO
  107.           Write(f,FunkText[i]);
  108. (*$I-*)
  109.         Close(f);
  110. (*$I+*)
  111.         Fehler := IOFehler   (* Close ist hoffentlich gutgegangen *)
  112.       END
  113.     END
  114.   END
  115. END;
  116.  
  117. (*-------------------------------------------------------------------------*)
  118. (*                           Ende DFFUNK.INC                               *)
  119.