Article #15205: Change Menubar at Runtime

 Technical Information Database

TI205D.txt   Change Menubar at Runtime
Category   :TVISION
Platform    :All
Product    :Pascal  All

Description:

{

This program changes the menubar at runtime as well
as demonstrates how to create a menuitem that does not
have a submenu.

}
{$X+}
program ExampleProgram;

uses
  Drivers, Objects, Views, App, Menus, Puzzle, Calendar;
  const
  PuzzleCmd   = 100;
  CalendarCmd = 101;
  SwitchCmd   = 102;

type
  TTestMain = object(TApplication)
    OtherMenu: PMenuBar;
    constructor Init;
    procedure Calendar;
    procedure HandleEvent(var Event: TEvent); virtual;
    procedure InitMenuBar; virtual;
    procedure Puzzle;
    procedure SwitchMenu;
  end;

{ TTestMain }
constructor TTestMain.Init;
begin
  TApplication.Init;
end;

procedure TTestMain.Calendar;
var
  CalendarWindow: PCalendarWindow;
begin
  CalendarWindow := new(PCalendarWindow, Init);
  DeskTop^.Insert(CalendarWindow);
end;

procedure TTestMain.HandleEvent(var Event: TEvent);
begin
  TApplication.HandleEvent(Event);
  if Event.What = evCommand Then
  begin
    case Event.Command of
      PuzzleCmd   : Puzzle;
      CalendarCmd : Calendar;
      SwitchCmd   : SwitchMenu;
    else
      Exit;
    end;
    ClearEvent(Event);
  end;
end;

Procedure TTestMain.InitMenuBar;
var
  R: TRect;
begin
  GetExtent(R);
  R.B.Y := R.A.Y+1;
  MenuBar := New(PMenuBar, Init(R, NewMenu(
     NewItem('~S~witch Menus','', 0, SwitchCmd, hcNoContext,
     NewSubMenu('~E~xample',hcNoContext,NewMenu(
     NewItem('~P~uzzle','', 0, PuzzleCmd, hcNoContext,
     NewItem('~C~alendar','', 0, CalendarCmd, hcNoContext,
     NewLine(
     NewItem('~Q~uit', '',0, cmQuit,
hcNoContext,Nil))))),Nil)))));
  OtherMenu := New(PMenuBar, Init(R, NewMenu(
     NewItem('~S~witch Menus','', 0, SwitchCmd, hcNoContext,
     NewSubMenu('~O~ther Menu',hcNoContext,NewMenu(
     NewItem('~B~y', '', 0, cmQuit, hcNoContext,
     NewLine(
     NewItem('~Q~uit', '',0, cmQuit,
hcNoContext,Nil)))),Nil)))));
end;

procedure TTestMain.Puzzle;
var
 PuzzleWindow: PPuzzleWindow;
begin
  PuzzleWindow := new(PPuzzleWindow, Init);
  DeskTop^.Insert(PuzzleWindow);
end;

procedure TTestMain.SwitchMenu;
var
  Temp: PMenuBar;
begin
  Delete(MenuBar);
  Temp := PMenuBar(MenuBar);
  MenuBar := OtherMenu;
  OtherMenu := Temp;
  Insert(MenuBar);
  MenuBar^.DrawView;
end;

var
  TestMain: TTestMain;

begin
  TestMain.Init;
  TestMain.Run;
  TestMain.Done;
end.


Reference:


7/16/98 4:33:39 PM
 

Last Modified: 01-SEP-99