[Back to OOP SWAG index] [Back to Main SWAG index] [Original]

    {
       This program will create two modaless dialog boxes and will
       allow only one Dialog2 dialog to be created at any time.

       Additionally, it will demonstrate 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
      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');
                     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;
                       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.

[Back to OOP SWAG index] [Back to Main SWAG index] [Original]