Article #15241: Runtime Menubar and Statusline Change

 Technical Information Database

TI241D.txt   Runtime Menubar and Statusline Change
Category   :TVISION
Platform    :All
Product    :Pascal  All

Description:

{

This program changes menus at runtime as well as changing
the statusline.  This program demonstrates how to change the
statusline and the active commands linked to the statusline
options.

}

{$X+}
program ExampleProgram;

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

var
  StatusLine1: PStatusLine;

type
  TTestMain = object(TApplication)
    OtherMenu: PMenuBar;
    constructor Init;
    procedure Calendar;
    procedure HandleEvent(var Event: TEvent); virtual;
    procedure InitMenuBar; virtual;
    procedure InitStatusLine; 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.InitStatusLine;
var R: TRect;
begin
  GetExtent(R);
  R.A.Y := R.B.Y - 1;
  StatusLine := New(PStatusLine, Init(R,
    NewStatusDef(0, $FFFF,
      NewStatusKey('', kbF10, cmMenu,
      NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,
      nil)),
    nil)
  ));
  StatusLine1 := New(PStatusLine, Init(R,
    NewStatusDef(0, $FFFF,
      NewStatusKey('', kbF10, cmMenu,
      NewStatusKey('~P~uzzle', kbAltP, PuzzleCmd,
      nil)),
    nil)
  ));
end;


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

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

var
  Main: TTestMain;

begin
  Main.Init;
  Main.Run;
  Main.Done;
end.


Reference:


7/16/98 4:33:39 PM
 

Last Modified: 01-SEP-99