home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / tvision / menustat / menustat.pas
Encoding:
Pascal/Delphi Source File  |  1991-05-06  |  3.1 KB  |  144 lines
  1. {
  2.  
  3. This program changes menus at runtime as well as changing
  4. the statusline.  This program demonstrates how to change the
  5. statusline and the active commands linked to the statusline
  6. options.
  7.  
  8. }
  9.  
  10. {$X+}
  11. program ExampleProgram;
  12.  
  13. uses
  14.   Drivers, Objects, Views, App, Menus, Puzzle, Calendar;
  15. const
  16.   PuzzleCmd   = 100;
  17.   CalendarCmd = 101;
  18.   SwitchCmd   = 102;
  19.  
  20. var
  21.   StatusLine1: PStatusLine;
  22.  
  23. type
  24.   TTestMain = object(TApplication)
  25.     OtherMenu: PMenuBar;
  26.     constructor Init;
  27.     procedure Calendar;
  28.     procedure HandleEvent(var Event: TEvent); virtual;
  29.     procedure InitMenuBar; virtual;
  30.     procedure InitStatusLine; virtual;
  31.     procedure Puzzle;
  32.     procedure SwitchMenu;
  33.   end;
  34.  
  35. { TTestMain }
  36. constructor TTestMain.Init;
  37. begin
  38.   TApplication.Init;
  39. end;
  40.  
  41. procedure TTestMain.Calendar;
  42. var
  43.   CalendarWindow: PCalendarWindow;
  44. begin
  45.   CalendarWindow := new(PCalendarWindow, Init);
  46.   DeskTop^.Insert(CalendarWindow);
  47. end;
  48.  
  49. procedure TTestMain.HandleEvent(var Event: TEvent);
  50. begin
  51.   TApplication.HandleEvent(Event);
  52.   if Event.What = evCommand Then
  53.   begin
  54.     case Event.Command of
  55.       PuzzleCmd   : Puzzle;
  56.       CalendarCmd : Calendar;
  57.       SwitchCmd   : SwitchMenu;
  58.     else
  59.       Exit;
  60.     end;
  61.     ClearEvent(Event);
  62.   end;
  63. end;
  64.  
  65. Procedure TTestMain.InitMenuBar;
  66. var
  67.   R: TRect;
  68. begin
  69.   GetExtent(R);
  70.   R.B.Y := R.A.Y+1;
  71.   MenuBar := New(PMenuBar, Init(R, NewMenu(
  72.      NewItem('~S~witch Menus','', 0, SwitchCmd, hcNoContext,
  73.      NewSubMenu('~E~xample',hcNoContext,NewMenu(
  74.      NewItem('~P~uzzle','', 0, PuzzleCmd, hcNoContext,
  75.      NewItem('~C~alendar','', 0, CalendarCmd, hcNoContext,
  76.      NewLine(
  77.      NewItem('~Q~uit', '',0, cmQuit, hcNoContext,Nil))))),Nil)))));
  78.   OtherMenu := New(PMenuBar, Init(R, NewMenu(
  79.      NewItem('~S~witch Menus','', 0, SwitchCmd, hcNoContext,
  80.      NewSubMenu('~O~ther Menu',hcNoContext,NewMenu(
  81.      NewItem('~B~y', '', 0, cmQuit, hcNoContext,
  82.      NewLine(
  83.      NewItem('~Q~uit', '',0, cmQuit, hcNoContext,Nil)))),Nil)))));
  84. end;
  85.  
  86.  
  87. procedure TTestmain.InitStatusLine;
  88. var R: TRect;
  89. begin
  90.   GetExtent(R);
  91.   R.A.Y := R.B.Y - 1;
  92.   StatusLine := New(PStatusLine, Init(R,
  93.     NewStatusDef(0, $FFFF,
  94.       NewStatusKey('', kbF10, cmMenu,
  95.       NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,
  96.       nil)),
  97.     nil)
  98.   ));
  99.   StatusLine1 := New(PStatusLine, Init(R,
  100.     NewStatusDef(0, $FFFF,
  101.       NewStatusKey('', kbF10, cmMenu,
  102.       NewStatusKey('~P~uzzle', kbAltP, PuzzleCmd,
  103.       nil)),
  104.     nil)
  105.   ));
  106. end;
  107.  
  108.  
  109. procedure TTestMain.Puzzle;
  110. var
  111.  PuzzleWindow: PPuzzleWindow;
  112. begin
  113.   PuzzleWindow := new(PPuzzleWindow, Init);
  114.   DeskTop^.Insert(PuzzleWindow);
  115. end;
  116.  
  117. procedure TTestMain.SwitchMenu;
  118. var
  119.   Temp: PMenuBar;
  120.   Temp1: PStatusLine;
  121. begin
  122.   Delete(MenuBar);
  123.   Temp := PMenuBar(MenuBar);
  124.   MenuBar := OtherMenu;
  125.   OtherMenu := Temp;
  126.   Insert(MenuBar);
  127.   Delete(StatusLine);
  128.   Temp1 := PStatusLine(StatusLine);
  129.   StatusLine := StatusLine1;
  130.   StatusLine1 := Temp1;
  131.   Insert(StatusLine);
  132.   MenuBar^.DrawView;
  133.   StatusLine^.DrawView;
  134. end;
  135.  
  136. var
  137.   Main: TTestMain;
  138.  
  139. begin
  140.   Main.Init;
  141.   Main.Run;
  142.   Main.Done;
  143. end.
  144.