home *** CD-ROM | disk | FTP | other *** search
/ The Devil's Doorknob BBS Capture (1996-2003) / devilsdoorknobbbscapture1996-2003.iso / Dloads / OTHERUTI / TPASCAL3.ZIP / TVDEMOS.ZIP / TVTXTDMO.PAS < prev   
Pascal/Delphi Source File  |  1991-06-11  |  4KB  |  154 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Pascal 6.0                             }
  4. {   Turbo Vision TTerminal demo program          }
  5. {                                                }
  6. {   Copyright (c) 1990 by Borland International  }
  7. {                                                }
  8. {************************************************}
  9.  
  10. program TVTxtDmo;
  11.  
  12. {$M 16384,16384,655360}
  13.  
  14. uses Dos, Objects, Views, TextView, MsgBox, App;
  15.  
  16. type
  17.   PTerminalWindow = ^TTerminalWindow;
  18.   TTerminalWindow = object(TWindow)
  19.     constructor Init(Bounds: TRect; WinTitle: String; WindowNo: Word;
  20.       var Interior: PTerminal; ABufSize: Word);
  21.     function MakeInterior(Bounds: TRect; ABufSize: Word): PTerminal;
  22.   end;
  23.  
  24.   PMyApp = ^TMyApp;
  25.   TMyApp = object(TApplication)
  26.     constructor Init;
  27.     procedure ShowTerminalWindow;
  28.   end;
  29.  
  30. procedure CheckParamList;
  31. var
  32.   F: file;
  33. begin
  34.   if ParamCount <> 1 then
  35.   begin
  36.     Writeln('Syntax: TVTXTDMO <file to view>');
  37.     Halt(1);
  38.   end;
  39.  
  40.   Assign(F, ParamStr(1));
  41.   {$I-}
  42.   Reset(F);
  43.   {$I+}
  44.   if IOResult <> 0 then
  45.   begin
  46.     Writeln('Cannot open file (', ParamStr(1), ')');
  47.     Halt(1);
  48.   end;
  49.  
  50.   Close(F);
  51. end;
  52.  
  53. { TTerminalWindow }
  54. constructor TTerminalWindow.Init(Bounds: TRect; WinTitle: String;
  55.   WindowNo: Word; var Interior: PTerminal; ABufSize: Word);
  56. begin
  57.   TWindow.Init(Bounds, WinTitle, WindowNo);
  58.   Interior := MakeInterior(Bounds, ABufSize);
  59.   Insert(Interior);
  60. end;
  61.  
  62. function TTerminalWindow.MakeInterior(Bounds: TRect;
  63.   ABufSize: Word): PTerminal;
  64. begin
  65.   GetExtent(Bounds);
  66.   Bounds.Grow(-1, -1);
  67.   MakeInterior := New(PTerminal, Init(Bounds,
  68.     StandardScrollBar(sbHorizontal + sbHandleKeyboard),
  69.     StandardScrollBar(sbVertical + sbHandleKeyboard),
  70.     ABufSize));
  71. end;
  72.  
  73. constructor TMyApp.Init;
  74. begin
  75.   CheckParamList;
  76.   TApplication.Init;
  77.   ShowTerminalWindow;
  78. end;
  79.  
  80. procedure TMyApp.ShowTerminalWindow;
  81. var
  82.   Demo: PTerminalWindow;
  83.   Interior: PTerminal;
  84.   T: Text;
  85.   R: TRect;
  86.   FText: Text;
  87.   FGeneric: file of byte;
  88.   St: String;
  89.   Result: Word;
  90.  
  91. const
  92.   BuffSize: Word = 8192;
  93.  
  94. begin
  95.   { Open the file as a generic DOS file to get the file size.
  96.     CheckParamList has already verified that the file exists
  97.     and can be opened. }
  98.   Assign(FGeneric, ParamStr(1));
  99.   Reset(FGeneric);
  100.  
  101.   if MaxAvail - 1000 < BuffSize then
  102.     BuffSize := MaxAvail - 1024;   { leave at least 1K free }
  103.  
  104.   if FileSize(FGeneric) > BuffSize then
  105.   begin
  106.     Str(BuffSize, St);
  107.     { ignore  result, just post a message }
  108.     Result := MessageBox('File is too big to fit in a TTerminal buffer.'#13+
  109.       'Only the first ' + st + ' bytes of the file ' +
  110.       'will be displayed.', nil, mfOkButton + mfWarning);
  111.     end
  112.   else
  113.     { filesize < buffsize, so reduce the buffer size to conserve RAM }
  114.     BuffSize := FileSize(FGeneric);
  115.  
  116.   Close(FGeneric);
  117.  
  118.   { Initialize the terminal window object }
  119.   R.Assign(10, 1, 70, 18);
  120.   Demo := New(PTerminalWindow, Init(R, ParamStr(1), wnNoNumber,
  121.     Interior, BuffSize));
  122.   Desktop^.Insert(Demo);
  123.  
  124.   { Assign the TTerminal interior text device driver to a text "file" }
  125.   AssignDevice(T,PTerminal(Interior));
  126.   Rewrite(T);
  127.   Writeln(T, '');
  128.  
  129.   { Open the file as a text file for reading. }
  130.   Assign(FText, ParamStr(1));
  131.   Reset(FText);
  132.  
  133.   { Copy lines into scroller until eof or buffer is full }
  134.   repeat
  135.     Readln(FText, St);
  136.     Writeln(T, St);
  137.   until Eof(FText) or (not Interior^.CanInsert(Length(St)));
  138.  
  139.   Close(FText);
  140.   Close(T);
  141.  
  142.   { set the scroller to its top }
  143.   Interior^.ScrollTo(0, 0);
  144. end;
  145.  
  146. var
  147.   MyMain: TMyApp;
  148.  
  149. begin
  150.   MyMain.Init;
  151.   MyMain.Run;
  152.   MyMain.Done;
  153. end.
  154.