home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1991 / 03 / bonus / boxerg.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-02-06  |  9.6 KB  |  316 lines
  1. (* ------------------------------------------------------ *)
  2. (*                      BOXERG.PAS                        *)
  3. (*             Turbo-Pascal-Unit für BOX.PAS              *)
  4. (*         (c) 1991 Achim Bergmeister & TOOLBOX           *)
  5. (* ------------------------------------------------------ *)
  6. UNIT BoxErg;
  7.  
  8. INTERFACE
  9.  
  10. USES Dos,Crt;
  11.  
  12. TYPE s12 = STRING[12];
  13.      s80 = STRING[80];
  14.      Schirm   = ARRAY [1..25,1..80] OF
  15.                 RECORD ch: CHAR; Attr: BYTE; END;
  16.  
  17. VAR  Screen: Schirm ABSOLUTE $B800:0;
  18.      SMem  : Schirm;
  19.  
  20. PROCEDURE Invers;
  21. PROCEDURE Normal;
  22. PROCEDURE Print (x,y: INTEGER; s: s80);
  23. PROCEDURE PrintF (x,y: INTEGER; s: s80);
  24. PROCEDURE Rahmen (x1,y1,x2,y2,Art: INTEGER);
  25. PROCEDURE GetCode (VAR Code: INTEGER);
  26. PROCEDURE WrtXY (x,y: BYTE; s: s80);
  27. PROCEDURE CursorDick;
  28. PROCEDURE CursorNormal;
  29. PROCEDURE CursorAus;
  30. PROCEDURE HoleDatei (x1,y1,Laenge: INTEGER; VAR WahlDatei: s12);
  31.  
  32. IMPLEMENTATION
  33.  
  34. PROCEDURE GetCode (VAR Code: INTEGER);
  35. VAR ch : CHAR;
  36. BEGIN
  37.   ch := ReadKey;
  38.   IF ch = #0 THEN Code := (Ord(ReadKey)+1000)
  39.   ELSE Code := Ord(ch);
  40. END;
  41.  
  42. PROCEDURE WrtXY (x,y: BYTE; s: s80);
  43. VAR i: BYTE;
  44. BEGIN
  45.   Dec (x);
  46.   FOR i := 1 TO Length(s) DO
  47.   BEGIN
  48.     Screen [y,x+i].ch := s[i];
  49.     Screen [y,x+i].Attr := TextAttr;
  50.   END;
  51. END;
  52.  
  53. PROCEDURE Rahmen (x1,y1,x2,y2,Art: INTEGER);
  54. VAR i: BYTE; k: STRING[8];
  55. BEGIN
  56.   CASE Art OF
  57.     1 : k := #218#191#192#217#196#196#179#179;
  58.     2 : k := #201#187#200#188#205#205#186#186;
  59.     3 : k := #218#220#192#219#196#220#179#219;
  60.   END;
  61.   Window (x1,y1,x2,y2); ClrScr; Window (1,1,80,25);
  62.   WrtXY (x1,y1,k[1]); WrtXY (x2,y1,k[2]);
  63.   WrtXY (x1,y2,k[3]); WrtXY (x2,y2,k[4]);
  64.   FOR i := x1+1 TO x2-1 DO
  65.   BEGIN WrtXY (i,y1,k[5]); WrtXY (i,y2,k[6]); END;
  66.   FOR i := y1+1 TO y2-1 DO
  67.   BEGIN WrtXY (x1,i,k[7]); WrtXY (x2,i,k[8]); END;
  68. END;
  69.  
  70. PROCEDURE CursorSetzen (Anfang,Ende: INTEGER);
  71. VAR r: Registers;
  72. BEGIN
  73.   r.AH := 1; r.ch := Anfang;
  74.   r.CL := Ende; Intr ($10,r);
  75. END;
  76.  
  77. PROCEDURE CursorDick;   BEGIN CursorSetzen (4,10);  END;
  78. PROCEDURE CursorNormal; BEGIN CursorSetzen (11,12); END;
  79. PROCEDURE CursorAus;    BEGIN CursorSetzen (-1,-1);   END;
  80.  
  81. PROCEDURE Invers; BEGIN TextAttr := 112; END;
  82. PROCEDURE Normal; BEGIN TextAttr := 7;   END;
  83.  
  84. PROCEDURE Print (x,y: INTEGER; s: s80);
  85. BEGIN GotoXY (x,y); Write (s); END;
  86.  
  87. PROCEDURE PrintF (x,y: INTEGER; s: s80);
  88. BEGIN Invers; GotoXY (x,y); Write (s); Normal; END;
  89.  
  90. TYPE s30    = STRING[30];
  91.      Zeilen = ARRAY [1..200] OF s30;
  92.  
  93. VAR BZeile,DatZeile,Zaehler,j,i,Max,Code : INTEGER;
  94.     Zeile    : Zeilen;
  95.     Pfad     : PathStr;
  96.     ch       : CHAR;
  97.     Dat      : s12;
  98.     Gewaehlt : BOOLEAN;
  99.  
  100. PROCEDURE HoleDatei (x1,y1,Laenge: INTEGER; VAR WahlDatei: s12);
  101.  
  102.    PROCEDURE Down;
  103.    BEGIN
  104.      IF DatZeile < Zaehler THEN
  105.      BEGIN
  106.        Print (1,BZeile,Zeile[DatZeile]);
  107.        IF BZeile < Laenge THEN
  108.        BEGIN
  109.          Inc(DatZeile); Inc(BZeile);
  110.          PrintF (1,BZeile,Zeile[DatZeile]);
  111.        END
  112.        ELSE BEGIN
  113.          Print (1,BZeile,Zeile[DatZeile]);
  114.          Inc(DatZeile); WriteLn;
  115.          PrintF (1,BZeile,Zeile[DatZeile]);
  116.        END;
  117.      END ELSE Write (^G);
  118.    END;
  119.  
  120.    PROCEDURE Up;
  121.    BEGIN
  122.      IF DatZeile > 1 THEN
  123.      BEGIN
  124.        IF BZeile >  1 THEN
  125.        BEGIN
  126.          Print (1,BZeile,Zeile[DatZeile]);
  127.          Dec(DatZeile); Dec(BZeile);
  128.          PrintF (1,BZeile,Zeile[DatZeile]);
  129.        END
  130.        ELSE BEGIN
  131.          Print (1,1,Zeile[DatZeile]); Dec(DatZeile);
  132.          GotoXY (1,1); InsLine;
  133.          PrintF (1,1,Zeile[DatZeile]);
  134.        END;
  135.      END ELSE Write (^G);
  136.    END;
  137.  
  138.    PROCEDURE DDir (VAR Zeile:Zeilen; VAR Zaehler:INTEGER;
  139.                                         VAR Pfad:PathStr);
  140.    VAR SRec: SearchRec;    Nix: BOOLEAN;   i: INTEGER;
  141.  
  142.       PROCEDURE QS (links,rechts: INTEGER; VAR Dat: Zeilen);
  143.       VAR i,j: INTEGER; x,y: s30;
  144.       BEGIN
  145.         i := links; j := rechts;
  146.         x := Dat[(links+rechts) DIV 2];
  147.         REPEAT
  148.           WHILE Dat[i] < x DO Inc(i);
  149.           WHILE x < Dat[j] DO Dec(j);
  150.           IF i <= j THEN
  151.           BEGIN
  152.             y := Dat[i]; Dat[i] := Dat[j];
  153.             Dat[j] := y; Inc(i); Dec(j);
  154.           END;
  155.         UNTIL i > j;
  156.         IF links < j THEN QS(links,j,Dat);
  157.         IF links < rechts THEN QS(i,rechts,Dat);
  158.       END;
  159.  
  160.       PROCEDURE Einlesen (Eintrag: SearchRec; x: INTEGER);
  161.       VAR dt: DateTime;
  162.           d1,d2,d3 : STRING[2];
  163.           PPos, i  : INTEGER;
  164.           Suffix   : STRING[3];
  165.           Dummy    : STRING[7];
  166.       BEGIN
  167.         WITH Eintrag DO
  168.         BEGIN
  169.           PPos := Pos ('.',Name); IF PPos <> 0 THEN
  170.           BEGIN
  171.             Suffix := Copy (Name,PPos+1,Length(Name)-PPos);
  172.             Delete (Name,PPos,1+Length(Name)-PPos);
  173.           END ELSE Suffix := '';
  174.           Zeile[x] := Name;
  175.           FOR i := Length(Name) TO 7 DO
  176.             Zeile[x] := Zeile[x] + ' ';
  177.           Zeile[x] := Zeile[x] + '.' + Suffix;
  178.           FOR i := Length(Suffix) TO 3 DO
  179.             Zeile[x] := Zeile[x] + ' ';
  180.           IF (Attr AND Directory) <> 0 THEN
  181.             Zeile[x] := ' ' + Zeile[x] + '     <DIR>        '
  182.           ELSE BEGIN
  183.             Str(Size,Dummy);
  184.             WHILE Length(Dummy) < 7 DO Dummy := ' ' + Dummy;
  185.             Zeile[x] := Zeile[x] + Dummy;
  186.             UnpackTime (Time,dt);
  187.             WITH dt DO
  188.             BEGIN
  189.               Str(Day,d1);
  190.               IF Length(d1) < 2 THEN d1 := '0'+d1;
  191.               Str(Month,d2);
  192.               IF Length(d2) < 2 THEN d2 := '0'+d2;
  193.               Str(Year MOD 100,d3);
  194.             END;
  195.             Zeile[x] := Zeile[x]+'  '+d1+'.'+d2+'.'+d3;
  196.           END;
  197.         END;
  198.       END;
  199.  
  200.    BEGIN { Ddir }
  201.      Nix := TRUE; Zaehler := 1;
  202.      FOR i := 1 TO 200 DO Zeile[i] := '';
  203.      FindFirst ('*.*',$31,SRec);
  204.      WHILE DosError = 0 DO
  205.      BEGIN
  206.        Einlesen (SRec,Zaehler); FindNext (SRec);
  207.        Nix := FALSE; Inc (Zaehler);
  208.      END;
  209.      IF Nix THEN Zeile[1] := 'Leeres Verzeichnis';
  210.      QS (1,Zaehler,Zeile);
  211.      GetDir (0,Pfad); IF Length(Pfad) = 3 THEN
  212.      BEGIN
  213.        FOR i := 2 TO Zaehler DO Zeile[i-1] := Zeile[i];
  214.        Dec (Zaehler,1);
  215.      END
  216.      ELSE BEGIN
  217.        FOR i := 3 TO Zaehler DO Zeile[i-2] := Zeile[i];
  218.        Dec (Zaehler,2);
  219.      END;
  220.      FOR i := 1 TO Zaehler DO
  221.      IF Copy(Zeile[i],1,1) = ' ' THEN
  222.        Zeile[i] := Copy(Zeile[i],2,Length(Zeile[i])-1)+' ';
  223.    END;
  224.  
  225.    PROCEDURE Aktualisieren (Laenge: INTEGER;
  226.                  VAR BZeile,DatZeile: INTEGER);
  227.    VAR a: LONGINT;  j,m,d,w: WORD; i: BYTE;
  228.    BEGIN
  229.      ClrScr; DDir (Zeile,Zaehler,Pfad);
  230.      IF (BZeile <= Laenge) AND (DatZeile >= Laenge) THEN
  231.      FOR i := 1 TO Laenge DO
  232.        Print (1,i,Zeile[i+(DatZeile-BZeile)])
  233.      ELSE IF (BZeile < Laenge) AND (Zaehler >= Laenge) THEN
  234.        FOR i := 1 TO Laenge DO Print (1,i,Zeile[i])
  235.      ELSE IF (BZeile < Laenge) AND (Zaehler < Laenge) THEN
  236.        FOR i := 1 TO Zaehler DO Print (1,i,Zeile[i]);
  237.      BZeile := 1; DatZeile := 1;
  238.      PrintF (1,BZeile,Zeile[DatZeile]);
  239.      Window (1,1,80,25);
  240.      IF Length(Pfad) > 3 THEN Pfad := Pfad+'\';
  241.      GotoXY (x1+1,y1); Write (Pfad,'*.*');
  242.      FOR i := Length(Pfad)+4 TO 32 DO Write (Chr(205));
  243.      Window (x1+2,y1+1,x1+32,y1+Laenge);
  244.    END;
  245.  
  246.    PROCEDURE Markieren (VAR WahlDatei: s12;
  247.                y,z: INTEGER;x1,y1: INTEGER );
  248.    VAR Dummy : s12;  Attr  : WORD; i : BYTE; f: FILE;
  249.    BEGIN
  250.      GotoXY (1,y); Write (Zeile[z]); Normal;
  251.      Dummy := Copy (Zeile[z],1,12);  WahlDatei := '';
  252.      FOR i := 1 TO 12 DO
  253.      IF Dummy[i] > ' ' THEN
  254.        WahlDatei := WahlDatei + Dummy[i];
  255.      Gewaehlt := TRUE;
  256.      IF WahlDatei[Length(WahlDatei)] = '.' THEN
  257.      BEGIN
  258.        WahlDatei := Copy (WahlDatei,1,Length(WahlDatei)-1);
  259.        Assign (f,WahlDatei);  GetFAttr (f,Attr);
  260.        IF Attr AND Directory <> 0 THEN
  261.        BEGIN
  262.          IF WahlDatei =  '.' THEN ChDir ('..')
  263.          ELSE ChDir (WahlDatei);
  264.          Aktualisieren (Laenge,BZeile,DatZeile);
  265.          Gewaehlt := FALSE;  WahlDatei := '';
  266.        END;
  267.      END;
  268.    END;
  269.  
  270. BEGIN
  271.   BZeile := 1; DatZeile := 1;
  272.   CursorAus; Gewaehlt := FALSE;
  273.   SMem := Screen; Window (x1,y1,x1+33,y1+1+Laenge); ClrScr;
  274.   Window (1,1,80,25); Rahmen (x1,y1,x1+33,y1+1+Laenge,2);
  275.   Window (x1+2,y1+1,x1+32,y1+Laenge);
  276.   Aktualisieren (Laenge,BZeile,DatZeile);
  277.   REPEAT
  278.     GetCode (Code);
  279.     CASE Code OF
  280.       13   : Markieren (WahlDatei,BZeile,DatZeile,1,y1);
  281.       1080 : Down;
  282.       1072 : Up;
  283.       1081 : FOR j := 1 TO Laenge-1 DO
  284.                IF DatZeile < Zaehler THEN Down;
  285.       1073 : FOR j := 1 TO Laenge-1 DO
  286.                IF DatZeile > 1 THEN Up;
  287.       1079 : IF Zaehler <= Laenge THEN
  288.              BEGIN
  289.                Print (1,BZeile,Zeile[DatZeile]);
  290.                DatZeile := Zaehler; BZeile := DatZeile;
  291.                PrintF (1,BZeile,Zeile[DatZeile]);
  292.              END
  293.              ELSE BEGIN
  294.                FOR i := 1 TO Laenge DO
  295.                  Print (1,i,Zeile[Zaehler-Laenge+i]);
  296.                DatZeile := Zaehler; BZeile := Laenge;
  297.                PrintF (1,BZeile,Zeile[DatZeile]);
  298.              END;
  299.       1071 : BEGIN
  300.                IF Zaehler < Laenge THEN Max := Zaehler
  301.                ELSE Max := Laenge;
  302.                FOR i := 1 TO Max DO Print (1,i,Zeile[i]);
  303.                DatZeile := 1; BZeile :=  1;
  304.                PrintF (1,BZeile,Zeile[DatZeile]);
  305.              END;
  306.     END;
  307.   UNTIL Gewaehlt OR (Code = 27);
  308.   Window (1,1,80,25); CursorNormal; Screen := SMem;
  309. END;
  310.  
  311. END.
  312. (* ------------------------------------------------------ *)
  313. (*                 Ende von BOXERG.PAS                    *)
  314.  
  315.  
  316.