home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / dtx9101 / tools / tvision2 / filewin.pas next >
Encoding:
Pascal/Delphi Source File  |  1991-09-30  |  39.2 KB  |  1,083 lines
  1. (* ---------------------------------------------------------------- *)
  2. (*                            FILEWIN.PAS                           *)
  3. (*                                                                  *)
  4. (* tFileWindow kann als Grundlage für eine Benutzeroberfläche à la  *)
  5. (* NortonCommander genutzt werden. Erklärungen im Listing; Anwendung*)
  6. (* in FWDEMO.PAS                                                    *)
  7. (*                                                                  *)
  8. (* (c) rr, 04.09.1991, 18.09.1991, 22.09.1991, 23.09.1991           *)
  9. (* ---------------------------------------------------------------- *)
  10. UNIT FileWin;
  11.  
  12. INTERFACE
  13.  
  14. USES Dos, Objects, Drivers, Memory,
  15.      Views, Dialogs, App, Menus,
  16.      StdDlg, MsgBox, Gadgets;
  17.  
  18. CONST
  19.   cmNewInfoStr   = 4000;
  20.   cmItemSelected = 4001;
  21.   cmNewMasks     = 4003;
  22.   cmOpenFileWin  = 4004;
  23.   cmToggleNewWin = 4005;
  24.   cmDirInWin     = 4006;
  25.   cmClearDesk    = 4008;
  26.   cmEnterNewMask = 4010;
  27.   cmEnterNewDir  = 4011;
  28.   cmDosShell     = 4012;
  29.  
  30. TYPE
  31.   TSearchRec = RECORD
  32.     Attr   : BYTE;
  33.     Time   : LONGINT;
  34.     Size   : LONGINT;
  35.     Name   : STRING [12];
  36.     Marked : BOOLEAN;
  37.   END;
  38.   PSearchRec = ^TSearchRec;
  39.  
  40.   PFileCollectionDF = ^TFileCollectionDF;
  41.   TFileCollectionDF = OBJECT (TFileCollection)
  42.     FUNCTION Compare (Key1, Key2: Pointer): Integer;          VIRTUAL;
  43.   END;
  44.  
  45.   PMarkingList = ^TMarkingList;
  46.   TMarkingList = OBJECT (TListBox)
  47.     MarkNum : INTEGER;
  48.     Marking : BOOLEAN;
  49.  
  50.     CONSTRUCTOR Init (VAR Bounds: TRect; Num : BYTE; 
  51.                       AScrollBar: PScrollBar);
  52.     PROCEDURE HandleEvent (VAR Event: TEvent);                VIRTUAL;
  53.     PROCEDURE Draw; VIRTUAL;
  54.     PROCEDURE FocusItem (Item: INTEGER);                      VIRTUAL;
  55.     PROCEDURE MarkItem (Item : INTEGER; Mark : BOOLEAN);      VIRTUAL;
  56.     PROCEDURE GetData (VAR Rec);                              VIRTUAL;
  57.     FUNCTION DataSize: Word;                                  VIRTUAL;
  58.     FUNCTION GetPalette : PPalette;                           VIRTUAL;
  59.     FUNCTION GetText (Item: INTEGER;
  60.                       MaxLen: INTEGER): STRING;               VIRTUAL;
  61.     FUNCTION GetInfoStr : STRING;                             VIRTUAL;
  62.     FUNCTION IsMarked (Item : INTEGER) : BOOLEAN;             VIRTUAL;
  63.     FUNCTION GetDummyLine : STRING;                           VIRTUAL;
  64.     DESTRUCTOR Done;                                          VIRTUAL;
  65.   END;
  66.  
  67.   PFileListBox = ^TFileListBox;
  68.   TFileListBox = OBJECT (TMarkingList)
  69.     MarkedSize : LONGINT;
  70.  
  71.     CONSTRUCTOR Init (VAR Bounds: TRect; 
  72.                       AScrollBar: PScrollBar);
  73.     PROCEDURE MarkItem (Item : INTEGER; Mark : BOOLEAN);      VIRTUAL;
  74.     PROCEDURE ReadDirectory (Path : PathStr; NewL: BOOLEAN);  VIRTUAL;
  75.     FUNCTION GetText (Item: INTEGER;
  76.                       MaxLen: INTEGER): STRING;               VIRTUAL;
  77.     FUNCTION GetInfoStr : STRING;                             VIRTUAL;
  78.     FUNCTION IsMarked (Item : INTEGER) : BOOLEAN;             VIRTUAL;
  79.     FUNCTION GetDummyLine : STRING;                           VIRTUAL;
  80.   END;
  81.  
  82.   PFileWindow = ^TFileWindow;
  83.   TFileWindow = OBJECT (TWindow)
  84.     Masks  : STRING;
  85.     CurDir : STRING;
  86.     FileBox: PFileListBox;
  87.     NewInfo: BOOLEAN;
  88.  
  89.     CONSTRUCTOR Init (VAR Bounds: TRect; Nr : INTEGER;
  90.                       StartDir, NMasks: STRING);
  91.     PROCEDURE HandleEvent (VAR Event : TEvent);               VIRTUAL;
  92.     PROCEDURE Draw;                                           VIRTUAL;
  93.     PROCEDURE ChangeBounds (VAR Bounds: TRect);               VIRTUAL;
  94.     PROCEDURE ReadDirectory (Path, NMasks : STRING);          VIRTUAL;
  95.     PROCEDURE SetDirectory (NewDir : STRING);                 VIRTUAL;
  96.     PROCEDURE SetMasks (NewMasks : STRING);                   VIRTUAL;
  97.     FUNCTION GetMasks : STRING;                               
  98.     FUNCTION GetDirectory : STRING;                           
  99.   END;
  100.  
  101.   PFileApplication = ^TFileApplication;
  102.   TFileApplication = OBJECT (TApplication)
  103.     WinNr       : INTEGER;
  104.     NewWinBySel : BOOLEAN;
  105.  
  106.     CONSTRUCTOR Init;
  107.     PROCEDURE OutOfMemory;                                    VIRTUAL;
  108.     PROCEDURE Idle;                                           VIRTUAL;
  109.     PROCEDURE HandleEvent (VAR Event : TEvent);               VIRTUAL;
  110.   END;
  111.  
  112. FUNCTION UpString (S : STRING) : STRING;
  113.  
  114. FUNCTION DriveValid (Drive: CHAR): BOOLEAN; 
  115.  
  116. FUNCTION PathValid (VAR Path: STRING): BOOLEAN;
  117.  
  118. FUNCTION GetDir (Drive : BYTE) : STRING;
  119.  
  120. FUNCTION GetNewDir (CurDir : STRING; Info : PSearchRec) : STRING;
  121.  
  122. FUNCTION FormatSearchRec (Info : PSearchRec;
  123.                           Lines: BOOLEAN) : STRING;
  124.  
  125. IMPLEMENTATION
  126.  
  127. (* ================================================================ *)
  128. (*                          Hilfsroutinen                           *)
  129. (* ================================================================ *)
  130. FUNCTION UpString (S : STRING) : STRING;
  131.   VAR i : BYTE;
  132. BEGIN
  133.   FOR i := 1 TO Length (s) DO
  134.     s [i] := UpCase (s [i]);
  135.   UpString := s;
  136. END;
  137.  
  138. FUNCTION DriveValid (Drive: CHAR): BOOLEAN; ASSEMBLER;
  139. ASM
  140.         MOV    DL,Drive
  141.         MOV    AH,36H
  142.         SUB    DL,'A'-1
  143.         INT    21H
  144.         INC    AX
  145.         JE    @@2
  146. @@1:    MOV    AL,1
  147. @@2:
  148. END;
  149.  
  150. FUNCTION PathValid (VAR Path: STRING): BOOLEAN;
  151.   VAR
  152.     ExpPath: PathStr;
  153.     F      : File;
  154.     SR     : SearchRec;
  155. BEGIN
  156.   ExpPath := FExpand (Path);
  157.   IF Length (ExpPath) <= 3 THEN
  158.     PathValid := DriveValid (ExpPath [1])
  159.   ELSE BEGIN
  160.     IF ExpPath [Length (ExpPath)] = '\' THEN Dec (ExpPath [0]);
  161.     FindFirst (ExpPath, Directory, SR);
  162.     PathValid := (DosError = 0) AND (SR.Attr AND Directory <> 0);
  163.   END;
  164. END;
  165.  
  166. FUNCTION GetDir (Drive : BYTE) : STRING;
  167.   VAR s : STRING;
  168. BEGIN
  169.   System.GetDir (Drive, s);
  170.   GetDir := s;
  171. END;
  172.  
  173. (* ---------------------------------------------------------------- *)
  174. (* Erweitert oder kürzt das Verzeichnis CurDir, je nachdem, ob      *)
  175. (* Info^.Name einen Unterverzeichnisnamen oder '..' enthält.        *)
  176. (* ---------------------------------------------------------------- *)
  177. FUNCTION GetNewDir (CurDir : STRING; Info : PSearchRec) : STRING;
  178. BEGIN
  179.   IF Info^.Attr AND Directory <> 0 THEN BEGIN
  180.     IF Info^.Name<>'..' THEN
  181.       CurDir := CurDir+'\'+Info^.Name
  182.     ELSE BEGIN
  183.       WHILE CurDir [Length (CurDir)] <> '\' DO
  184.         Dec (CurDir [0]);
  185.       Dec (CurDir [0]);
  186.     END;
  187.     GetNewDir := CurDir;
  188.   END ELSE
  189.     GetNewDir := '';
  190. END;
  191.  
  192. (* ---------------------------------------------------------------- *)
  193. (* Formatiert einen Info-Record NortonCommander-like: Dateiname,    *)
  194. (* Extension, Dateigrösse bzw SUB-DIR oder UP--DIR, Datum und Zeit- *)
  195. (* punkt der Erstellung sowie die Attribute in Form von Buchstaben, *)
  196. (* z.B. AHS (Archive-Hidden-System). Ist Lines True, so werden die  *)
  197. (* einzelnen Einträge mit einem senkrechten Strich (ASCII 179) von- *)
  198. (* einander abgetrennt.                                             *)
  199. (* ---------------------------------------------------------------- *)
  200. FUNCTION FormatSearchRec (Info : PSearchRec;
  201.                           Lines: BOOLEAN) : STRING;
  202.   TYPE
  203.     TParams = RECORD
  204.                 PName, PExt, PSize,
  205.                 PDate, PTime,PAttr : PString;
  206.               END;
  207.   VAR
  208.     Params : TParams;
  209.     hs     : STRING;
  210.     ht     : DateTime;
  211.     Name, Ext,
  212.     FSize, Time,
  213.     Date, Attr,
  214.     Result : STRING;
  215.  
  216.   FUNCTION LeadingZero (w : WORD) : STRING;
  217.     VAR s : STRING;
  218.   BEGIN
  219.     Str (w:0, s);
  220.     IF Length (s) = 1 THEN s := '0' + s;
  221.     LeadingZero := s;
  222.   END;
  223.  
  224. BEGIN
  225.   IF Info^.Attr AND Directory > 0 THEN BEGIN
  226.     Ext := '';
  227.     Name:= Info^.Name;
  228.     IF Info^.Name='..' THEN
  229.       FSize := #16'UP--DIR'#17
  230.     ELSE
  231.       FSize := #16'SUB-DIR'#17;
  232.   END ELSE BEGIN
  233.     hs  := Info^.Name;
  234.     IF Pos ('.', hs) > 0 THEN BEGIN
  235.       { es gibt Dateien ohne Extension, bei denen diese Formatierung
  236.         ziemlich falsch ausfallen würde; daher die Fallunterscheidung}
  237.       Name:= Copy (hs, 1, Pred (Pos ('.', hs)));
  238.       Ext := Copy (hs, Succ (Pos ('.', hs)), 3);
  239.     END ELSE BEGIN
  240.       Name := hs;
  241.       Ext := '';
  242.     END;
  243.     Str (Info^.Size, FSize);
  244.   END;
  245.   Params.PName := @Name;
  246.   Params.PExt  := @Ext;
  247.   Params.PSize := @FSize;
  248.  
  249.   UnpackTime (Info^.Time, ht);
  250.   Str (ht.Day, hs);
  251.   Date := hs+'.'+
  252.           LeadingZero(ht.Month)+'.'+
  253.           LeadingZero(ht.Year);
  254.   Delete (Date, Length (Date)-3, 2);
  255.   Params.PDate := @Date;
  256.  
  257.   Time := LeadingZero(ht.hour)+':'+
  258.           LeadingZero(ht.min);
  259.   Params.PTime := @Time;
  260.  
  261.   Attr := '·····';  
  262.   IF Info^.Attr AND Archive > 0 THEN Attr [1] := 'A';
  263.   IF Info^.Attr AND ReadOnly> 0 THEN Attr [2] := 'R';
  264.   IF Info^.Attr AND Hidden  > 0 THEN Attr [3] := 'H';
  265.   IF Info^.Attr AND SysFile > 0 THEN Attr [4] := 'S';
  266.   IF Info^.Attr AND Directory>0 THEN Attr [5] := 'D';
  267.   Params.PAttr := @Attr;
  268.  
  269.   IF Lines THEN
  270.     FormatStr (Result, '%-8s %3s│%9s│%8s│%6s│%5s', Params)
  271.   ELSE
  272.     FormatStr (Result, '%-8s %3s %9s %8s %6s %5s', Params);
  273.   FormatSearchRec := Result;
  274. END;
  275.  
  276. (* ================================================================ *)
  277. (*                       TFileCollectionDF                          *)
  278. (* ================================================================ *)
  279. (* Compare ist TFileCollection.Compare aus STDDLG nachempfunden,    *)
  280. (* nur mit dem Unterschied, dass es die Verzeicnisse VOR die Dateien*)
  281. (* einordnet.                                                       *)
  282. (* ---------------------------------------------------------------- *)
  283. FUNCTION TFileCollectionDF.Compare (Key1, Key2: POINTER): INTEGER;
  284. BEGIN
  285.   IF PSearchRec(Key1)^.Name = PSearchRec(Key2)^.Name THEN Compare := 0
  286.   ELSE IF PSearchRec(Key1)^.Name = '..' THEN Compare := -1
  287.   ELSE IF PSearchRec(Key2)^.Name = '..' THEN Compare := 1
  288.   ELSE IF (PSearchRec(Key1)^.Attr AND Directory <> 0) AND
  289.      (PSearchRec(Key2)^.Attr AND Directory = 0) THEN Compare := -1
  290.   ELSE IF (PSearchRec(Key2)^.Attr AND Directory <> 0) AND
  291.      (PSearchRec(Key1)^.Attr AND Directory = 0) THEN Compare := 1
  292.   ELSE IF PSearchRec(Key1)^.Name > PSearchRec(Key2)^.Name THEN
  293.     Compare := 1
  294.   ELSE Compare := -1;
  295. END;
  296.  
  297. (* ================================================================ *)
  298. (*                         TMarkingList                             *)
  299. (* ================================================================ *)
  300. CONSTRUCTOR TMarkingList.Init (VAR Bounds: TRect;
  301.                                Num       : BYTE;
  302.                                AScrollBar: PScrollBar);
  303. BEGIN
  304.   TListBox.Init (Bounds, Num, AScrollBar);
  305.   Marking := FALSE;
  306.   MarkNum := 0;
  307. END;
  308.  
  309. (* ---------------------------------------------------------------- *)
  310. (* HandleEvent schickt bei Selektierung eines Eintrages, dh bei     *)
  311. (* dessen Anwahl mit Enter oder Doppelklick der Maus, einen cmItem- *)
  312. (* Selected-Broadcast an APPLICATION ab und nicht an den Owner (der *)
  313. (* die Nachricht natürlich auch empfangen kann), weil es in bestimm-*)
  314. (* ten Fällen nötig sein kann, dass auf Programmebene über die Aus- *)
  315. (* wertung entschieden wird. So bei TFileWindow: Das Programm, nicht*)
  316. (* das Fenster, muss ein angewähltes Programm starten. Des weiteren *)
  317. (* sind Einträge über INS oder mit der rechten Maustaste markierbar.*)
  318. (* Bei der Mausmarkierung übernimmt HandleEvent das Maustracking    *)
  319. (* selbst. Ist der erste angeklickte Eintrag nicht markiert, wird er*)
  320. (* und alle folgenden markiert und umgekehrt. Deshalb die Verwendung*)
  321. (* von First.                                                       *)
  322. (* ---------------------------------------------------------------- *)
  323. PROCEDURE TMarkingList.HandleEvent (VAR Event: TEvent);
  324.   CONST
  325.     Info   : POINTER = NIL;
  326.   VAR
  327.     NewPos     : TPoint;
  328.     Factor     : SHORTINT;
  329.     First      : BOOLEAN;
  330. BEGIN
  331.   IF ((Event.What = evKeyDown) AND (Event.KeyCode=kbEnter)) OR
  332.      ((Event.What = EvMouseDown) AND (Event.Double)) THEN BEGIN
  333.     Info := List^.At (Focused);
  334.     Message(Application, evBroadCast, cmItemSelected, Info);
  335.     ClearEvent (Event);
  336.     { ausgeschicktes Ereignis löschen, sonst läuft es noch weiter
  337.       bis zu TApplication.EventError }
  338.   END;
  339.  
  340.   IF (Event.What = evKeyDown) AND (Event.KeyCode=kbIns) THEN BEGIN
  341.     MarkItem (Focused, NOT IsMarked (Focused));
  342.     IF Focused < Pred (Range) THEN
  343.       Inc (Focused);
  344.     FocusItem (Focused);
  345.     DrawView;
  346.     ClearEvent (Event);
  347.   END;
  348.  
  349.   IF (Event.What = evMouseDown) AND
  350.      (Event.Buttons=mbRightButton) THEN BEGIN
  351.     Factor := 0; First := TRUE;
  352.     REPEAT
  353.       MakeLocal (Event.Where, NewPos);
  354.       IF MouseInView (Event.Where) AND     { Maus in View ? }
  355.          (TopItem+NewPos.Y < Range) THEN
  356.         Focused := TopItem+NewPos.Y        { ja, Position ausrechnen }
  357.       ELSE BEGIN                           { nein: }
  358.         IF NewPos.Y < 0 THEN               { oberhalb ? }
  359.           Factor := -1
  360.         ELSE                     { oder unterhalb der eigenen View ? }
  361.           IF NewPos.Y > Size.Y THEN Factor := 1;
  362.         IF (Focused+Factor > Range-1) OR
  363.            (Focused+Factor < 0) THEN
  364.           Factor := 0;            { nicht ausserhalb von Range gehen }
  365.         Inc (Focused, Factor);
  366.       END;
  367.       IF First THEN BEGIN 
  368.         Marking := NOT IsMarked (Focused);
  369.         First := FALSE;
  370.       END;
  371.       MarkItem (Focused, Marking);
  372.       FocusItem (Focused);
  373.       DrawView;
  374.     UNTIL NOT MouseEvent (Event, evMouseMove+evMouseAuto);
  375.     { Solange, bis Taste losgelassen ist }
  376.     ClearEvent (Event);
  377.   END;
  378.   IF Event.What<>evNothing THEN
  379.     TListBox.HandleEvent (Event);
  380. END;
  381.  
  382. (* ---------------------------------------------------------------- *)
  383. (* Die Darstellung muss nun auch berücksichtigen, ob ein Eintrag    *)
  384. (* markiert ist. Festgestellt wird das über die abstrakte Funktion  *)
  385. (* IsMarked. Anhand dieser Information wird die Farbe für den Ein-  *)
  386. (* trag gewählt, wobei für den fokussierten Eintrag eine jeweils    *)
  387. (* andere verwendet wird. Hat die Liste weniger Einträge als der    *)
  388. (* Darstellungsbereich Zeilen, werden die nicht ausgefüllten Zeilen *)
  389. (* mit GetDummyLines gefüllt. Hat die Liste also Abtrennungen wie   *)
  390. (* z.B. bei FileListBox, so muss diese Methode einen entsprechenden *)
  391. (* String liefern.                                                  *)
  392. (* ---------------------------------------------------------------- *)
  393. PROCEDURE TMarkingList.Draw;
  394.   VAR
  395.     i    : INTEGER;
  396.     Line : TDrawBuffer;
  397.     s    : STRING;
  398.     Col  : BYTE;
  399. BEGIN
  400.   IF TopItem+Size.Y-1 > Range-1 THEN
  401.     TopItem := Range-Size.Y;
  402.   IF TopItem < 0 THEN
  403.     TopItem := 0;
  404.  
  405.   FOR i := TopItem TO TopItem+Size.Y-1 DO BEGIN
  406.     IF i < Range THEN BEGIN
  407.       IF (i=Focused) AND (IsMarked (i)) THEN Col := 5
  408.         ELSE IF (i=Focused) THEN Col := 3
  409.           ELSE IF IsMarked (i) THEN Col := 1
  410.             ELSE Col := 2;
  411.     END ELSE
  412.       Col := 2;
  413.     MoveChar (Line, ' ', GetColor (Col), Size.X+1);
  414.     IF i < Range THEN BEGIN
  415.       s := GetText (i, Size.Y);
  416.       MoveStr (Line[1], s, GetColor (Col));
  417.     END ELSE
  418.       MoveStr (Line[1], GetDummyLine, GetColor (Col));
  419.     WriteLine (0, i-TopItem, Size.X+1, 1, Line);
  420.   END;
  421. END;
  422.  
  423. (* ---------------------------------------------------------------- *)
  424. (* FocusItem sendet einen BroadCast aus, dessen Zeiger auf den      *)
  425. (* aktuellen InfoString zeigt. "S" ist eine Konstante, weil ein     *)
  426. (* Zeiger auf eine lokale Variable eben nur lokal gültig ist, die   *)
  427. (* konstante aber im globalen Datensegment ist.                     *)
  428. (* ---------------------------------------------------------------- *)
  429. PROCEDURE TMarkingList.FocusItem (Item: Integer);
  430.   CONST
  431.     s : STRING = '';
  432. BEGIN
  433.   TListBox.FocusItem (Item);
  434.   s := GetInfoStr;
  435.   Message (Owner, evBroadcast, cmNewInfoStr, @s);
  436. END;
  437.  
  438. (* ---------------------------------------------------------------- *)
  439. (* MarkItem hat den Eintrag zu markieren. Wie diese Information kon-*)
  440. (* kret festgehalten wird, muss der Nachkomme entscheiden (z.B. wie *)
  441. (* bei TFileListBox über das Feld Marked von TSearchRec).           *)
  442. (* ---------------------------------------------------------------- *)
  443. PROCEDURE TMarkingList.MarkItem (Item : INTEGER; Mark : BOOLEAN);
  444. BEGIN
  445.   IF Mark THEN Inc (MarkNum) ELSE Dec (MarkNum);
  446. END;
  447.  
  448. PROCEDURE TMarkingList.GetData (VAR Rec);
  449. BEGIN
  450.   { Daten sollen nicht mehr als Strings verschickt werden;
  451.     die Datenübertragung wird direkt über List abgewickelt. }
  452. END;
  453.  
  454. FUNCTION TMarkingList.DataSize: Word;
  455. BEGIN
  456.   DataSize := 0;
  457. END;
  458.  
  459. FUNCTION TMarkingList.GetPalette : PPalette;
  460.   CONST CMyPal = #2#1#7#1#3;
  461.         PMyPal : STRING [5] = CMyPal;
  462. BEGIN
  463.   GetPalette := @PMyPal;
  464. END;
  465.  
  466. FUNCTION TMarkingList.GetText (Item: INTEGER;
  467.                                MaxLen: INTEGER): STRING;
  468. BEGIN
  469.   GetText := '';    { Nachkommen müssen Daten besorgen }
  470. END;
  471.  
  472. FUNCTION TMarkingList.GetInfoStr : STRING;
  473. BEGIN
  474.   GetInfoStr := '';  
  475. END;
  476.  
  477. FUNCTION TMarkingList.IsMarked (Item : INTEGER) : BOOLEAN;
  478. BEGIN
  479.   IsMarked := FALSE; { siehe MarkItem }
  480. END;
  481.  
  482. FUNCTION TMarkingList.GetDummyLine : STRING;
  483. BEGIN
  484.   GetDummyLine := '';
  485. END;
  486.  
  487. DESTRUCTOR TMarkingList.Done;
  488. BEGIN
  489.   IF List <> NIL THEN
  490.     Dispose (List, Done);   { Liste freigeben }
  491.   TListBox.Done;
  492. END;
  493.  
  494. (* ================================================================ *)
  495. (*                         TFileListBox                             *)
  496. (* ================================================================ *)
  497. CONSTRUCTOR TFileListBox.Init (VAR Bounds: TRect;
  498.                                AScrollBar: PScrollBar);
  499. BEGIN
  500.   TMarkingList.Init (Bounds, 1, AScrollBar);
  501.   MarkedSize := 0;
  502. END;
  503.  
  504. PROCEDURE TFileListBox.MarkItem (Item : INTEGER; Mark : BOOLEAN);
  505.   VAR Info :PSearchRec;
  506. BEGIN
  507.   { NICHT Vorfahren verwenden, weil der nicht berücksichtigt, ob
  508.     Directory oder nicht ! Directories sollen nicht markiert werden
  509.     können. }
  510.   Info := PSearchRec (List^.At (Item));
  511.   IF (Info^.Attr AND Directory=0) AND
  512.      (Info^.Marked<>Mark) THEN BEGIN
  513.     Info^.Marked := Mark;
  514.     IF Mark THEN BEGIN
  515.       Inc (MarkedSize, Info^.Size);
  516.       Inc (MarkNum);
  517.     END ELSE BEGIN
  518.       Dec (MarkedSize, Info^.Size);
  519.       Dec (MarkNum);
  520.     END;
  521.   END;
  522. END;
  523.  
  524. (* ---------------------------------------------------------------- *)
  525. (* Liest die Dateien aus Path ein, wobei erwartet wird, dass Path   *)
  526. (* Verzeichnis+'\'+Suchmaske enthält. Ist NewL TRUE, so wird die    *)
  527. (* bisherige Liste gelöscht und eine neue erstellt. Wenn aber FALSE,*)
  528. (* dann wird die alte Liste um neue Einträge ergänzt, wobei die     *)
  529. (* alphabetische Ordnung natürlich erhalten bleibt. Der Zweck ist,  *)
  530. (* dass mehrere Suchmasken in einem Fenster berücksichtigt werden   *)
  531. (* können (siehe TFileWindow). - Hat es nicht mehr genügend         *)
  532. (* Speicher, wird OutOfMemory aufgerufen und die Liste freigegeben. *)
  533. (* ---------------------------------------------------------------- *)
  534. PROCEDURE TFileListBox.ReadDirectory (Path: PathStr;
  535.                                       NewL: BOOLEAN);
  536.   VAR
  537.     FileInfo : SearchRec;
  538.     PInfo    : PSearchRec;
  539.     FileBox  : PFileCollectionDF;  
  540. BEGIN
  541.   IF NewL THEN
  542.     New (FileBox, Init (100, 10))
  543.   ELSE
  544.     FileBox :=  PFileCollectionDF (List);
  545.   FindFirst (Path, AnyFile, FileInfo);
  546.   WHILE DosError = 0 DO BEGIN
  547.     New (PInfo);
  548.     IF (PInfo=NIL) OR (LowMemory) THEN BEGIN
  549.       Application^.OutOfMemory;
  550.       Dispose (List, Done);
  551.       Exit;
  552.     END ELSE BEGIN
  553.       PInfo^.Marked := FALSE;
  554.       Move (FileInfo.Attr, PInfo^, SizeOf (PInfo^)-1);
  555.       IF PInfo^.Name<>'.' THEN
  556.         FileBox^.Insert (PInfo);
  557.       FindNext(FileInfo);
  558.     END;
  559.   END;
  560.   IF NewL THEN NewList (FileBox)
  561.           ELSE SetRange (List^.Count);
  562. END;
  563.  
  564. FUNCTION TFileListBox.GetText (Item: INTEGER; MaxLen: INTEGER): STRING;
  565. BEGIN
  566.   GetText := FormatSearchRec (List^.At (Item), TRUE);
  567. END;
  568.  
  569. FUNCTION TFileListBox.GetInfoStr : STRING;
  570.   VAR
  571.     SizeStr, NumStr, s : STRING;
  572. BEGIN
  573.   IF MarkNum=0 THEN
  574.     GetInfoStr := FormatSearchRec (List^.At (Focused), FALSE)
  575.   ELSE BEGIN
  576.     Str (MarkedSize, SizeStr);
  577.     Str (MarkNum, NumStr);
  578.     s := SizeStr+' Bytes in '+NumStr+' Dateien.';
  579.     GetInfoStr := s;
  580.   END;
  581. END;
  582.  
  583. FUNCTION TFileListBox.IsMarked (Item : INTEGER) : BOOLEAN;
  584.   VAR Info : PSearchRec;
  585. BEGIN
  586.   Info := PSearchRec (List^.At (Item));
  587.   IF Info^.Attr AND Directory > 0 THEN
  588.     IsMarked := FALSE  { Directories können nicht markiert werden }
  589.   ELSE
  590.     IsMarked := BOOLEAN (Info^.Marked);
  591. END;
  592.  
  593. FUNCTION TFileListBox.GetDummyLine : STRING;
  594.  CONST Dummy : STRING = '            │         │        │      │';
  595. BEGIN
  596.   GetDummyLine := Dummy;
  597. END;
  598.  
  599. (* ================================================================ *)
  600. (*                          TFileWindow                             *)
  601. (* ================================================================ *)
  602. (* Init prüft zuerst, ob das angegebene Verzeichnis existiert. Wenn *)
  603. (* nicht, wird das aktuelle genommen. Nach dem Aufruf von           *)
  604. (* TWindow.Init wird eine FileListBox erzeugt und, sofern LowMemory *)
  605. (* nicht FALSE ist, mit Insert in die Gruppe eingefügt.             *)
  606. (* ---------------------------------------------------------------- *)
  607. CONSTRUCTOR TFileWindow.Init (VAR Bounds: TRect;
  608.                               Nr        : INTEGER;
  609.                               StartDir  : STRING;
  610.                               NMasks    : STRING);
  611.   VAR R : TRect;
  612. BEGIN
  613.   IF (NOT PathValid (StartDir)) OR (StartDir='') THEN
  614.     StartDir := GetDir (0);
  615.   CurDir := StartDir;
  616.   NewInfo := FALSE;
  617.  
  618.   TWindow.Init (Bounds, CurDir, Nr);
  619.                     { Twindow.Init setzt Parameter für Title auf '' !}
  620.   CurDir := StartDir;                       { daher nochmal kopieren }
  621.  
  622.   R.Assign (1, 3, Size.X-1, Size.Y-3);
  623.   FileBox := New (PFileListBox,
  624.                   Init (R, 
  625.                         StandardScrollBar (sbVertical+
  626.                                            sbHandleKeyboard)));
  627.   IF Application^.ValidView (FileBox)<>NIL THEN BEGIN
  628.     FileBox^.GrowMode := gfGrowHiY+gfGrowHiX;
  629.     SetMasks (NMasks);
  630.     Insert (FileBox);
  631.   END ELSE
  632.     Fail;
  633. END;
  634.  
  635. (* ---------------------------------------------------------------- *)
  636. (* Draw gibt eine Kopfzeile (Head) zur Beschriftung der Liste aus   *)
  637. (* ergänzt den Inhalt um "Eckzeichen". Zwei davon liegen auf dem    *)
  638. (* Rahmen des Fensters und dürfen daher während der Vergrösserung   *)
  639. (* oder Bewegung des Fensters nicht dargestellt werden. Damit der   *)
  640. (* Fensterinhalt (und somit die Liste) nicht unnötig oft dargestellt*)
  641. (* wird, wird auf NewInfo geprüft. Dieses Flag ist dann TRUE, wenn  *)
  642. (* HandleEvent den BroadCast cmNewInfoStr empfangen hat und als     *)
  643. (* Reaktion NewInfo auf TRUE setzt, DrawView aufruft und NewInfo    *)
  644. (* wieder auf FALSE setzt. - Je nachdem, ob das Fenster aktiv oder  *)
  645. (* passiv ist, wird eine andere Farbe benutzt.                      *)
  646. (* ---------------------------------------------------------------- *)
  647. PROCEDURE TFileWindow.Draw;
  648.   CONST
  649.     PasCharSet = '├─┼┴';
  650.     ActCharSet = '╟─┼┴';
  651.     Head : STRING = ' Name    Ext │ Grösse  │ Datum  │ Zeit │ Attr'+
  652.                     '                                             ';
  653.     Empty: STRING = '                                             '+
  654.                     '                                             ';
  655.   VAR
  656.     Col      : BYTE;
  657.     CharSet  : STRING;
  658. BEGIN
  659.   IF NOT NewInfo THEN
  660.     TWindow.Draw;
  661.   Col := 1; CharSet := ActCharSet;
  662.   IF State AND sfActive > 0 THEN BEGIN
  663.     Col := 2;  CharSet := ActCharSet;
  664.   END ELSE BEGIN
  665.     Col := 1;  CharSet := PasCharSet;
  666.   END;
  667.   IF NOT NewInfo THEN BEGIN
  668.     WriteStr (1, 1, Copy (Head, 1, Size.X-2), Col);
  669.     IF State AND sfDragging = 0 THEN BEGIN
  670.       WriteChar (0, 2, CharSet[1], Col, 1);
  671.       WriteChar (0, Size.Y-3, CharSet[1], Col, 1);
  672.     END;
  673.     WriteChar (1,  2, CharSet[2], Col, Size.X-2);
  674.     WriteChar (14, 2, CharSet[3], Col, 1);
  675.     WriteChar (24, 2, CharSet[3], Col, 1);
  676.     WriteChar (33, 2, CharSet[3], Col, 1);
  677.     WriteChar (40, 2, CharSet[3], Col, 1);
  678.     WriteChar (1, Size.Y-3, CharSet[2], Col, Size.X-2);
  679.     WriteChar (14,Size.Y-3, CharSet[4], Col, 1);
  680.     WriteChar (24,Size.Y-3, CharSet[4], Col, 1);
  681.     WriteChar (33,Size.Y-3, CharSet[4], Col, 1);
  682.     WriteChar (40,Size.Y-3, CharSet[4], Col, 1);
  683.   END;
  684.  
  685.   FillChar (Empty, 80, ' ');                    { Infozeile ausgeben }
  686.   Empty := FileBox^.GetInfoStr;
  687.   Empty[0] := CHAR (Size.X-3);
  688.   WriteStr (2, Size.Y-2, Empty, Col);
  689. END;
  690.  
  691. (* ---------------------------------------------------------------- *)
  692. (* HandleEvent reagiert auf cmNewInfoStr mit dessen Darstellung     *)
  693. (* (siehe Draw), auf cmNewMasks mit Aufruf von SetMasks und auf die *)
  694. (* Anfrage, ob das Fenster ein Verzeichnis darstelle (das beim      *)
  695. (* Broadcast cmDirInWin im InfoPtr-Feld übergeben wird), mit dem    *)
  696. (* Aufruf von ClearEvent, sollte das übergebene Verzeichnis mit     *)
  697. (* CurDir übereinstimmen.                                           *)
  698. (* ---------------------------------------------------------------- *)
  699. PROCEDURE TFileWindow.HandleEvent (VAR Event : TEvent);
  700. BEGIN
  701.   IF (Event.What = EvBroadCast) THEN BEGIN
  702.     CASE Event.Command OF
  703.       cmNewInfoStr   : BEGIN
  704.                          NewInfo:= TRUE;
  705.                          DrawView;
  706.                          NewInfo := FALSE;
  707.                        END;
  708.       cmNewMasks     : SetMasks (STRING (Event.InfoPtr^));
  709.       cmDirInWin     : IF STRING (Event.InfoPtr^)=CurDir THEN
  710.                          ClearEvent (Event);
  711.     END;
  712.   END;
  713.  
  714.   IF Event.What<>evNothing THEN
  715.     TWindow.HandleEvent (Event);
  716. END;
  717.  
  718. (* ---------------------------------------------------------------- *)
  719. (* ChangeBounds fordert eine gewisse Mindestgrösse, damit es nicht  *)
  720. (* möglich ist, keinen Listeneintrag mehr darzustellen.             *)
  721. (* ---------------------------------------------------------------- *)
  722. PROCEDURE TFileWindow.ChangeBounds (VAR Bounds : TRect);
  723. BEGIN
  724.   IF Bounds.B.Y-Bounds.A.Y < 10 THEN
  725.     Bounds.B.Y := Bounds.A.Y+10;
  726.   TWindow.ChangeBounds (Bounds);
  727. END;
  728.  
  729. (* ---------------------------------------------------------------- *)
  730. (* ReadDirectory sucht für alle in NMasks enthaltenen, durch "/"    *)
  731. (* abgetrennten Masken die Dateien im Verzeichnis Path. Dadurch ist *)
  732. (* es möglich, in einem Fenster mehrere Suchmasken darzustellen.    *)
  733. (* Sollen Directories berücksichtigt werden, so muss "*." in NMasks *)
  734. (* enthalten sein. Ein Beispiel: "*.exe/*.com/*.bat/*." sucht alle  *)
  735. (* ausführbaren Dateien sowie Verzeichnisse.                        *)
  736. (* ---------------------------------------------------------------- *)
  737. PROCEDURE TFileWindow.ReadDirectory (Path, NMasks : STRING);
  738.   VAR FirstM : BOOLEAN;
  739.       OneMask : STRING;
  740. BEGIN
  741.   FirstM := TRUE;
  742.   WHILE NMasks<>'' DO BEGIN
  743.     IF Pos ('/', NMasks) > 0 THEN BEGIN
  744.       OneMask := Copy (NMasks, 1, Pos ('/', NMasks));
  745.       Dec (OneMask [0]);
  746.     END ELSE
  747.       OneMask := NMasks;
  748.     FileBox^.ReadDirectory (CurDir+'\'+OneMask, FirstM);
  749.       { für jede Suchmaske die entsprechenden Einträge suchen lassen }
  750.     FirstM := FALSE;
  751.     IF Pos ('/', NMasks) > 0 THEN
  752.       System.Delete (NMasks, 1, Pos ('/', NMasks))
  753.     ELSE
  754.       NMasks := '';
  755.   END;
  756.   FileBox^.FocusItem (0);
  757.   FileBox^.DrawView;
  758. END;
  759.  
  760. (* ---------------------------------------------------------------- *)
  761. (* SetDirectory muss den "Title" des Fensters anpassen und die Liste*)
  762. (* neu erstellen lassen.                                            *)
  763. (* ---------------------------------------------------------------- *)
  764. PROCEDURE TFileWindow.SetDirectory (NewDir : STRING);
  765.   CONST NewDirStr : STRING = '';
  766. BEGIN
  767.   CurDir := NewDir;  NewDirStr := NewDir;
  768.   DisposeStr (Title);
  769.   Title := NewStr (NewDirStr);
  770.   Lock;
  771.   ReadDirectory (CurDir, Masks);
  772.   ReDraw;
  773.   DrawView;
  774.   UnLock;
  775. END;
  776.  
  777. PROCEDURE TFileWindow.SetMasks (NewMasks : STRING); 
  778. BEGIN
  779.   Masks := NewMasks;
  780.   ReadDirectory (CurDir, Masks);
  781. END;
  782.  
  783. FUNCTION TFileWindow.GetMasks : STRING;
  784. BEGIN
  785.   GetMasks := Masks;
  786. END;
  787.  
  788. FUNCTION TFileWindow.GetDirectory : STRING;
  789. BEGIN
  790.   GetDirectory := CurDir;
  791. END;
  792.  
  793. (* ================================================================ *)
  794. (*                         TFileApplication                         *)
  795. (* ================================================================ *)
  796. (* Das Flag NewWinBySel gibt an, ob bei der Anwahl eines            *)
  797. (* Verzeichnisses in einem TFileWindow das neue Verzeichnis im      *)
  798. (* gleichen Fenster (NewWinBySel=FALSE) oder in einem neuen Fenster *)
  799. (* (TRUE) dargestellt werden soll (siehe HandleEvent).              *)
  800. (* ---------------------------------------------------------------- *)
  801. CONSTRUCTOR TFileApplication.Init;
  802.   VAR R : TRect;
  803. BEGIN
  804.   TApplication.Init;
  805.   WinNr := 0;
  806.   NewWinBySel := TRUE;
  807. END;
  808.  
  809. (* ---------------------------------------------------------------- *)
  810. (* Frischt Menü und Statuszeile auf, dh lässt cmTile und cmCascade  *)
  811. (* zu, sobald ein Fenster geöffnet ist, das auf diese Befehle rea-  *)
  812. (* giert.                                                           *)
  813. (* ---------------------------------------------------------------- *)
  814. PROCEDURE TFileApplication.Idle;
  815.  
  816. FUNCTION IsTileable (P: PView): BOOLEAN; FAR;
  817. BEGIN
  818.   IsTileable := P^.Options AND ofTileable <> 0;
  819. END;
  820.  
  821. BEGIN
  822.   TApplication.Idle;
  823.   IF Desktop^.FirstThat (@IsTileable) <> NIL THEN
  824.     EnableCommands ([cmTile, cmCascade])
  825.   ELSE
  826.     DisableCommands ([cmTile, cmCascade]);
  827. END;
  828.  
  829. PROCEDURE TFileApplication.OutOfMemory;
  830. BEGIN
  831.   MessageBox('Not enough memory available to complete operation.',
  832.     nil, mfError + mfOkButton);
  833. END;
  834.  
  835. (* ---------------------------------------------------------------- *)
  836. (* HandleEvent reagiert auf einige Befehle und Broadcasts:          *)
  837. (* Befehle:                                                         *)
  838. (* - cmOpenFileWin : Ein neues TFileWindow wird mit dem aktuellen   *)
  839. (*   Verzeichnis                                                    *)
  840. (* - cmTile, cmCascade : Desktop^.Tile bzw. Desktop^.Cascade werden *)
  841. (*   aufgerufen.                                                    *)
  842. (* - cmToggleNewWin : Schaltet Flag NewWinBySel um (siehe Init).    *)
  843. (* - cmDosShell : Command.Com wird gestartet.                       *)
  844. (* - ClearDesktop : Alle Views werden vom Desktop genommen.         *)
  845. (* - cmEnterNewMask : Über eine Inputbox kann eine/mehrere neue     *)
  846. (*   Suchmaske(n) eingeben werden.                                  *)
  847. (* - cmEnterNewDir : Ein neues Verzeichnis/Laufwerk kann eingegen   *)
  848. (*   werden.                                                        *)
  849. (* BroadCast:                                                       *)
  850. (* - cmItemSelected : Ist der Item ein Verzeichnis, so wird in Ab-  *)
  851. (*   hängigkeit von NewWinBySel entweder ein neues Fenster geöffnet *)
  852. (*   oder der Inhalt des aktiven angepasst. Ist der Item eine Datei,*)
  853. (*   so wird, sofern es eines ist, das Programm gestartet.          *)
  854. (* ---------------------------------------------------------------- *)
  855. PROCEDURE TFileApplication.HandleEvent (VAR Event : TEvent);
  856.  
  857.   (* -------------------------------------------------------------- *)
  858.   (* Desktop aufräumen. Dazu wird an alle Views der Befehl cmClose  *)
  859.   (* gesandt. Damit es nicht allzu sehr flackert, wird die Ausgabe  *)
  860.   (* zwischenzeitlich blockiert (Lock).                             *)
  861.   (* -------------------------------------------------------------- *)
  862.   PROCEDURE ClearDesktop;
  863.     PROCEDURE CloseView (P: PView); FAR;
  864.     BEGIN
  865.       Message (P, evCommand, cmClose, NIL);
  866.     END;
  867.   BEGIN
  868.     Desktop^.Lock;
  869.     IF Desktop^.Valid (cmClose) THEN
  870.       Desktop^.ForEach(@CloseView);
  871.     Desktop^.UnLock;
  872.     WinNr := 0;
  873.   END;
  874.  
  875.   (* -------------------------------------------------------------- *)
  876.   (* DosShell, aus TVDEMO übernommen. Falls ein Programm aufgeführt *)
  877.   (* werden soll, so muss sein VOLLSTÄNDIGER Name (Pfad+Name) über- *)
  878.   (* geben werden. Vor dem Aufruf von Exec wird der Speicher so weit*)
  879.   (* als möglich freigegeben, hinterher alles wieder neu            *)
  880.   (* initialisiert und der gesamte Bildschirm nochmal dargestellt.  *)
  881.   (* -------------------------------------------------------------- *)
  882.   PROCEDURE DosShell (Prog, CmdLine : STRING);
  883.   BEGIN
  884.     DoneSysError;
  885.     DoneEvents;
  886.     DoneVideo;
  887.     DoneMemory;
  888.     SetMemTop (HeapPtr);
  889.     SwapVectors;
  890.  
  891.     Exec (Prog, CmdLine);
  892.  
  893.     SwapVectors;
  894.     SetMemTop (HeapEnd);
  895.     InitMemory;
  896.     InitVideo;
  897.     InitEvents;
  898.     InitSysError;
  899.     Redraw;
  900.   END;
  901.  
  902.   (* -------------------------------------------------------------- *)
  903.   (* Ein TFileWindow für das Verzeichnis Path mit den Masken Masks  *)
  904.   (* öffnen. Zuerst wird mit einem BroadCast cmDirInWin geprüft, ob *)
  905.   (* ein Fenster dieses Verzeichnis bereits darstellt. Wenn ja, wird*)
  906.   (* es in den Vordergrund geholt (MakeFirst). Sonst wird die Grösse*)
  907.   (* des neuen Fensters von dem aktiven, falls schon eins sichtbar  *)
  908.   (* ist, übernommen. Dabei wird vorausgesetzt, dass die aktive View*)
  909.   (* ein TFileWindow ist. Das wird von DoAction überprüft, das diese*)
  910.   (* Prozedur aufruft. Dann wird das Fenster in die Arbeitsfläche   *)
  911.   (* eingefügt. Falls noch keine View eingefügt ist, wird das Fen-  *)
  912.   (* ster zentiert.                                                 *)
  913.   (* -------------------------------------------------------------- *)
  914.   PROCEDURE DoOpenFileWin (Path, Masks : STRING);
  915.     CONST
  916.       Dir : STRING = '';
  917.     VAR
  918.       R : TRect;
  919.       FW : PFileWindow;
  920.   BEGIN
  921.     Dir := Path;
  922.     FW := Message (Desktop, evBroadCast, cmDirInWin, @Dir);
  923.     IF FW<>NIL THEN
  924.       FW^.MakeFirst
  925.     ELSE BEGIN
  926.       IF Desktop^.Current <> NIL THEN BEGIN
  927.         Desktop^.Current^.GetBounds (R);
  928.         Inc (R.A.X); Inc (R.A.Y);
  929.       END ELSE
  930.         R.Assign (0, 0, 47, 18);
  931.  
  932.       Inc (WinNr);  { mitzählen Anzahl Fenster }
  933.  
  934.       FW := New (PFileWindow,
  935.                  Init (R, WinNr, UpString (Path), Masks));
  936.       FW^.Options := FW^.Options OR ofTileable;
  937.       IF Desktop^.Current=NIL THEN
  938.         FW^.Options := FW^.Options OR ofCentered;
  939.       Desktop^.Insert (ValidView (FW));
  940.       ClearEvent (Event);
  941.     END;
  942.   END;
  943.  
  944.   (* -------------------------------------------------------------- *)
  945.   (* DoAction wird aufgerufen, wenn HandleEvent ein cmItemSelected  *)
  946.   (* abarbeitet. In CurDir wird zunächst das Verzeichnis des aktiven*)
  947.   (* TFileWindow's eingetragen. Dabei wird angenommen, das die      *)
  948.   (* aktive View ein TFileWindow ist, da nur dieses cmItemSelected  *)
  949.   (* aussendet. Ist der in Event.InfoPtr übergebene Item ein        *)
  950.   (* Directory, so wird ein neues Fenster geöffnet (NewWinBySel=    *)
  951.   (* TRUE) mit dem neuen Verzeichnis oder dem aktiven ein neues Ver-*)
  952.   (* zeichnis zugewiesen. Ist der Item ein ausführbares Programm,   *)
  953.   (* so wird die DosShell mit CurDir+'\'+Info^.Name aufgerufen.     *)
  954.   (* Parameter werden dem Programm keine mitgegeben.                *)
  955.   (* -------------------------------------------------------------- *)
  956.   PROCEDURE DoAction;
  957.     VAR
  958.       Info   : PSearchRec;
  959.       CurDir : STRING;
  960.       TopFW  : PFileWindow;
  961.   BEGIN
  962.     TopFW := PFileWindow (Desktop^.Current);
  963.     CurDir := TopFW^.GetDirectory;
  964.     Info := Event.InfoPtr;
  965.     IF (Info^.Attr AND Directory > 0) THEN BEGIN
  966.       IF NewWinBySel THEN
  967.         DoOpenFileWin (GetNewDir (CurDir, Info), TopFW^.GetMasks)
  968.       ELSE
  969.         TopFW^.SetDirectory (GetNewDir (CurDir, Info));
  970.     END ELSE 
  971.       IF (Pos ('.COM', Info^.Name) > 0) OR
  972.          (Pos ('.EXE', Info^.Name) > 0) OR
  973.          (Pos ('.BAT', Info^.Name) > 0) THEN
  974.         DosShell (CurDir+'\'+Info^.Name, '');
  975.   END;
  976.  
  977.   (* -------------------------------------------------------------- *)
  978.   (* DoTile und DoCascade brauchen nur die Grösse des Desktop's     *)
  979.   (* festzustellen, den Rest übernimmt dieser selber.               *)
  980.   (* -------------------------------------------------------------- *)
  981.   PROCEDURE DoTile;
  982.     VAR R : TRect;
  983.   BEGIN
  984.     Desktop^.GetExtent (R);
  985.     Desktop^. Tile (R);
  986.   END;
  987.  
  988.   PROCEDURE DoCascade;
  989.     VAR R : TRect;
  990.   BEGIN
  991.     Desktop^.GetExtent (R);
  992.     Desktop^.Cascade (R);
  993.   END;
  994.  
  995.   (* -------------------------------------------------------------- *)
  996.   (* EnterNewMask fordert den Benutzer in einer InputBox auf, eine  *)
  997.   (* neue Suchmaske einzugeben (mehrere können durch "/" getrennt   *)
  998.   (* eingegeben werden), doch nur, wenn die aktive View vom Typ     *)
  999.   (* TFileWindow ist.                                               *)
  1000.   (* -------------------------------------------------------------- *)
  1001.   PROCEDURE EnterNewMask;
  1002.     VAR w : WORD;
  1003.         FW: PFileWindow;
  1004.         s : STRING;
  1005.   BEGIN
  1006.     IF TypeOf (Desktop^.Current^)=TypeOf (TFileWindow) THEN BEGIN
  1007.       FW := PFileWindow (Desktop^.Current);
  1008.       s := FW^.GetMasks;
  1009.       w := InputBox (' Eingabe der neuen Suchmaske(n) ',
  1010.                      '', s, 40);
  1011.       IF (w=cmOk) THEN
  1012.         FW^.SetMasks (UpString (s));
  1013.     END;
  1014.   END;
  1015.  
  1016.   (* -------------------------------------------------------------- *)
  1017.   (* Ist die aktive View ein TFileWindow, so wird ihr Verzeichnis   *)
  1018.   (* in die InputBox übernommen. Ist das eingegebene Verzeichnis    *)
  1019.   (* gültig, so wird, wieder in Abhängigkeit von NewWinBySel,       *)
  1020.   (* reagiert, falls die Eingabe nicht abgebrochen wurde.           *)
  1021.   (* -------------------------------------------------------------- *)
  1022.   PROCEDURE EnterNewDir;
  1023.     VAR w : WORD;
  1024.         FW: PFileWindow;
  1025.         m, s : STRING;
  1026.   BEGIN
  1027.     IF TypeOf (Desktop^.Current^)=TypeOf (TFileWindow) THEN BEGIN
  1028.       FW := PFileWindow (Desktop^.Current);
  1029.       s := FW^.GetDirectory;
  1030.     END ELSE BEGIN
  1031.       FW := NIL;
  1032.       s := '';
  1033.     END;
  1034.     m := '*.*';
  1035.     w := InputBox (' Eingabe des neuen Verzeichnisses ',
  1036.                    '', s, 255);
  1037.     IF s='' THEN
  1038.       s := GetDir (0);
  1039.     IF (PathValid (s)) AND (w=cmOk) THEN BEGIN
  1040.       IF s [Length (s)]='\' THEN Dec (s [0]);
  1041.       IF (NewWinBySel) OR (WinNr=0) THEN
  1042.         DoOpenFileWin (UpString (s), m)
  1043.       ELSE
  1044.         IF (w=cmOk) AND (FW <> NIL) THEN
  1045.           FW^.SetDirectory (UpString (s));
  1046.     END;
  1047.   END;
  1048.  
  1049. BEGIN
  1050.   IF (Event.What=EvCommand) AND
  1051.      (Event.Command=cmClose) AND
  1052.      (WinNr > 0) THEN
  1053.     Dec (WinNr);
  1054.     { mitzählen, muss aber vor der Behandlung durch
  1055.       TApplication.HandleEvent erledigt werden, weil danach das
  1056.       Ereignis schon abgearbeitet ist und auch als solches
  1057.       gekennzeichnet. }
  1058.  
  1059.   TApplication.HandleEvent (Event);
  1060.  
  1061.   IF Event.What=EvBroadCast THEN
  1062.     CASE Event.Command OF
  1063.       cmItemSelected : DoAction;
  1064.     END;
  1065.  
  1066.   IF Event.What=EvCommand THEN
  1067.     CASE Event.Command OF
  1068.       cmOpenFileWin : DoOpenFileWin (GetDir (0), '*.*');
  1069.       cmTile        : DoTile;
  1070.       cmCascade     : DoCascade;
  1071.       cmToggleNewWin: NewWinBySel := NOT NewWinBySel;
  1072.       cmDosShell    : DosShell (GetEnv('COMSPEC'), '');
  1073.       cmClearDesk   : ClearDesktop;
  1074.       cmEnterNewMask: EnterNewMask;
  1075.       cmEnterNewDir : EnterNewDir;
  1076.     END;
  1077. END;
  1078.  
  1079. END.
  1080. (* ---------------------------------------------------------------- *)
  1081. (*                         Ende von FILEWIN.PAS                     *)
  1082. (* ---------------------------------------------------------------- *)
  1083.