home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 10 / tricks / datwahl.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-07-08  |  11.1 KB  |  354 lines
  1. (* ------------------------------------------------------ *)
  2. (*                      DATWAHL.PAS                       *)
  3. (*              Turbo-Dateiwahl nachempfunden             *)
  4. (*          (c)  1990 Alexander Sunder & TOOLBOX          *)
  5. (* ------------------------------------------------------ *)
  6. UNIT DatWahl;
  7.  
  8. INTERFACE
  9.  
  10. USES
  11.   Crt, Dos;
  12.  
  13. CONST
  14.   StdName      = '*';
  15.   StdExt       = '*';
  16.   MaxEintraege = 165;
  17.   BoxColor     = $70;       { Werte für monochrome Text-   }
  18.   ChoseColor   = $18;       { darstellung: invers und hell }
  19.  
  20. TYPE
  21.   TDrive = STRING [1];
  22.   TDir   = STRING [67];
  23.   TName  = STRING [8];
  24.   TExten = STRING [3];
  25.  
  26.  
  27.   PROCEDURE UpString(VAR St : STRING);
  28.  
  29.   PROCEDURE Rahmen(X1, Y1, X2, Y2 : BYTE);
  30.  
  31.   PROCEDURE CompleteFileName(Name      : STRING;
  32.                              VAR Drive : TDrive;
  33.                              VAR Dir   : TDir;
  34.                              VAR FName : TName;
  35.                              VAR Ext   : TExten);
  36.  
  37.   PROCEDURE DateiWahl(x, y : BYTE; VAR Name : STRING);
  38.  
  39.  
  40. IMPLEMENTATION
  41.  
  42.   PROCEDURE UpString;
  43.   VAR
  44.     i : BYTE;
  45.   BEGIN
  46.     FOR i := 1 TO Length(St) DO
  47.       IF St[i] IN ['ä', 'ö', 'ü'] THEN
  48.         CASE St[i] OF
  49.           'ä' : St[i] := 'Ä';
  50.           'ö' : St[i] := 'Ö';
  51.           'ü' : St[i] := 'Ü';
  52.         END
  53.       ELSE
  54.         St[i] := UpCase(St[i]);
  55.   END;
  56.  
  57.   PROCEDURE CompleteFileName;
  58.   VAR
  59.     HDir         : TDir;
  60.     i            : BYTE;
  61.     ExtVorhanden : BOOLEAN;
  62.   BEGIN
  63.     Dir := '';  FName := StdName;  Ext := StdExt;
  64.     ExtVorhanden := FALSE;
  65.     IF (Length(Name) > 1) AND (Name[2] = ':') THEN BEGIN
  66.       Drive := Name[1];
  67.       Name  := Copy(Name, 3, Length(Name) - 2);
  68.     END ELSE BEGIN
  69.       GetDir(0, HDir);
  70.       Drive := HDir[1];
  71.     END;
  72.     i := Pos('.',Name);
  73.     IF (Length(Name) > 1) AND (i <> 0) THEN BEGIN
  74.       Ext  := Copy(Name, i + 1, Length(Name) - i);
  75.       Name := Copy(Name, 1, i - 1);
  76.       ExtVorhanden := TRUE;
  77.     END;
  78.     IF Length(Name) > 0 THEN BEGIN
  79.       i := Length(Name);
  80.       WHILE (Name[i] <> '\') and (i > 1) DO Dec(i);
  81.       IF Name[i] <> '\' THEN
  82.         FName := Name
  83.       ELSE
  84.         IF ExtVorhanden THEN BEGIN
  85.           FName := Copy(Name, i + 1, Length(Name) - i);
  86.           Dir   := Copy(Name, 1, i)
  87.         END ELSE
  88.           Dir   := Name;
  89.     END;
  90.     IF (Dir = '') OR (Dir[1] <> '\') THEN BEGIN
  91.       GetDir(Ord(Drive[1]) - 64, HDir);
  92.       HDir := Copy(HDir, 3, Length(HDir) - 2);
  93.       IF Dir = '' THEN Dir := HDir
  94.                   ELSE Dir := HDir + '\' + Dir;
  95.     END;
  96.     IF Dir[Length(Dir)] <> '\' THEN Dir := Dir + '\'
  97.   END;
  98.  
  99.   PROCEDURE Rahmen;
  100.   VAR
  101.     I : BYTE;
  102.   BEGIN
  103.     GotoXY(X1, Y1);  Write(#218);
  104.     FOR i := X1 + 1 TO X2 - 1 DO Write(#196);
  105.     Write(#191);
  106.     FOR i := Y1 + 1 TO Y2 - 1 DO BEGIN
  107.       GotoXY(X1, i);  Write(#179);
  108.       GotoXY(X2, i);  Write(#179);
  109.     END;
  110.     GotoXY(X1, Y2);  Write(#192);
  111.     FOR i := X1 + 1 TO X2 - 1 DO Write(#196);
  112.     Write(#217);
  113.   END;
  114.  
  115.   PROCEDURE DateiWahl;
  116.   TYPE
  117.     string12   = STRING[12];
  118.   VAR
  119.     DirNamen         : ARRAY [1..MaxEintraege] OF string12;
  120.     Anzahl,i         : WORD;
  121.     Drive            : TDrive;
  122.     Dir,OldDir       : TDir;
  123.     FName            : TName;
  124.     Ext              : TExten;
  125.     OldX, OldY, Attr : BYTE;
  126.     ScreenBase       : WORD;
  127.     ScreenBuffer     : ARRAY [0..3999] OF BYTE;
  128.  
  129.     PROCEDURE DirNamenSortieren(Links, Rechts : WORD);
  130.     VAR
  131.       L, R                : WORD;
  132.       Vergleich, Speicher : string12;
  133.     BEGIN
  134.       L := Links;  R := Rechts ;
  135.       Vergleich := DirNamen[(Links + Rechts) DIV 2];
  136.       REPEAT
  137.         WHILE DirNamen[L] < Vergleich DO L := L + 1;
  138.         WHILE DirNamen[R] > Vergleich DO R := R - 1;
  139.         IF L <= R THEN BEGIN
  140.           Speicher    := DirNamen[L];
  141.           DirNamen[L] := DirNamen[R];
  142.           DirNamen[R] := Speicher;
  143.           L := L + 1;  R := R - 1;
  144.         END;
  145.       UNTIL L > R;
  146.       IF R > Links  THEN DirNamenSortieren(Links, R);
  147.       IF L < Rechts THEN DirNamenSortieren(L, Rechts);
  148.     END;
  149.  
  150.     FUNCTION DateiListeErstellen(Name : STRING) : WORD;
  151.     VAR
  152.       DirInfo   : SearchRec;
  153.       I, Anzahl : WORD;
  154.     BEGIN
  155.       Anzahl := 0;
  156.       FindFirst(Name, AnyFile, DirInfo);
  157.       WHILE (DOSError = 0) AND
  158.             (Anzahl < MaxEintraege - 15) DO BEGIN
  159.         IF DirInfo.Attr = Archive THEN BEGIN
  160.           Inc(Anzahl);
  161.           DirNamen[Anzahl] := DirInfo.Name;
  162.         END;
  163.         FindNext(DirInfo);
  164.       END;
  165.       IF (Anzahl > 0) OR (DOSError IN [0,2,18]) THEN BEGIN
  166.         FindFirst(Drive+':'+ Dir + '*.*', AnyFile, DirInfo);
  167.         WHILE (DOSError = 0) AND
  168.               (Anzahl < MaxEintraege) DO BEGIN
  169.           IF (DirInfo.Attr = Directory) AND
  170.              (DirInfo.Name <> '.') THEN BEGIN
  171.             Inc(Anzahl);
  172.             IF DirInfo.Name = '..' THEN
  173.               DirInfo.Name := #255 + DirInfo.Name;
  174.             DirNamen[Anzahl] := '\' + DirInfo.Name
  175.           END;
  176.           FindNext(DirInfo);
  177.         END;
  178.         IF Anzahl > 0 THEN BEGIN
  179.           DirNamenSortieren(1, Anzahl);
  180.           FOR i := 1 TO Anzahl DO BEGIN
  181.             IF Copy(DirNamen[i], 1, 1) = '\' THEN
  182.               DirNamen[i] := Copy(DirNamen[i], 2,
  183.                              Length(DirNamen[i]) - 1) + '\';
  184.             IF Copy(DirNamen[i], 1, 1) = #255 THEN
  185.               DirNamen[i] := Copy(DirNamen[i], 2, 3);
  186.           END;
  187.         END;
  188.       END;
  189.       DateiListeErstellen := Anzahl;
  190.     END;
  191.  
  192.     PROCEDURE DateiAuswahl(VAR Name : STRING);
  193.     VAR
  194.       ch                     : CHAR;
  195.       ErsteZeile, BildIndex  : INTEGER;
  196.  
  197.       PROCEDURE DateiAusgabe(Index, Zeile : BYTE);
  198.       BEGIN
  199.         GotoXY(x + 1 + ((Index - 1) MOD 4) * 15,
  200.                y + 1 +  (Index - 1) DIV 4);
  201.         Write(' ', DirNamen[Index + Zeile * 4],
  202.               ' ':13 - Length(DirNamen[Index + Zeile * 4]));
  203.       END;
  204.  
  205.       PROCEDURE Aufbau(Zeile : BYTE);
  206.       VAR
  207.         i : BYTE;
  208.       BEGIN
  209.         GotoXY(X + 1, Y); FOR I := 1 TO 59 DO Write(#196);
  210.         GotoXY(x + (60 - Length(' ' + Name + ' ')) DIV 2, y);
  211.         Write(' ' + Name + ' ');
  212.         TextAttr := BoxColor;  i := 1;
  213.         WHILE i < 37 DO BEGIN
  214.           IF Zeile * 4 + i <= Anzahl THEN
  215.             DateiAusgabe(i, Zeile)
  216.           ELSE BEGIN
  217.             GotoXY(x + 1 + ((i - 1) MOD 4) * 15,
  218.                    y + 1 +  (i - 1) DIV 4);
  219.             Write(' ':14);
  220.           END;
  221.           Inc(i);
  222.         END;
  223.       END;
  224.  
  225.     BEGIN
  226.       ErsteZeile := 0;   BildIndex := 1;
  227.       Aufbau(ErsteZeile);
  228.       TextAttr := ChoseColor;
  229.       DateiAusgabe(BildIndex, ErsteZeile);
  230.       REPEAT
  231.         ch := ReadKey;
  232.         IF ch = #0 THEN BEGIN
  233.           ch := ReadKey;
  234.           IF ch IN [#71..#73, #75, #77, #79..#81] THEN BEGIN
  235.             TextAttr := BoxColor;
  236.             DateiAusgabe(BildIndex, ErsteZeile);
  237.             CASE ch OF
  238. {Home}        #71: BEGIN
  239.                      ErsteZeile := 0;  BildIndex := 1;
  240.                      Aufbau(ErsteZeile);
  241.                    END;
  242. {UpArrow}     #72: IF ErsteZeile * 4 +
  243.                       BildIndex > 4 THEN BEGIN
  244.                      IF BildIndex - 4 <= 0 THEN BEGIN
  245.                        Dec(ErsteZeile);
  246.                        Aufbau(ErsteZeile);
  247.                      END ELSE
  248.                        Dec(BildIndex, 4);
  249.                    END;
  250. {PageUp}      #73: BEGIN
  251.                      IF (ErsteZeile - 9) * 4 + 1 > 0 THEN
  252.                        Dec(ErsteZeile, 9)
  253.                      ELSE BEGIN
  254.                        ErsteZeile := 0;
  255.                        BildIndex  := 1 + (BildIndex-1) MOD 4;
  256.                      END;
  257.                      Aufbau(ErsteZeile);
  258.                    END;
  259. {LeftArrow}   #75: IF ErsteZeile*4 + BildIndex > 1 THEN BEGIN
  260.                      Dec(BildIndex);
  261.                      IF BildIndex = 0 THEN BEGIN
  262.                        Dec(ErsteZeile);  BildIndex := 4;
  263.                        Aufbau(ErsteZeile);
  264.                      END;
  265.                    END;
  266. {RightArrow}  #77: IF ErsteZeile*4 +
  267.                        BildIndex < Anzahl THEN BEGIN
  268.                      Inc(BildIndex);
  269.                      IF BildIndex = 37 THEN BEGIN
  270.                        Inc(ErsteZeile); BildIndex := 33;
  271.                        Aufbau(ErsteZeile);
  272.                      END;
  273.                    END;
  274. {END}         #79: BEGIN
  275.                      IF (Anzahl < ErsteZeile * 4 - 1) OR
  276.                         (Anzahl > ErsteZeile * 4 + 34)
  277.                      THEN BEGIN
  278.                        ErsteZeile := ((Anzahl - 1) DIV 4) -8;
  279.                        Aufbau(ErsteZeile)
  280.                      END;
  281.                      BildIndex := Anzahl - ErsteZeile * 4;
  282.                    END;
  283. {DownArrow}   #80: BEGIN
  284.                      IF ErsteZeile*4+BildIndex+4 <= Anzahl
  285.                      THEN Inc(BildIndex,4)
  286.                      ELSE BildIndex := Anzahl-ErsteZeile*4;
  287.                      IF BildIndex > 36 THEN BEGIN
  288.                        Inc(ErsteZeile); Dec(BildIndex,4);
  289.                        Aufbau(ErsteZeile);
  290.                      END;
  291.                    END;
  292. {PageDOwn}    #81: IF(ErsteZeile+9)*4+1 <= Anzahl THEN BEGIN
  293.                      Inc(ErsteZeile, 9);
  294.                      Aufbau(ErsteZeile);
  295.                      IF ErsteZeile*4+BildIndex > Anzahl THEN
  296.                        BildIndex := Anzahl - ErsteZeile * 4
  297.                    END ELSE
  298.                      BildIndex := Anzahl - ErsteZeile * 4;
  299.             END;
  300.             TextAttr := ChoseColor;
  301.             DateiAusgabe(BildIndex, ErsteZeile);
  302.           END;
  303.         END;
  304.       UNTIL ch IN [#13, #27];
  305.       TextAttr := BoxColor;
  306.       DateiAusgabe(BildIndex, ErsteZeile);
  307.       IF ch = #13 THEN
  308.         Name := DirNamen[ErsteZeile * 4 + BildIndex]
  309.       ELSE Name := '';
  310.     END;
  311.  
  312.   BEGIN
  313.     OldX := WhereX;  OldY := WhereY;  Attr:=TextAttr;
  314.     IF Mem[$40:$49]=7 THEN ScreenBase := $B000
  315.                       ELSE ScreenBase := $B800;
  316.     Move(Mem[ScreenBase:0000], ScreenBuffer, 4000);
  317.     GetDir(0, OldDir);
  318.     UpString(Name);
  319.     CompleteFileName(Name, Drive, Dir, FName, Ext);
  320.     TextAttr := BoxColor;
  321.     Rahmen(x, y, x+60, y+10);
  322.     Window(x+1, y+1, x+59, y+9);
  323.     ClrScr;
  324.     Window(1, 1, 80, 25);
  325.     REPEAT
  326.       Name := Drive + ':' + Dir + FName + '.' + Ext;
  327.       Anzahl := DateiListeErstellen(Name);
  328.       IF Anzahl = 0 THEN BEGIN
  329.         Name := '';  Write(#7);
  330.       END ELSE BEGIN
  331.         DateiAuswahl(Name);
  332.         IF Name[Length(Name)] = '\' THEN BEGIN
  333.           IF (Name[1] <> '.') THEN
  334.             Dir := Dir + Name
  335.           ELSE BEGIN
  336.             i := Length(Dir) - 1;
  337.             WHILE (i > 0) AND (Dir[i] <> '\') DO Dec(i);
  338.             IF i > 0 THEN Dir := Copy(Dir, 1, i);
  339.           END;
  340.         END;
  341.       END;
  342.     UNTIL (Name = '') OR (Name[Length(Name)] <> '\');
  343.     IF Name <> '' THEN
  344.       Name := Drive + ':' + Dir + Name;
  345.     Move(ScreenBuffer, Mem[ScreenBase:0000], 4000);
  346.     TextAttr := Attr;   GotoXY(OldX, OldY);
  347.     ChDir(OldDir);
  348.   END;
  349.  
  350. BEGIN
  351. END.
  352. (* ------------------------------------------------------ *)
  353. (*                  Ende von DATWAHL.PAS                  *)
  354.