home *** CD-ROM | disk | FTP | other *** search
-
-
-
-
-
-
- PRODUCT : Turbo Pascal NUMBER : 670
- VERSION : 6.0
- OS : MS/PC DOS
- DATE : February 28, 1992 PAGE : 1/4
-
- TITLE : Messaging Between Two Dialogs and Update Background
- Events
-
-
-
-
- {
- This program will create two modeless dialog boxes and will
- allow only one dialog to be created at any time.
-
- Additionally, it demonstrates how to broadcast messages to
- background windows and update information without changing
- the selected dialog.
-
- }
- {$X+}
-
- Program DialogCommunication;
-
- uses Objects, Drivers, Views, Menus, Dialogs, App, Crt;
- const
- cmDialog1 = 100;
- cmDialog2 = 101;
- cmDialog1Button = 200;
- cmDialog2Button = 201;
-
- type
-
- PHelloApp = ^THelloApp;
- THelloApp = object(TApplication)
- procedure MakeDialog;
- procedure HandleEvent(var Event: TEvent); virtual;
- procedure InitMenuBar; virtual;
- procedure InitStatusLine; virtual;
- end;
-
- PMyDialog1 = ^TMyDialog1;
- TMyDialog1 = object(TDialog)
- procedure MakeDialog2;
- procedure HandleEvent(var Event:TEvent); virtual;
- end;
-
- PMyDialog2 = ^TMyDialog2;
- TMyDialog2 = object(TMyDialog1)
- procedure HandleEvent(var Event:TEvent); virtual;
- end;
-
- procedure TMyDialog1.HandleEvent(var Event: TEvent);
- var
-
-
-
-
-
-
-
-
-
-
-
-
- PRODUCT : Turbo Pascal NUMBER : 670
- VERSION : 6.0
- OS : MS/PC DOS
- DATE : February 28, 1992 PAGE : 2/4
-
- TITLE : Messaging Between Two Dialogs and Update Background
- Events
-
-
-
-
- AreYouThere: PView;
- begin
- TDialog.HandleEvent(Event);
- if Event.What = evCommand then
- begin
- case Event.Command of
- cmDialog1Button:
- begin
- AreYouThere:= Message(DeskTop, evBroadcast,
- cmDialog2, nil);
- if AreYouThere = nil then
- MakeDialog2
- else
- ClearEvent(Event);
- end
- else
- Exit;
- end;
- ClearEvent(Event);
- end;
- end;
-
- procedure TMyDialog1.MakeDialog2;
- var
- Dialog2: PMyDialog2;
- R: TRect;
- Button: PButton;
- begin
- R.Assign(1,1,40,20);
- Dialog2:= New(PMyDialog2, init(R,'Dialog2'));
- R.Assign(10,10,20,12);
- Button:= New(PButton,Init(R,'Beep', cmDialog2Button,
- bfdefault));
- Dialog2^.Insert(Button);
- DeskTop^.Insert(Dialog2);
- end;
-
- procedure TMyDialog2.HandleEvent(var Event: TEvent);
- begin
- case Event.Command of
- cmDialog2: begin
- sound(2000); delay(10); nosound;
- Title:=newstr('Hello world');
-
-
-
-
-
-
-
-
-
-
-
-
- PRODUCT : Turbo Pascal NUMBER : 670
- VERSION : 6.0
- OS : MS/PC DOS
- DATE : February 28, 1992 PAGE : 3/4
-
- TITLE : Messaging Between Two Dialogs and Update Background
- Events
-
-
-
-
- ReDraw;
- ClearEvent(Event);
- end;
- end;
- TDialog.HandleEvent(Event);
- if Event.What = evCommand then
- begin
- case Event.Command of
- cmDialog2Button: begin
- Sound(1000); delay(100); NoSound;
- end;
- else
- Exit;
- end;
- ClearEvent(Event);
- end;
- end;
-
- { THelloApp }
-
- procedure THelloApp.MakeDialog;
- var
- R:TRect;
- Button1: PButton;
- Dialog1: PMyDialog1;
- begin
- R.Assign(25, 5, 65, 16);
- Dialog1:= New(PMyDialog1, init(R,'Dialog1'));
- R.Assign(16, 8, 38, 10);
- Button1:= New(PButton, Init(R,'Call Dialog2', cmDialog1Button,
- bfDefault));
- Dialog1^.Insert(Button1);
- DeskTop^.Insert(Dialog1);
- end;
-
- procedure THelloApp.HandleEvent(var Event: TEvent);
- begin
- TApplication.HandleEvent(Event);
- if Event.What = evCommand then
- begin
- case Event.Command of
- cmDialog1:begin
- MakeDialog;
-
-
-
-
-
-
-
-
-
-
-
-
- PRODUCT : Turbo Pascal NUMBER : 670
- VERSION : 6.0
- OS : MS/PC DOS
- DATE : February 28, 1992 PAGE : 4/4
-
- TITLE : Messaging Between Two Dialogs and Update Background
- Events
-
-
-
-
- end;
- else
- Exit;
- end;
- ClearEvent(Event);
- end;
- end;
-
- procedure THelloApp.InitMenuBar;
- var
- R: TRect;
- begin
- GetExtent(R);
- R.B.Y := R.A.Y + 1;
- MenuBar := New(PMenuBar, Init(R, NewMenu(
- NewSubMenu('~O~pen Dialogs', hcNoContext, NewMenu(
- NewItem('~D~ialog1','', 0, cmDialog1, hcNoContext,
- NewLine(
- NewItem('E~x~it', 'Alt-X', kbAltX, cmQuit,
- hcNoContext, nil)))), nil))));
- end;
-
- procedure THelloApp.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)));
- end;
-
- var
- HelloWorld: THelloApp;
-
- begin
- HelloWorld.Init;
- HelloWorld.Run;
- HelloWorld.Done;
- end.
-
-
-
-
-
-
-
-