home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1995 November / PCWK1195.iso / inne / podstawy / dos / 4dos / 4uzytki / tfc22c.exe / TCV.PAS < prev    next >
Pascal/Delphi Source File  |  1993-11-03  |  22KB  |  736 lines
  1. {$X+}
  2. {
  3.     TCV Tobi's Catalogue Vison  Version 2.2  11-3-93, 9:35 AM
  4.     
  5.        This BP source is released into the Public Domain
  6.        Feel free to make changes to this program but
  7.        don't remove my name and address ...
  8.  
  9.        Let me know if you made any enhancements or if
  10.        you find errors ...
  11.  
  12.        Thanks for Additions and Corrections to:
  13.  
  14.                . David Frey (no e-Mail)
  15.                . Thomas Ludwig (ludwig@informatik.tu-muenchen.de)
  16.                . Maettu Studer (no e-Mail)
  17.                . Robert Juhasz (robertj@uni-paderborn.de)
  18.  
  19.        Written by
  20.  
  21.                  Tobi Oetiker (oetiker@stud.ee.ethz.ch or 2:301/516.2@fido)
  22.                  Gallusstrasse 25 / CH-4600 Olten / FAX +41 62 32 61
  23.  
  24.       Revisions:
  25.          
  26.             V2.2 --- . Highlighted Current Search String.
  27. }
  28.  
  29. Program Tobis_Catalog_Vision;
  30. {$M 16384,16384,655360}
  31. Uses App, Objects, Menus, Drivers, Views, Dialogs, MsgBox, Memory, DOS, 
  32.      HistList, fix;
  33.  
  34. Const VERSION = '2.2';
  35. Type
  36.   TTCV = Object (TApplication)
  37.            DWPresent: Boolean;
  38.            Constructor Init;
  39.            Procedure InitStatusline; Virtual;
  40.            Procedure InitMenuBar; Virtual;
  41.            Procedure InitDesktop; Virtual;
  42.            Procedure DataWindow;
  43.          End;
  44.   
  45.   PDataWin = ^TDataWin;
  46.   TDataWin = Object (TDialog)
  47.              End;
  48.   
  49.   PTCVStatLine = ^TTCVStatLine;
  50.   TTCVStatLine = Object (TStatusLine)
  51.                    Function Hint (AHelpCtx: Word): String; Virtual;
  52.                    Procedure Draw; Virtual;
  53.                    
  54.                  End;
  55.   
  56.   PDiskCol = ^TDiskCol;
  57.   TDiskCol = Object (TStringcollection)
  58.                LineBuf: String;
  59.                LineBufNr: Integer;
  60.                EntryBuf: Array [1..6] Of String [80];
  61.                EntryBufNr: Integer;
  62.                Constructor Init (ALimit, ADelta: Integer);
  63.  
  64.                Function GetEntry (Zeile: Integer; Nummer: Byte): String;
  65.                Function FindNext (Start: Integer; Key: String): Integer;
  66.                Function FindPrev (Start: Integer; Key: String): Integer;
  67.                Function DirLine (Welche: Integer): String;
  68.              End;
  69.   
  70.   PDirBox = ^TDirBox;
  71.   TDirBox = Object (TListBox)
  72.               Search: String;
  73.               Constructor Init (Var Bounds: TRect; ANumCols: Word;
  74.               AScrollBar: PScrollBar);
  75.               Destructor Done; Virtual;
  76.               Procedure Draw; Virtual;
  77.               Procedure HandleEvent (Var Event: TEvent); Virtual;
  78.             End;
  79.   PHButton = ^THButton;
  80.   THButton = Object (TButton)
  81.                Constructor Init (Var Bounds: TRect; ATitle: TTitleStr;
  82.                ACommand: Word; AFlags: Word; Hnr: Word);
  83.              End;
  84. Const  hcBrowseMode = 1000;
  85.   hcSearchMode = 1003;
  86.   hcSearching = 1004;
  87.   hcReading = 1005;
  88.   hcAbout = 1006;
  89.   hcInfo = 1007;
  90.   hcExit = 1008;
  91.   cmInfo = 100;
  92.   cmAbout = 101;
  93.   
  94. Function NoCasePos (a, b: String): Byte;
  95.   Var i: Integer;
  96.   Begin
  97.     If Length (a) > 0 Then
  98.     Begin
  99.       For i := 1 To Length (a) Do a [i] := UpCase (a [i] );
  100.       For i := 1 To Length (b) Do b [i] := UpCase (b [i] );
  101.       NoCasePos := Pos (a, b);
  102.     End
  103.     Else
  104.       NoCasePos := 0;
  105.   End;
  106.  
  107. Function LineCheck (S: String): Boolean;
  108. Var i, l: Byte;
  109. Begin
  110.   i := 2;
  111.   l := Length (s);
  112.   If s [1] = '"' Then
  113.   Begin
  114.     While (i < l) And Not (s [i] = '"') Do Inc (i);
  115.     If i < l Then
  116.     Begin
  117.       i := i + 3;
  118.       While (i < l) And Not (s [i] = '"') Do Inc (i);
  119.       If i < l Then
  120.       Begin
  121.         i := i + 3;
  122.         While (i < l) And Not (s [i] = '"') Do Inc (i);
  123.         If i < l Then
  124.         Begin
  125.           i := i + 3;
  126.           While (s [i] >= '0') And (s [i] <= '9') And (i < l) Do Inc (i);
  127.           If s [i] = ',' Then
  128.           Begin
  129.             i := i + 2;
  130.             While (i < l) And Not (s [i] = '"') Do Inc (i);
  131.             If i < l Then
  132.             Begin
  133.               i := i + 3;
  134.               While (i < l) And Not (s [i] = '"') Do Inc (i);
  135.               If s [i] = '"' Then
  136.               Begin
  137.                 LineCheck := True;
  138.                 Exit;
  139.               End;
  140.             End;
  141.           End;
  142.         End;
  143.       End;
  144.     End;
  145.   End;
  146.   LineCheck := False;
  147. End;
  148.  
  149.  
  150. Function ToString (STRP: PString): String;
  151. Begin
  152.   If STRP <> Nil Then
  153.     ToString := STRP^
  154.   Else
  155.     ToString := '"#ERROR#","x","x",2,"x","x"';
  156. End;
  157.  
  158. Constructor THButton. Init (Var Bounds: TRect; ATitle: TTitleStr;
  159.              ACommand: Word; AFlags: Word; Hnr: Word);
  160. Begin
  161.   TButton. Init (Bounds, ATitle, ACommand, AFlags);
  162.   HelpCtx := Hnr;
  163. End;
  164.  
  165. Function TDiskCol. GetEntry (Zeile: Integer; Nummer: Byte): String;
  166. Var zeiger, i: Byte;
  167.   s: String;
  168. Begin
  169.   If Zeile <> EntryBufNr Then
  170.   Begin
  171.     s := ToString (At (Zeile) );
  172.     EntryBufNr := Zeile;
  173.     i := 2;
  174.     Zeiger := 2;
  175.     While s [Zeiger] <> '"' Do Inc (Zeiger);
  176.     EntryBuf [1] := Copy (s, i, Zeiger - i);
  177.     
  178.     i := Zeiger + 3;
  179.     Zeiger := i;
  180.     While s [Zeiger] <> '"' Do Inc (Zeiger);
  181.     EntryBuf [2] := Copy (s, i, Zeiger - i);
  182.     i := Zeiger + 3;
  183.     Zeiger := i;
  184.     While s [Zeiger] <> '"' Do Inc (Zeiger);
  185.     EntryBuf [3] := Copy (s, i, Zeiger - i);
  186.     i := Zeiger + 2;
  187.     Zeiger := i;
  188.     While s [Zeiger] <> ',' Do Inc (Zeiger);
  189.     EntryBuf [4] := Copy (s, i, Zeiger - i);
  190.     i := Zeiger + 2;
  191.     Zeiger := i;
  192.     While s [Zeiger] <> '"' Do Inc (Zeiger);
  193.     EntryBuf [5] := Copy (s, i, Zeiger - i);
  194.     i := Zeiger + 3;
  195.     Zeiger := i;
  196.     While s [Zeiger] <> '"' Do Inc (Zeiger);
  197.     EntryBuf [6] := Copy (s, i, Zeiger - i);
  198.   End;
  199.   GetEntry := EntryBuf [Nummer];
  200. End;
  201.  
  202. Function TDiskCol. DirLine (Welche: Integer): String;
  203. Var LS, DI, Fi, Co: String;
  204. Const Space = '                            ';
  205. Begin;
  206.   If Welche = LineBufNr Then
  207.   Begin
  208.     DirLine := LineBuf;
  209.     Exit;
  210.   End;
  211.   DI := ' ' + Copy (GetEntry (Welche, 1) + Space, 1, 14);
  212.   Fi := Copy (GetEntry (Welche, 3) + Space, 1, 15);
  213.   Co := GetEntry (Welche, 5);
  214.   LineBuf := DI + Fi + Co;
  215.   LineBufNr := Welche;
  216.   DirLine := LineBuf;
  217. End;
  218.  
  219. Constructor TDiskCol. Init (ALimit, ADelta: Integer);
  220. Begin
  221.   TStringCollection. Init (ALimit, ADelta);
  222.   LineBufNr := - 1;
  223.   EntryBufNr := - 1;
  224. End;
  225.  
  226. Function TDiskCol. FindNext (Start: Integer; Key: String): Integer;
  227. Var i: Integer;
  228.   p: Byte;
  229. Begin
  230.   If (Start >= 0) And (Start < Count) And (Key <> '') Then
  231.   Begin
  232.     i := Start - 1;
  233.     p := 0;
  234.     While (i < Count - 1) And (p = 0) Do
  235.     Begin
  236.       Inc (i);
  237.       p := NoCasePos (Key, DirLine (i) );
  238.     End;
  239.     If p = 0 Then
  240.       FindNext := Start
  241.     Else
  242.       FindNext := i;
  243.   End
  244.   Else
  245.     FindNext := 0;
  246. End;
  247.  
  248. Function TDiskCol. FindPrev (Start: Integer; Key: String): Integer;
  249. Var i, p: Integer;
  250. Begin
  251.   If (Start >= 1) And (key <> '') Then
  252.   Begin
  253.     i := Start;
  254.     p := 0;
  255.     While (i >= 1) And (p = 0) Do
  256.     Begin
  257.       Dec (i);
  258.       p := NoCasePos (Key, DirLine (i) );
  259.     End;
  260.     FindPrev := i;
  261.   End
  262.   Else
  263.     FindPrev := Start;
  264. End;
  265.  
  266.  
  267. Destructor TDirBox. Done;
  268. Begin
  269.   NewList (Nil);
  270.   TListBox. Done;
  271. End;
  272.  
  273. Constructor TDirBox. Init (Var Bounds: TRect; ANumCols: Word;
  274.                              AScrollBar: PScrollBar);
  275.  
  276.  
  277. Var DataCol: PDiskCol;
  278.   LineCount: LongInt;
  279.   err: Boolean;
  280.   
  281. Procedure ReadFile;
  282.    Var
  283.      F: Text;
  284.      S: String;
  285.      propah: PathStr;
  286.      
  287.    Function FiletoRead: PathStr;
  288.      Var
  289.        EXEName: PathStr;
  290.        Dir: DirStr;
  291.        Name: NameStr;
  292.        Ext: ExtStr;
  293.        gefunden: PathStr;
  294.      Begin
  295.        If Lo (DosVersion) >= 3 Then EXEName := ParamStr (0)
  296.        Else EXEName := FSearch ('TCV.EXE', GetEnv ('PATH') );
  297.        FSplit (EXEName, Dir, Name, Ext);
  298.        If Dir [Length (Dir) ] = '\' Then Dec (Dir [0] );
  299.        FiletoRead := FSearch ('PROGS.TFC', Dir);
  300.        blockCursor;
  301.      End;
  302.  
  303.    Begin
  304.      err := False;
  305.      LineCount := 0;
  306.      DataCol := New (PDiskCol, Init (1000, 10) );
  307.      ProPah := FiletoRead;
  308.      {$I-}
  309.      Assign (f, ProPah);
  310.      Reset (f);
  311.      {$I+}
  312.      If IOResult <> 0 Then err := True Else
  313.        If ProPah = '' Then err := True Else
  314.          If EoF (F) Then err := True;
  315.      If err Then
  316.      Begin
  317.        MessageBox ('Cannot open file ' + ProPah + #13 + 'Read the docs and create an PROGS.TFC file using TFC.BTM',
  318.        Nil, mfError + mfOkButton);
  319.        DataCol^. Insert (NewStr ('"No Data"," "," ",3," "," "') );
  320.      End
  321.      Else
  322.      Begin
  323.        While Not EoF (F) And Not LowMemory Do
  324.        Begin
  325.          ReadLn (F, S);
  326.          Inc (LineCount);
  327.          If LineCheck (S) Then DataCol^. Insert (NewStr (S) )
  328.          Else
  329.          Begin
  330.            MessageBox ('Error in Line %d of Data File', @LineCount, mfError + mfOkButton);
  331.            Statusline^. Update;
  332.          End;
  333.        End;
  334.        If LowMemory Then
  335.          MessageBox ('Couldn''t read all Entries from File due to Memory shortage.', Nil, mfError + mfOkButton);
  336.        Close (F);
  337.      End;
  338.    End;
  339.  
  340. Begin
  341.   TListbox. Init (Bounds, ANumCols, AScrollBar);
  342.   HelpCtx := hcReading;
  343.   StatusLine^. Update;
  344.   ReadFile;
  345.   EventMask := EventMask Or evCommand;
  346.   options := options Or ofPostProcess;
  347.   Search := '';
  348.   HelpCtx := hcBrowseMode;
  349.   NewList (DataCol);
  350. End;
  351.  
  352. Procedure TDirBox. HandleEvent (Var Event: TEvent);
  353. Var p: Byte;
  354.   r: TRect;
  355.   Mouse: TPoint;
  356.   ha: Word;
  357.   from, found, f: Integer;
  358.   
  359. Procedure InfoBox (n: Integer);
  360.   Var Pinfo: PDialog;
  361.     R: TRect;
  362.   Begin
  363.     R. Assign (8, 6, 72, 17);
  364.     Pinfo := New (PDialog, Init (R, 'Info Box') );
  365.     With Pinfo^ Do
  366.     Begin
  367.       GetExtent (R);
  368.       R. Grow ( - 3, - 2);
  369.       R. B. Y := R. A. Y + 1;
  370.       Insert (New (PStaticText, Init (R, 'Disk Label:  ' + PDiskCol (List)^. GetEntry (n, 1) ) ) );
  371.       R. Move (0, 1);
  372.       Insert (New (PStaticText, Init (R, 'File Name:   ' + PDiskCol (List)^. GetEntry (n, 3) ) ) );
  373.       R. Move (0, 1);
  374.       Insert (New (PStaticText, Init (R, 'File Date:   ' + PDiskCol (List)^. GetEntry (n, 2) ) ) );
  375.       R. Move (0, 1);
  376.       Insert (New (PStaticText, Init (R, 'Space Used:  ' + PDiskCol (List)^. GetEntry (n, 4) + ' Bytes') ) );
  377.       R. Move (0, 1);
  378.       Insert (New (PStaticText, Init (R, 'Description: ' + PDiskCol (List)^. GetEntry (n, 5) ) ) );
  379.       R. Move (0, 1);
  380.       Insert (New (PStaticText, Init (R, 'Scan Date:   ' + PDiskCol (List)^. GetEntry (n, 6) ) ) );
  381.       GetExtent (R);
  382.       R. Grow ( - 2, - 1);
  383.       R. A. Y := R. B. Y - 2;
  384.       R. A. X := R. B. X - 10;
  385.       Insert (New (PButton, init (R, '~O~K', cmCancel, bfNormal) ) );
  386.       Desktop^. ExecView (Pinfo);
  387.     End;
  388.   End;
  389.  
  390. Begin
  391.   If (Event. What = evMouseDown) Then
  392.     If (Event. Double) Then
  393.     Begin
  394.       makelocal (Event. Where, Mouse);
  395.       If Mouse. Y + Topitem < range - 1 Then
  396.       Begin
  397.         If Mouse. Y + TopItem <> Focused Then
  398.         Begin
  399.           Search := '';
  400.           FocusItem (Mouse. Y + Topitem);
  401.         End;
  402.         InfoBox (focused);
  403.         ClearEvent (Event);
  404.       End;
  405.     End;
  406.   If Event. What = evCommand Then
  407.     Case Event. Command Of
  408.       cmInfo:
  409.              Begin
  410.                InfoBox (focused);
  411.                ClearEvent (Event);
  412.              End;
  413.       cmAbout:
  414.               Begin
  415.                 Desktop^. Getextent (R);
  416.                 R. Grow ( - 15, - 4);
  417.                 r. Move (0, - 2);
  418.                 MessageBoxRect (R, #3 + 'CREADTED in Nov''93 BY' + #13 + #13 + #3 + 'Tobias Oetiker' + #13 +
  419.                 + #3 + 'Gallusstrasse 25' + #13 + #3 + 'CH-4600 Olten'
  420.                 + #13 + #3 + 'Switzerland' + #13 + #13 + #3 + 'eMail oetiker@stud.ee.ethz.ch'
  421.                 + #13 + #13 + #3 + 'USING Turbo Pascal 7.0 and Turbo Vision',
  422.                 Nil, mfInformation + mfOkButton);
  423.                 ClearEvent (Event);
  424.               End;
  425.     End;
  426.   If (Owner^. Phase <> phFocused) Then Exit;
  427.   If (Event. What = evKeyDown) Then
  428.   Begin
  429.     
  430.     Case Event. CharCode Of
  431.       #32..#255:
  432.                 Begin
  433.                   If Length (Search) = 0 Then
  434.                     from := 0
  435.                   Else
  436.                     from := focused;
  437.                   HelpCtx := hcSearching;
  438.                   StatusLine^. Update;
  439.                   found := PDiskCol (List)^. FindNext (from, Search + Event. CharCode);
  440.                   p := NoCasePos (Search + Event. CharCode, PDiskCol (List)^. DirLine (found) );
  441.                   If p > 0 Then
  442.                     search := search + Event. CharCode
  443.                   Else
  444.                     MessageBox ('There is no Line to match "' +
  445.                     search + Event. CharCode + '".',
  446.                     Nil, mfError + mfOkButton);
  447.                   If found = focused Then
  448.                     Draw
  449.                   Else
  450.                     FocusItem (found);
  451.                   ClearEvent (Event);
  452.                 End;
  453.       #08:
  454.           Begin
  455.             If Length (Search) > 0 Then
  456.             Begin
  457.               Dec (Search [0] );
  458.               HelpCtx := hcSearching;
  459.               StatusLine^. Update;
  460.               found := PDiskCol (List)^. FindNext (0, Search);
  461.               If found = focused Then draw
  462.               Else FocusItem (found);
  463.             End;
  464.             ClearEvent (Event);
  465.           End;
  466.       Else
  467.         
  468.         Case ctrlToArrow (Event. KeyCode) Of
  469.           kbUp:
  470.                  If (Length (Search) > 0) And (Focused > 0) Then
  471.                  Begin
  472.                    HelpCtx := hcSearching;
  473.                    StatusLine^. Update;
  474.                    found := PDiskCol (List)^. FindPrev (Focused, Search);
  475.                    p := NoCasePos (Search, PDiskCol (List)^. DirLine (found) );
  476.                    If p = 0 Then
  477.                    Begin
  478.                      If MessageBox ('There is no more Line to match "' +
  479.                         search + '".',
  480.                         Nil, mfError + mfOkCancel) = 10
  481.                      Then
  482.                      Begin
  483.                        Search := '';
  484.                        If Focused > 0 Then found := Focused - 1;
  485.                      End Else found := Focused;
  486.                    End;
  487.                    FocusItem (found);
  488.                    ClearEvent (Event);
  489.                  End;
  490.           
  491.           kbDown:
  492.                    If (Length (Search) > 0) And (Focused < (Range - 1) ) Then
  493.                    Begin
  494.                      HelpCtx := hcSearching;
  495.                      StatusLine^. Update;
  496.                      found := PDiskCol (List)^. FindNext (Focused + 1, Search);
  497.                      p := NoCasePos (Search, PDiskCol (List)^. DirLine (found) );
  498.                      If p = 0 Then
  499.                      Begin
  500.                        If MessageBox ('There is no more Line to match "' +
  501.                           search + '".',
  502.                           Nil, mfError + mfOKCancel) = 10
  503.                        Then
  504.                        Begin
  505.                          Search := '';
  506.                          If Focused < Range - 1 Then found := Focused + 1;
  507.                        End Else found := Focused;
  508.                      End;
  509.                      FocusItem (found);
  510.                      ClearEvent (Event);
  511.                    End;
  512.           kbEnter:
  513.                   Begin
  514.                     InfoBox (focused);
  515.                     ClearEvent (Event);
  516.                   End;
  517.           Else
  518.             Search := '';
  519.           Draw;
  520.         End;
  521.     End;
  522.     If Search = '' Then  HelpCtx := hcBrowseMode
  523.     Else HelpCtx := hcSearchMode;
  524.   End;
  525.   TListBox. HandleEvent (Event);
  526. End;
  527.  
  528. Procedure TDirBox. Draw;
  529. Var i, CursorX: Integer;
  530.   Line: TDrawBuffer;
  531.   LCOL, MarkCol: Word;
  532.   p: Integer;
  533.   SelLine: String;
  534. Begin;
  535.   For i := 0 To Size. Y Do
  536.   Begin
  537.     Lcol := GetColor (1);
  538.     MoveChar (Line, ' ', LCol, Size. X);
  539.     If (i + TopItem) < List^. Count Then
  540.     Begin
  541.       If (i + TopItem = Focused) Then
  542.       Begin
  543.         Lcol := GetColor (3);
  544.         Markcol := GetColor (5);
  545.         p := NoCasePos (Search, PDiskCol (List)^. DirLine (focused) );
  546.         If p > 0 Then
  547.         Begin
  548.           CursorX := p + Length (Search) - 1;
  549.           SetCursor (CursorX, i);
  550.           ShowCursor;
  551.           SelLine := PDiskCol (List)^. DirLine (i + TopItem);
  552.           Insert ('~', SelLine, CursorX + 1);
  553.           Insert ('~', SelLine, p);
  554.           MoveCStr (Line, SelLine, 256 * MarkCol + Lcol);
  555.         End
  556.         Else
  557.         Begin
  558.           Search := '';
  559.           HelpCtx := hcBrowseMode;
  560.           HideCursor;
  561.           MoveStr (Line, PDiskCol (List)^. DirLine (i + TopItem), Lcol);
  562.         End
  563.       End
  564.       Else
  565.         MoveStr (Line, PDiskCol (List)^. DirLine (i + TopItem), Lcol);
  566.     End;
  567.     WriteLine (0, i, Size. X, 1, Line);
  568.   End;
  569. End;
  570.  
  571. Constructor TTCV. Init;
  572. Begin
  573.   InitMemory;
  574.   InitVideo;
  575.   If ParamCount = 1 Then
  576.     If NocasePos ('LCD', ParamStr (1) ) > 0 Then setScreenMode (smBW80);
  577.   InitEvents;
  578.   InitSysError;
  579.   InitHistory;
  580.   TProgram. Init;
  581.   HelpCtx := hcReading;
  582.   StatusLine^. Update;
  583.   DataWindow;
  584.   HelpCtx := hcNoContext;
  585. End;
  586.  
  587. Procedure TTCV. DataWindow;
  588. Var
  589.   R, S: TRect;
  590.   Window: PDataWin;
  591.   SB: PScrollbar;
  592.   LB: PDirBox;
  593. Begin
  594.   Desktop^. GetExtent (R);
  595.   Window := New (PDataWin, Init (R, 'Tobis Catalog Vision Version ' + VERSION) );
  596.   With Window^ Do
  597.   Begin
  598.     Flags := $00;
  599.     DragMode := $00;
  600.     GrowMode := $00;
  601.     GetExtent (R);
  602.     R. Grow ( - 2, - 1);
  603.     R. A. X := R. B. X - 12;
  604.     R. A. Y := R. B. Y - 2;
  605.     R. Move ( - 30, 0);
  606.     Insert (New (PHButton, init (R, '~I~nfo', cmInfo, bfNormal, hcInfo) ) );
  607.     R. Move (15, 0);
  608.     Insert (New (PHButton, init (R, '~A~bout', cmAbout, bfNormal, hcAbout) ) );
  609.     R. Move (15, 0);
  610.     Insert (New (PHButton, init (R, 'E~x~it', cmQuit, bfNormal, hcExit) ) );
  611.     GetExtent (R);
  612.     R. Grow ( - 2, - 3);
  613.     Inc (R. A. Y);
  614.     R. Move ( - 1, - 1);
  615.     Inc (R. A. X);
  616.     S := R;
  617.     S. A. X := S. B. X - 1;
  618.     S. Move (1, 0);
  619.     SB := New (PscrollBar, Init (S) );
  620.     LB := New (PDirBox, Init (R, 1, SB) );
  621.     GetExtent (R);
  622.     R. Grow ( - 2, - 2);
  623.     R. B. Y := R. A. Y + 1;
  624.     Insert (New (PLabel
  625.     , Init (R,
  626.     '~D~isk          File Name      Comment', LB) ) );
  627.     Insert (LB);
  628.     Insert (SB);
  629.   End;
  630.   Desktop^. Insert (Window);
  631. End;
  632.  
  633. Procedure TTCV. InitDesktop;
  634. Var R: TRect;
  635. Begin;
  636.   GetExtent (R);
  637.   Dec (R. B. Y);
  638.   Desktop := New (PDeskTop, Init (R) );
  639. End;
  640. Function TTCVStatLine. Hint (AHelpCtx: Word): String;
  641. Begin
  642.   Case HelpCtx Of
  643.     hcBrowseMode:  Hint := 'BROWSE MODE: Use [UP],[DOWN] to Browse or Enter a Word you are looking for.';
  644.     hcSearchMode: Hint := 'SEARCH MODE: [UP],[DOWN] for Next Match; Continue typing; [ESC] to Browse Mode';
  645.     hcSearching:  Hint := 'Searching ...   Please wait!';
  646.     hcReading:    Hint := 'Reading Data File from Disk ...    Please wait!';
  647.     hcInfo:       Hint := 'Press this button to get full information about the selected File';
  648.     hcAbout:      Hint := 'Pressing this button displays the autors address.';
  649.     hcExit:       Hint := 'Press Exit to terminate TCV.'
  650.     Else
  651.       Hint := '';
  652.   End;
  653. End;
  654. Procedure TTCVStatLine. Draw;
  655. Var Line: TDrawBuffer;
  656. Begin
  657.   MoveChar (Line, ' ', GetColor (1), Size. X);
  658.   MoveStr (Line, ' ' + Hint (GetHelpctx), GetColor (1) );
  659.   WriteLine (0, 0, Size. X, 1, Line);
  660. End;
  661.  
  662.  
  663. Procedure TTCV. InitStatusline;
  664. Var R: TRect;
  665. Begin
  666.   GetExtent (R);
  667.   R. A. Y := R. B. Y - 1;
  668.   StatusLine := New (PTCVStatLine, Init (R, Nil) );
  669. End;
  670.  
  671. Procedure TTCV. InitMenuBar;
  672.  
  673. Var R: TRect;
  674. Begin
  675. End;
  676.  
  677. Function GREP: Boolean;
  678. Var Line, Disk: String;
  679.   F: Text;
  680.   i: Byte;
  681. Begin
  682.   GREP := False;
  683.   If ParamStr (1) = '/GREP' Then
  684.   Begin
  685.     GREP := True;
  686.     {$I-}
  687.     Assign (F, GetEnv ('target') );
  688.     Reset (F);
  689.     {$I+}
  690.     If (IOResult <> 0) Or EoF (F) Then
  691.     Begin
  692.       WriteLn ('** Error Opening File ', GetEnv ('target') );
  693.       WriteLn ('   Use Format TCV /GREP');
  694.       WriteLn ('   With env vars target and dsklbl set')
  695.     End
  696.     Else
  697.     Begin
  698.       Disk := GetEnv ('dsklbl');
  699.       While Not EoF (F) Do
  700.       Begin
  701.         ReadLn (F, Line);
  702.         If NOCASEPOS (DISK, Line) <> 1 Then WriteLn (Line);
  703.       End;
  704.     End;
  705.   End;
  706. End;
  707.  
  708. Var
  709.   TCV: TTCV;
  710.  
  711. Begin
  712.   If Not GREP Then
  713.   Begin
  714.     LowMemSize := 20000 Div 16;
  715.     initFix;
  716.     TCV. Init;
  717.     doneFix;
  718.     TCV. Run;
  719.     TCV. Done;
  720.  
  721.     WriteLn ('Thanks for using TCV. This software, was created by:');
  722.     WriteLn ('                                                                ');
  723.     WriteLn (' Tobias Oetiker                                                  ');
  724.     WriteLn (' Gallusstr. 25,  CH-4600 Olten, Switzerland                   ');
  725.     WriteLn ('                                                            ');
  726.     WriteLn (' Internet:  oetiker@stud.ee.ethz.ch              ');
  727.     WriteLn (' Fidonet:   2:301/516.4');
  728.     WriteLn;
  729.     WriteLn ('This is Card-Ware: If you use this Software on a regular basis,');
  730.     Writeln ('                   please send me a Picture Post-Card from where you live.');
  731.     Writeln ('                   If you include your eMail address, I''ll inform you,');
  732.     Writeln ('                   when the next release of TFC gets available.');
  733.     WriteLn;
  734.   End;
  735. End.
  736.