Turbo Toolbox/Turbo_Toolbox.iso/1989/06/tricks/dirwin.pas

Pascal/Delphi Source File | 1989-03-21 | 7.1 KB | 258 lines

(* ------------------------------------------------------ *)
(*                     DIRWIN.PAS                         *)
(*        Utility zum Anzeigen eines Verzeichnisses       *)
(*           innerhalb eines Bildschirmfensters           *)
(*          (c) 1989 by J. Laitenberger & TOOLBOX         *)
(* ------------------------------------------------------ *)
UNIT DirWin;

INTERFACE

USES Crt, Dos;

CONST
  spaces = '              ';                    { 14 Stück }
  video  = $b800;           { hier für color. mono : $b000 }

TYPE
  str12  = STRING [12];
  str20  = STRING [20];
  str80  = STRING [80];
  dirtyp = ARRAY [0..100] OF str12;

VAR
  path, next, st : STRING;
  c, c1, c2      : CHAR;
  count, first,
  last, diff,
  marked         : BYTE;
  regs           : Registers;
  i, j, max      : INTEGER;
  srec           : searchrec;
  dira           : dirtyp;
  att            : BOOLEAN;
  strg, mask     : str12;
  page           : ARRAY [$0000..$0fff] OF BYTE;

FUNCTION GetDir : STRING;

IMPLEMENTATION

PROCEDURE color (tc, bc : BYTE);
BEGIN
  TextColor (tc);
  TextBackground (bc)
END;

PROCEDURE cursor (start, end_ : INTEGER);
(* Setzt die Cursorform *)
VAR  regs : Registers;
BEGIN
  WITH regs DO BEGIN
    ch := start; cl := end_; ah := 1; Intr($10, regs);
  END;
END;

PROCEDURE hidecur;                (* Schaltet Cursor aus *)
BEGIN
  cursor(-1, 0);
END;

PROCEDURE showcur;          (* Schaltet Cursor wieder ein *)
BEGIN
  cursor(6,7);
END;

PROCEDURE store;                (* Sichert den Bildschirm *)
VAR i: INTEGER;
BEGIN
  FOR i := 0 TO $0fff DO page [i] := Mem [video:i];
END;

PROCEDURE restore;                 (* -> alter Bildschirm *)
VAR i: INTEGER;
BEGIN
  FOR i := 0 TO $0fff DO Mem [video:i] := page [i];
END;

FUNCTION getdd : CHAR;
(* Ermittelt das aktuelle Diskettenlaufwerk *)
BEGIN
  regs.ah := $19; MsDos (regs);
  getdd  := Chr (regs.al + Ord ('A'))
END;

FUNCTION form (ent: str12): str12;
BEGIN
  form := ent + '\'
END;

PROCEDURE dir;
(* Ermittelt Directory, Kapazität, freie Bytes *)
(* der Diskette im aktuellen Laufwerk          *)
BEGIN
  srec.name := '*.*'; i:=0;
  FindFirst(Copy(path, 1, Length(path)
            - Length(mask)) + '*.*', $20 + $10, srec);
  WHILE NOT (DosError = 18) AND (i <= 100) DO BEGIN
    IF srec.attr = $10 THEN BEGIN
      IF srec.name <> '.' THEN BEGIN
        Inc (i); dira [i] := form (srec.name)
      END;
    END;
    FindNext (srec);
  END;
  srec.name := path;
  FindFirst(path, $20, srec);
  WHILE NOT (DosError = 18) AND (i <= 100) DO BEGIN
    Inc (i);
    dira[i] := srec.name;
    FindNext (srec)
  END;
  IF dira[1] = (getdd + ':\' + mask) THEN Dec(i);
  max := i;
END;

PROCEDURE Window;
VAR i, j : INTEGER;
BEGIN
  GotoXY (10, 9); color (14,0);
  Write (Chr(218));
  FOR i := 0 TO 59 DO Write (Chr(196));
  Write (Chr(191));
  GotoXY (10,19);
  Write (Chr(192));
  FOR i := 0 TO 59 DO Write (Chr(196));
  Write (Chr(217));
  Color (15,0);
  GotoXY ((60 - Length(path) + 2) DIV 2 + 10, 9);
  Write (' ', path, ' ');
  Color (14,0);
  FOR i := 10 TO 18 DO BEGIN
    GotoXY (10,i);
    Write (Chr(179));
    FOR j := 0 TO 59 DO Write (Chr(32));
    Write (Chr(179));
  END;
  Color (7,0)
END;

PROCEDURE fill;
VAR  x, y : BYTE; cnt : BYTE;
BEGIN
  x := 11;  y := 10;
  IF att THEN BEGIN
    Window; att := FALSE;
  END;
  last := max;
  IF last > 0 THEN BEGIN
    IF last > 35 + first THEN last := first + 35;
    FOR cnt := first TO last DO BEGIN
      GotoXY (x,y);
      IF cnt = marked THEN BEGIN
        Color (0,7); Write (' ' + dira[cnt],
                   Copy(spaces, 1, 14 - Length(dira[cnt])));
        Color (7,0)
      END ELSE Write (' ' + dira[cnt],
                   Copy(spaces, 1, 14 - Length(dira[cnt])));
      x := x + 15;
      IF x > 60 THEN BEGIN
        x := 11; Inc (y);
      END;
    END;
  END ELSE BEGIN
    GotoXY (11,10);
    Write ('No files found.');
  END;
END;

FUNCTION GetDir : STRING;
VAR xpos, ypos : BYTE;
BEGIN
  marked := 1;  xpos := WhereX;  ypos := WhereY;
  path := getdd + ':\' + mask;  store;  hidecur;
  dir;  att := TRUE;  first := 1;  fill;
  REPEAT
    c1 := ReadKey;
    IF c1 = #0 THEN BEGIN
      c1 := ReadKey;
      CASE c1 OF
        'K': IF marked > first THEN Dec (marked);
        'M': IF (marked < max) AND
                (marked < 35 + first) THEN Inc (marked);
        'H': BEGIN
               IF (first-1 < marked) AND
                  (first+4 > marked) THEN BEGIN
                 IF marked-3 > 1 THEN BEGIN
                   Dec (first,4); Dec (marked,4);
                   Window; fill;
                 END;
               END ELSE BEGIN
                 IF marked > 3 + first THEN
                   Dec (marked, 4);
               END;
             END;
        'P': BEGIN
               IF (first+31 < marked) AND
                  (first+36 > marked) THEN BEGIN
                 IF marked+4 < max THEN BEGIN
                   Inc (first,4);  Inc (marked,4);
                   Window; fill;
                 END ELSE BEGIN
                   IF marked <> max THEN BEGIN
                     Inc (first,4); marked := max;
                     Window; fill;
                   END;
                 END;
               END ELSE BEGIN
                 IF (marked <= max - 4) AND
                    (marked <= 31 + first) THEN
                   Inc(marked,4)
                 ELSE IF marked > max-4 THEN marked := max;
               END;
             END;
      END;
    END ELSE BEGIN
      CASE c1 OF
        #13: BEGIN
               IF dira[marked][Length(dira[marked])] = '\'
                 THEN BEGIN
                 IF dira[marked] <> '.\' THEN BEGIN
                   IF dira[marked] = '..\' THEN BEGIN
                     IF path <> mask THEN BEGIN
                       count := Length(path)-Length(mask)-1;
                       WHILE (path [count] <> '\') DO
                         Dec (count);
                       Delete(path, count, Length(path) -
                              Length(mask) - count);
                     END;
                   END ELSE BEGIN
                     next := dira[marked];
                     Delete(next, Length(next), 1);
                     att := TRUE;  next := '\' + next;
                     Insert(next, path, Length(path) -
                                        Length(mask));
                   END;
                   att := TRUE;  marked := 1;
                   dir;  fill;
                 END;
               END ELSE BEGIN
                 GetDir := Copy(path, 1, Length(path) -
                               Length(mask)) + dira[marked];
                 GotoXY(xpos,ypos); restore; showcur;
                 Exit;
               END;
             END;
      END;
    END;
    fill;
  UNTIL c1 = #27;
  GetDir := '<ESC>';
  GotoXY(xpos,ypos); restore; showcur;
END;

BEGIN
  mask := '*.*'
END.
(* ------------------------------------------------------ *)
(*                 Ende von DIRWIN.PAS                    *)