home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / tvision / gravis / gv / gvguid05.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-05-23  |  3.7 KB  |  152 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 GVGUID05;
  13.  
  14. uses Objects, Drivers, Views, GVDriver, ExtGraph, GVViews, GVMenus, GVApp, MetaGr;
  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.     constructor Init(Bounds: TRect; WinTitle: String; WindowNo: Word);
  32.   end;
  33.  
  34.   PInterior = ^TInterior;
  35.   TInterior = object(TGView)
  36.     constructor Init(var Bounds: TRect);
  37.     procedure Draw; virtual;
  38.   end;
  39.  
  40. { TInterior }
  41. constructor TInterior.Init(var Bounds: TRect);
  42. begin
  43.   TGView.Init(Bounds);
  44.   GrowMode := gfGrowHiX + gfGrowHiY;
  45. end;
  46.  
  47. procedure TInterior.Draw;
  48. const
  49.   Greeting: string = 'Hello, World!';
  50. var
  51.   R: TRect;
  52. begin
  53.   SetViewPort;
  54.   HideMouse;     { unbedingt GVDriver nach Drivers einbinden, sonst Fehler }
  55.   SetFillStyle (SolidFill, Black);
  56.   Bar (0,0, Size.X-1, Size.Y-1);
  57.   R.Assign (20,35, 100, 20);
  58.   SetGVStyle (ftSansSerif);
  59.   OutGVText (R.A, Greeting, White, White, R.B, True);
  60.   ShowMouse;
  61.   RestoreViewPort;
  62. end;
  63.  
  64. { TDemoWindow }
  65. constructor TDemoWindow.Init(Bounds: TRect; WinTitle: String; WindowNo: Word);
  66. var
  67.   S: string[3];
  68.   Interior: PInterior;
  69. begin
  70.   Str(WindowNo, S);
  71.   TWindow.Init(Bounds, WinTitle + ' ' + S);
  72.   Delete (Background);
  73.   Dispose (Background, Done);
  74.   GetExtent(Bounds);
  75.   Bounds.Grow (-4,-4);
  76.   Bounds.A.Y:=23;
  77.   Interior := New(PInterior, Init(Bounds));
  78.   Insert(Interior);
  79. end;
  80.  
  81. { TMyApp }
  82. procedure TMyApp.HandleEvent(var Event: TEvent);
  83. begin
  84.   TApplication.HandleEvent(Event);
  85.   if Event.What = evCommand then
  86.   begin
  87.     case Event.Command of
  88.       cmNewWin: NewWindow;
  89.     else
  90.       Exit;
  91.     end;
  92.     ClearEvent(Event);
  93.   end;
  94. end;
  95.  
  96. procedure TMyApp.InitMenuBar;
  97. var R: TRect;
  98. begin
  99.   GetExtent(R);
  100.   R.B.Y := R.A.Y + 21;
  101.   MenuBar := New(PMenuBar, Init(R, NewMenu(
  102.     NewSubMenu('~F~ile', hcNoContext, NewMenu(
  103.       NewItem('~O~pen', 'F3', kbF3, cmFileOpen, hcNoContext,
  104.       NewItem('~N~ew', 'F4', kbF4, cmNewWin, hcNoContext,
  105.       NewLine(
  106.       NewItem('E~x~it', 'Alt-X', kbAltX, cmQuit, hcNoContext,
  107.       nil))))),
  108.     NewSubMenu('~W~indow', hcNoContext, NewMenu(
  109.       NewItem('~N~ext', 'F6', kbF6, cmNext, hcNoContext,
  110.       NewItem('~Z~oom', 'F5', kbF5, cmZoom, hcNoContext,
  111.       nil))),
  112.     nil))
  113.   )));
  114. end;
  115.  
  116. procedure TMyApp.InitStatusLine;
  117. var R: TRect;
  118. begin
  119.   GetExtent(R);
  120.   R.A.Y := R.B.Y - 21;
  121.   StatusLine := New(PStatusLine, Init(R,
  122.     NewStatusDef(0, $FFFF,
  123.       NewStatusKey('', kbF10, cmMenu,
  124.       NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,
  125.       NewStatusKey('~F4~ New', kbF4, cmNewWin,
  126.       NewStatusKey('~Alt-F3~ Close', kbAltF3, cmClose,
  127.       nil)))),
  128.     nil)
  129.   ));
  130. end;
  131.  
  132. procedure TMyApp.NewWindow;
  133. var
  134.   Window: PDemoWindow;
  135.   R: TRect;
  136. begin
  137.   Inc(WinCount);
  138.   R.Assign(0, 0, 200, 100);
  139.   R.Move(Random(400), Random(300));
  140.   Window := New(PDemoWindow, Init(R, 'Demo Window', WinCount));
  141.   DeskTop^.Insert(Window);
  142. end;
  143.  
  144. var
  145.   MyApp: TMyApp;
  146.  
  147. begin
  148.   MyApp.Init;
  149.   MyApp.Run;
  150.   MyApp.Done;
  151. end.
  152.