home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l044 / 4.ddi / DOCDEMOS.ZIP / TVGUID06.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-10-23  |  4.1 KB  |  186 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Pascal 6.0                             }
  4. {   Demo program from the Turbo Vision Guide     }
  5. {                                                }
  6. {   Copyright (c) 1990 by Borland International  }
  7. {                                                }
  8. {************************************************}
  9.  
  10. { NOTE: This program intentionally puts up a window
  11.   that does not completely draw itself and the result
  12.   may be "garbage" characters on the screen.
  13. }
  14.  
  15. program TVGUID06;
  16.  
  17. uses Objects, Drivers, Views, Menus, App;
  18.  
  19. const
  20.   FileToRead        = 'TVGUID06.PAS';
  21.   MaxLines          = 100;
  22.   WinCount: Integer =   0;
  23.   cmFileOpen        = 100;
  24.   cmNewWin          = 101;
  25.  
  26. var
  27.   LineCount: Integer;
  28.   Lines: array[0..MaxLines - 1] of PString;
  29.    
  30. type
  31.   TMyApp = object(TApplication)
  32.     procedure InitStatusLine; virtual;
  33.     procedure InitMenuBar; virtual;
  34.     procedure NewWindow;
  35.     procedure HandleEvent(var Event: TEvent); virtual;
  36.   end;
  37.  
  38.   PDemoWindow = ^TDemoWindow;
  39.   TDemoWindow = object(TWindow)
  40.     constructor Init(Bounds: TRect; WinTitle: String; WindowNo: Word);
  41.   end;
  42.  
  43.   PInterior = ^TInterior;
  44.   TInterior = object(TView)
  45.     constructor Init(var Bounds: TRect);
  46.     procedure Draw; virtual;
  47.   end;
  48.  
  49. procedure ReadFile;
  50. var
  51.   F: Text;
  52.   S: String;
  53. begin
  54.   LineCount := 0;
  55.   Assign(F, FileToRead);
  56.   {$I-}
  57.   Reset(F);
  58.   {$I+}
  59.   if IOResult <> 0 then
  60.   begin
  61.     Writeln('Cannot open ', FileToRead);
  62.     Halt(1);
  63.   end;
  64.   while not Eof(F) and (LineCount < MaxLines) do
  65.   begin
  66.     Readln(F, S);
  67.     Lines[LineCount] := NewStr(S);
  68.     Inc(LineCount);
  69.   end;
  70.   Close(F);
  71. end;
  72.  
  73. procedure DoneFile;
  74. var
  75.   I: Integer;
  76. begin
  77.   for I := 0 to LineCount - 1 do
  78.     if Lines[I] <> nil then DisposeStr(Lines[i]);
  79. end;
  80.  
  81. { TInterior }
  82. constructor TInterior.Init(var Bounds: TRect);
  83. begin
  84.   TView.Init(Bounds);
  85.   GrowMode := gfGrowHiX + gfGrowHiY;
  86.   Options := Options or ofFramed;
  87. end;
  88.  
  89. procedure TInterior.Draw;
  90. var
  91.   Y: Integer;
  92. begin
  93.   for Y := 0 to Size.Y - 1 do
  94.   begin
  95.     WriteStr(0, Y, Lines[Y]^, $01);
  96.   end;
  97. end;
  98.  
  99. { TDemoWindow }
  100. constructor TDemoWindow.Init(Bounds: TRect; WinTitle: String; WindowNo: Word);
  101. var
  102.   S: string[3];
  103.   Interior: PInterior;
  104. begin
  105.   Str(WindowNo, S);
  106.   TWindow.Init(Bounds, WinTitle + ' ' + S, wnNoNumber);
  107.   GetClipRect(Bounds);
  108.   Bounds.Grow(-1,-1);
  109.   Interior := New(PInterior, Init(Bounds));
  110.   Insert(Interior);
  111. end;
  112.  
  113. { TMyApp }
  114. procedure TMyApp.HandleEvent(var Event: TEvent);
  115. begin
  116.   TApplication.HandleEvent(Event);
  117.   if Event.What = evCommand then
  118.   begin
  119.     case Event.Command of
  120.       cmNewWin: NewWindow;
  121.     else
  122.       Exit;
  123.     end;
  124.     ClearEvent(Event);
  125.   end;
  126. end;
  127.  
  128. procedure TMyApp.InitMenuBar;
  129. var R: TRect;
  130. begin
  131.   GetExtent(R);
  132.   R.B.Y := R.A.Y + 1;
  133.   MenuBar := New(PMenuBar, Init(R, NewMenu(
  134.     NewSubMenu('~F~ile', hcNoContext, NewMenu(
  135.       NewItem('~O~pen', 'F3', kbF3, cmFileOpen, hcNoContext,
  136.       NewItem('~N~ew', 'F4', kbF4, cmNewWin, hcNoContext,
  137.       NewLine(
  138.       NewItem('E~x~it', 'Alt-X', kbAltX, cmQuit, hcNoContext,
  139.       nil))))),
  140.     NewSubMenu('~W~indow', hcNoContext, NewMenu(
  141.       NewItem('~N~ext', 'F6', kbF6, cmNext, hcNoContext,
  142.       NewItem('~Z~oom', 'F5', kbF5, cmZoom, hcNoContext,
  143.       nil))),
  144.     nil))
  145.   )));
  146. end;
  147.  
  148. procedure TMyApp.InitStatusLine;
  149. var R: TRect;
  150. begin
  151.   GetExtent(R);
  152.   R.A.Y := R.B.Y - 1;
  153.   StatusLine := New(PStatusLine, Init(R,
  154.     NewStatusDef(0, $FFFF,
  155.       NewStatusKey('', kbF10, cmMenu,
  156.       NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,
  157.       NewStatusKey('~F4~ New', kbF4, cmNewWin,
  158.       NewStatusKey('~Alt-F3~ Close', kbAltF3, cmClose,
  159.       nil)))),
  160.     nil)
  161.   ));
  162. end;
  163.  
  164. procedure TMyApp.NewWindow;
  165. var
  166.   Window: PDemoWindow;
  167.   R: TRect;
  168. begin
  169.   Inc(WinCount);
  170.   R.Assign(0, 0, 24, 7);
  171.   R.Move(Random(55), Random(16));
  172.   Window := New(PDemoWindow, Init(R, 'Demo Window', WinCount));
  173.   DeskTop^.Insert(Window);
  174. end;
  175.  
  176. var
  177.   MyApp: TMyApp;
  178.  
  179. begin
  180.   ReadFile;
  181.   MyApp.Init;
  182.   MyApp.Run;
  183.   MyApp.Done;
  184.   DoneFile;
  185. end.
  186.