home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l044 / 4.ddi / DOCDEMOS.ZIP / TVGUID04.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-10-23  |  2.4 KB  |  102 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 TVGUID04;
  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.   end;
  30.  
  31. { TMyApp }
  32. procedure TMyApp.HandleEvent(var Event: TEvent);
  33. begin
  34.   TApplication.HandleEvent(Event);
  35.   if Event.What = evCommand then
  36.   begin
  37.     case Event.Command of
  38.       cmNewWin: NewWindow;
  39.     else
  40.       Exit;
  41.     end;
  42.     ClearEvent(Event);
  43.   end;
  44. end;
  45.  
  46. procedure TMyApp.InitMenuBar;
  47. var R: TRect;
  48. begin
  49.   GetExtent(R);
  50.   R.B.Y := R.A.Y + 1;
  51.   MenuBar := New(PMenuBar, Init(R, NewMenu(
  52.     NewSubMenu('~F~ile', hcNoContext, NewMenu(
  53.       NewItem('~O~pen', 'F3', kbF3, cmFileOpen, hcNoContext,
  54.       NewItem('~N~ew', 'F4', kbF4, cmNewWin, hcNoContext,
  55.       NewLine(
  56.       NewItem('E~x~it', 'Alt-X', kbAltX, cmQuit, hcNoContext,
  57.       nil))))),
  58.     NewSubMenu('~W~indow', hcNoContext, NewMenu(
  59.       NewItem('~N~ext', 'F6', kbF6, cmNext, hcNoContext,
  60.       NewItem('~Z~oom', 'F5', kbF5, cmZoom, hcNoContext,
  61.       nil))),
  62.     nil))
  63.   )));
  64. end;
  65.  
  66. procedure TMyApp.InitStatusLine;
  67. var R: TRect;
  68. begin
  69.   GetExtent(R);
  70.   R.A.Y := R.B.Y - 1;
  71.   StatusLine := New(PStatusLine, Init(R,
  72.     NewStatusDef(0, $FFFF,
  73.       NewStatusKey('', kbF10, cmMenu,
  74.       NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,
  75.       NewStatusKey('~F4~ New', kbF4, cmNewWin,
  76.       NewStatusKey('~Alt-F3~ Close', kbAltF3, cmClose,
  77.       nil)))),
  78.     nil)
  79.   ));
  80. end;
  81.  
  82. procedure TMyApp.NewWindow;
  83. var
  84.   Window: PDemoWindow;
  85.   R: TRect;
  86. begin
  87.   Inc(WinCount);
  88.   R.Assign(0, 0, 26, 7);
  89.   R.Move(Random(58), Random(16));
  90.   Window := New(PDemoWindow, Init(R, 'Demo Window', WinCount));
  91.   DeskTop^.Insert(Window);
  92. end;
  93.  
  94. var
  95.   MyApp: TMyApp;
  96.  
  97. begin
  98.   MyApp.Init;
  99.   MyApp.Run;
  100.   MyApp.Done;
  101. end.
  102.