home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l044 / 4.ddi / DOCDEMOS.ZIP / TVGUID05.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-10-23  |  3.3 KB  |  139 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. program TVGUID05;
  11.  
  12. uses Objects, Drivers, Views, Menus, App;
  13.  
  14. const
  15.   WinCount: Integer =   0;
  16.   cmFileOpen        = 100;
  17.   cmNewWin          = 101;
  18.  
  19. type
  20.   TMyApp = object(TApplication)
  21.     procedure HandleEvent(var Event: TEvent); virtual;
  22.     procedure InitMenuBar; virtual;
  23.     procedure InitStatusLine; virtual;
  24.     procedure NewWindow;
  25.   end;
  26.  
  27.   PDemoWindow = ^TDemoWindow;
  28.   TDemoWindow = object(TWindow)
  29.     constructor Init(Bounds: TRect; WinTitle: String; WindowNo: Word);
  30.   end;
  31.  
  32.   PInterior = ^TInterior;
  33.   TInterior = object(TView)
  34.     constructor Init(var Bounds: TRect);
  35.     procedure Draw; virtual;
  36.   end;
  37.  
  38. { TInterior }
  39. constructor TInterior.Init(var Bounds: TRect);
  40. begin
  41.   TView.Init(Bounds);
  42.   GrowMode := gfGrowHiX + gfGrowHiY;
  43.   Options := Options or ofFramed;
  44. end;
  45.  
  46. procedure TInterior.Draw;
  47. const
  48.   Greeting: string = 'Hello, World!';
  49. begin
  50.   TView.Draw;
  51.   WriteStr(4, 2, Greeting,$01);
  52. end;
  53.  
  54. { TDemoWindow }
  55. constructor TDemoWindow.Init(Bounds: TRect; WinTitle: String; WindowNo: Word);
  56. var
  57.   S: string[3];
  58.   Interior: PInterior;
  59. begin
  60.   Str(WindowNo, S);
  61.   TWindow.Init(Bounds, WinTitle + ' ' + S, wnNoNumber);
  62.   GetClipRect(Bounds);
  63.   Bounds.Grow(-1,-1);
  64.   Interior := New(PInterior, Init(Bounds));
  65.   Insert(Interior);
  66. end;
  67.  
  68. { TMyApp }
  69. procedure TMyApp.HandleEvent(var Event: TEvent);
  70. begin
  71.   TApplication.HandleEvent(Event);
  72.   if Event.What = evCommand then
  73.   begin
  74.     case Event.Command of
  75.       cmNewWin: NewWindow;
  76.     else
  77.       Exit;
  78.     end;
  79.     ClearEvent(Event);
  80.   end;
  81. end;
  82.  
  83. procedure TMyApp.InitMenuBar;
  84. var R: TRect;
  85. begin
  86.   GetExtent(R);
  87.   R.B.Y := R.A.Y + 1;
  88.   MenuBar := New(PMenuBar, Init(R, NewMenu(
  89.     NewSubMenu('~F~ile', hcNoContext, NewMenu(
  90.       NewItem('~O~pen', 'F3', kbF3, cmFileOpen, hcNoContext,
  91.       NewItem('~N~ew', 'F4', kbF4, cmNewWin, hcNoContext,
  92.       NewLine(
  93.       NewItem('E~x~it', 'Alt-X', kbAltX, cmQuit, hcNoContext,
  94.       nil))))),
  95.     NewSubMenu('~W~indow', hcNoContext, NewMenu(
  96.       NewItem('~N~ext', 'F6', kbF6, cmNext, hcNoContext,
  97.       NewItem('~Z~oom', 'F5', kbF5, cmZoom, hcNoContext,
  98.       nil))),
  99.     nil))
  100.   )));
  101. end;
  102.  
  103. procedure TMyApp.InitStatusLine;
  104. var R: TRect;
  105. begin
  106.   GetExtent(R);
  107.   R.A.Y := R.B.Y - 1;
  108.   StatusLine := New(PStatusLine, Init(R,
  109.     NewStatusDef(0, $FFFF,
  110.       NewStatusKey('', kbF10, cmMenu,
  111.       NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,
  112.       NewStatusKey('~F4~ New', kbF4, cmNewWin,
  113.       NewStatusKey('~Alt-F3~ Close', kbAltF3, cmClose,
  114.       nil)))),
  115.     nil)
  116.   ));
  117. end;
  118.  
  119. procedure TMyApp.NewWindow;
  120. var
  121.   Window: PDemoWindow;
  122.   R: TRect;
  123. begin
  124.   Inc(WinCount);
  125.   R.Assign(0, 0, 24, 7);
  126.   R.Move(Random(55), Random(16));
  127.   Window := New(PDemoWindow, Init(R, 'Demo Window', WinCount));
  128.   DeskTop^.Insert(Window);
  129. end;
  130.  
  131. var
  132.   MyApp: TMyApp;
  133.  
  134. begin
  135.   MyApp.Init;
  136.   MyApp.Run;
  137.   MyApp.Done;
  138. end.
  139.