home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 09 / tricks / datwahl.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-06-09  |  5.1 KB  |  183 lines
  1. (* ------------------------------------------------------ *)
  2. (*                    DATWAHL.PAS                         *)
  3. (* Dateiwahl mit Cursortasten unter Turbo Pascal 4.0/5.x  *)
  4. (*      (c) 1988, 1989  M.Köthe, R.Geier & TOOLBOX        *)
  5. (* ------------------------------------------------------ *)
  6. PROGRAM Dateiwahl;
  7.  
  8. USES Crt, Dos;
  9.  
  10. CONST  Blau = 1;  Weiss = 15;  Gelb = 14;
  11.  
  12. TYPE   DosName = STRING[64];
  13.        DatName = STRING[12];
  14.  
  15. VAR    Eingabe : DosName;
  16.        Ausgabe : DatName;
  17.        ErrCode : INTEGER;
  18.  
  19. (* ------------------------------------------------------ *)
  20.   PROCEDURE DateiAuswahl(Maske : DosName;
  21.                   VAR AusDatei : DatName; Fehler : INTEGER);
  22.   VAR
  23.     D                 : SearchRec;
  24.     Chw, i            : INTEGER;
  25.     Ch                : CHAR;
  26.     Datei             : ARRAY [1..100] OF STRING[12];
  27.     Anzahl,   Wahl,
  28.     Waag,     Senk,
  29.     LastWaag, MaxSenk : INTEGER;
  30.  
  31.     PROCEDURE CursorOff;
  32.     BEGIN
  33.       GotoXY(1,4);
  34.       Mem[$b800:$01e0] := 32;  Mem[$b800:$01e1] := 0;
  35.     END;
  36.  
  37.     PROCEDURE Invers;
  38.     BEGIN
  39.       TextColor(Blau);  TextBackGround(Weiss);
  40.       GotoXY(Waag, Senk);  Write(Datei[Wahl]);  CursorOff;
  41.       TextColor(Gelb);  TextBackGround(Blau);
  42.     END;
  43.  
  44.     PROCEDURE Normal;
  45.     BEGIN
  46.       GotoXY(Waag, Senk);  Write(Datei[Wahl]);  CursorOff;
  47.     END;
  48.  
  49.     PROCEDURE Cursor_Rechts;
  50.     BEGIN
  51.       Normal;
  52.       IF Succ(Wahl) <= Anzahl THEN BEGIN
  53.         Inc(Wahl);
  54.         Inc(Waag, 15);
  55.                       { nächster Eintrag in gleicher Zeile }
  56.         IF (Waag > 64) THEN BEGIN
  57.           Waag := 4;
  58.           Inc(Senk);   { erster Eintrag in nächster Zeile  }
  59.         END;
  60.       END ELSE BEGIN
  61.         Wahl := 1;  Waag := 4;
  62.         Senk := 5;     { erster Eintrag in erster Zeile    }
  63.       END;
  64.       Invers;
  65.     END;
  66.  
  67.     PROCEDURE Cursor_Links;
  68.     BEGIN
  69.       Normal;
  70.       IF Pred(Wahl) > 0 THEN BEGIN
  71.         Dec(Wahl);
  72.         Dec(Waag, 15); { voriger Eintrag in gleicher Zeile }
  73.         IF (Waag < 4) THEN BEGIN
  74.           Waag := 64;
  75.           Dec(Senk);   { letzter Eintrag in voriger Zeile  }
  76.         END;
  77.       END ELSE BEGIN
  78.         Wahl := Anzahl;  Waag := LastWaag;
  79.         Senk := MaxSenk;
  80.                        { letzter Eintrag in letzter Zeile  }
  81.       END;
  82.       Invers;
  83.     END;
  84.  
  85.     PROCEDURE Cursor_auf;
  86.     BEGIN
  87.       Normal;
  88.       IF (Wahl-5) >= 1 THEN BEGIN
  89.         Dec(Wahl, 5);
  90.         Dec(Senk);     { Eintrag in der vorigen Zeile      }
  91.       END ELSE BEGIN
  92.         IF LastWaag < Waag THEN BEGIN
  93.           Wahl := Anzahl;  Waag := LastWaag;
  94.           Senk := MaxSenk;
  95.                        { letzter Eintrag in letzter Zeile  }
  96.         END ELSE BEGIN
  97.           Wahl := Wahl + (MaxSenk - Senk) * 5;
  98.           Senk := MaxSenk;
  99.                        { gleicher Eintrag in letzter Zeile }
  100.         END;
  101.       END;
  102.       Invers;
  103.     END;
  104.  
  105.     PROCEDURE Cursor_ab;
  106.     BEGIN
  107.       Normal;
  108.       IF (Wahl+5) <= Anzahl THEN BEGIN
  109.         Inc(Wahl, 5);
  110.         Inc(Senk);    { gleicher Eintrag in nächster Zeile }
  111.       END ELSE BEGIN
  112.         Wahl := Wahl - (Senk - 5) * 5;
  113.         Senk := 5;    { gleicher Eintrag in erster Zeile   }
  114.       END;
  115.       Invers;
  116.     END;
  117.  
  118.   BEGIN
  119.     ClrScr;
  120.     Anzahl := 0;
  121.     Waag := 4;  Senk := 5;
  122.     FindFirst(Maske, Archive, D);
  123.     IF (DosError <> 0) THEN BEGIN      { Fehler beim Laden }
  124.       GotoXY(20,12);
  125.       Write(Chr(7), 'Directory oder Datei nicht gefunden');
  126.       CursorOff;  Delay(2000);  ClrScr;
  127.       Wahl := 0;
  128.       Exit;
  129.     END;
  130.     WHILE (DosError = 0) AND (Anzahl < 100) DO BEGIN
  131.       Inc(Anzahl);
  132.       Datei[Anzahl] := D.Name;
  133.       FindNext(D);
  134.     END;
  135.  
  136.     Window(1, 1, 80, 3);
  137.     TextBackground(Blau);  TextColor(Gelb);  ClrScr;
  138.     GotoXY(33,2);  Write('Dateiauswahl');
  139.     Window(1, 1, 80, 25);
  140.     FOR i := 1 TO Anzahl DO BEGIN
  141.       GotoXY(Waag, Senk);
  142.       Write(Datei[i]);
  143.       Inc(Waag, 15);
  144.       IF (Waag > 66) THEN BEGIN
  145.         Waag := 4;  Inc(Senk);
  146.       END;
  147.       MaxSenk := Senk;  LastWaag := Waag - 15;
  148.     END;
  149.     Waag := 4;  Senk := 5;  Wahl := 1;  Invers;
  150.  
  151.     REPEAT
  152.       Ch := ReadKey;
  153.       IF (Ch = #0) THEN BEGIN
  154.         Ch := ReadKey;  Chw := Ord(Ch);
  155.         CASE Chw OF
  156.           77 : Cursor_rechts;
  157.           75 : Cursor_links;
  158.           80 : Cursor_ab;
  159.           72 : Cursor_auf;
  160.         END;
  161.       END;
  162.     UNTIL (Ch = #13) OR (Ch = #27);
  163.     IF (Ch = #13) THEN AusDatei := Datei[Wahl]
  164.                   ELSE AusDatei := 'Auswahl abgebrochen';
  165.     Fehler := DosError;
  166.     ClrScr;
  167.   END;
  168.  
  169. BEGIN
  170.   TextBackGround(Blau);  TextColor(Gelb);  ClrScr;
  171.   WriteLn('Bitte die Suchmaske eingeben: ');
  172.   ReadLn(Eingabe);
  173.   DateiAuswahl(Eingabe, Ausgabe, ErrCode);
  174.   TextBackGround(Weiss);  TextColor(Blau);  ClrScr;
  175.   Write('Die gewählte Datei ist: ');
  176.   WriteLn(Ausgabe);
  177.   Write('DOS-Fehlercode: ');
  178.   WriteLn(ErrCode);
  179.   TextBackGround(Blau);  TextColor(Gelb);
  180. END.
  181. (* ------------------------------------------------------ *)
  182. (*               Ende von DATWAHL.PAS                     *)
  183.