home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / tvision / gravis / gv / gvguid04.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-05-23  |  2.5 KB  |  104 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. { modifiziert für Graphics Vision von Stefan Milius }
  11.  
  12. program GVGUID04;
  13.  
  14. uses Objects, Drivers, Views, GVViews, GVMenus, GVApp;
  15.  
  16. const
  17.   WinCount: Integer =   0;
  18.   cmFileOpen        = 100;
  19.   cmNewWin          = 101;
  20.  
  21. type
  22.   TMyApp = object(TApplication)
  23.     procedure HandleEvent(var Event: TEvent); virtual;
  24.     procedure InitMenuBar; virtual;
  25.     procedure InitStatusLine; virtual;
  26.     procedure NewWindow;
  27.   end;
  28.  
  29.   PDemoWindow = ^TDemoWindow;
  30.   TDemoWindow = object(TWindow)
  31.   end;
  32.  
  33. { TMyApp }
  34. procedure TMyApp.HandleEvent(var Event: TEvent);
  35. begin
  36.   TApplication.HandleEvent(Event);
  37.   if Event.What = evCommand then
  38.   begin
  39.     case Event.Command of
  40.       cmNewWin: NewWindow;
  41.     else
  42.       Exit;
  43.     end;
  44.     ClearEvent(Event);
  45.   end;
  46. end;
  47.  
  48. procedure TMyApp.InitMenuBar;
  49. var R: TRect;
  50. begin
  51.   GetExtent(R);
  52.   R.B.Y := R.A.Y + 21;
  53.   MenuBar := New(PMenuBar, Init(R, NewMenu(
  54.     NewSubMenu('~F~ile', hcNoContext, NewMenu(
  55.       NewItem('~O~pen', 'F3', kbF3, cmFileOpen, hcNoContext,
  56.       NewItem('~N~ew', 'F4', kbF4, cmNewWin, hcNoContext,
  57.       NewLine(
  58.       NewItem('E~x~it', 'Alt-X', kbAltX, cmQuit, hcNoContext,
  59.       nil))))),
  60.     NewSubMenu('~W~indow', hcNoContext, NewMenu(
  61.       NewItem('~N~ext', 'F6', kbF6, cmNext, hcNoContext,
  62.       NewItem('~Z~oom', 'F5', kbF5, cmZoom, hcNoContext,
  63.       nil))),
  64.     nil))
  65.   )));
  66. end;
  67.  
  68. procedure TMyApp.InitStatusLine;
  69. var R: TRect;
  70. begin
  71.   GetExtent(R);
  72.   R.A.Y := R.B.Y - 21;
  73.   StatusLine := New(PStatusLine, Init(R,
  74.     NewStatusDef(0, $FFFF,
  75.       NewStatusKey('', kbF10, cmMenu,
  76.       NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,
  77.       NewStatusKey('~F4~ New', kbF4, cmNewWin,
  78.       NewStatusKey('~Alt-F3~ Close', kbAltF3, cmClose,
  79.       nil)))),
  80.     nil)
  81.   ));
  82. end;
  83.  
  84. procedure TMyApp.NewWindow;
  85. var
  86.   Window: PDemoWindow;
  87.   R: TRect;
  88. begin
  89.   Inc(WinCount);
  90.   R.Assign(0, 0, 200, 100);
  91.   R.Move(Random(400), Random(300));
  92.   Window := New(PDemoWindow, Init(R, 'Demo Window'));
  93.   DeskTop^.Insert(Window);
  94. end;
  95.  
  96. var
  97.   MyApp: TMyApp;
  98.  
  99. begin
  100.   MyApp.Init;
  101.   MyApp.Run;
  102.   MyApp.Done;
  103. end.
  104.