Stars of Shareware: Programmierung/SOURCE.mdf/programm/windows/c/mobjm260/multidlg.pa_/multidlg.pa

Text File | 1994-09-06 | 5.4 KB | 194 lines

(*********************************************************************)
(*                                                                   *)
(*          Microworks ObjectMate 2.6                                                        *)
(*                                                                   *)
(*     Windows Interface Develpment Kit for the Borland Languages.   *)
(*                                                                   *)
(*         MULITDLG.PAS : Multiple Dialog Demonstration                      *)
(*                                                                                                                             *)
(*     Copyright 1992-94 Microworks Sydney, Australia.                 *)
(*                                                                   *)
(*********************************************************************)

(* MultiDlg creates a notebook style multiple dialog using child dialogs and
 * a radio button style SFX toolbar. It's an easy and more stylish alternative
 * to tabbed multiple dialogs. In the resource file multidlg.res there are two
 * main templates: MULTIDLG and MULTIDLGC. MULTDLG is the Pascal template and
 * MULTIDLGC is the C++ 4.0 template.
 *)

program MultiDlg;

uses WinTypes, WinProcs, WIN31, SFX200,
         {$IFDEF Ver15}
             WObjects;
         {$ELSE}
             Objects, OWindows, ODialogs;
         {$ENDIF}

{$R MultiDlg.res}

const

    id_Dlg1         = 1;
    id_Dlg2         = 2;
    id_Dlg3         = 3;
    id_Dlg4         = 4;
    id_Dlg5         = 5;
    id_Shade        = 101;
    id_Toolbar      = 102;
    id_But1         = 301;
    id_But2         = 302;
    id_But3         = 303;
    id_But4         = 304;
    id_But5         = 305;
    AppName : PChar = 'MultiDlg';

type

    PChildDlg = ^TChildDlg;
    TChildDlg = object(TDialog)
        procedure OK (var Msg: TMessage); virtual id_First + id_Ok;
        procedure Cancel (var Msg: TMessage); virtual id_First + id_Cancel;
    end;

    PMultiDlg = ^TMultiDlg;
    TMultiDlg = object(TDlgWindow)
        NextDlg : PChildDlg;
        PrevDlg : PChildDlg;
        Shade   : PSFXShade;
        Toolbar : PSFXToolbar;
        constructor Init(AParent: PWindowsObject; AName: PChar);
        destructor Done; virtual;
        function  GetClassName : PChar; virtual;
        procedure GetWindowClass(var AWndClass: TWndClass); virtual;
        procedure SetUpWindow; virtual;
        procedure CreateChildDialog (AnID: Integer; Title: PChar);
        procedure IDBut1 (var Msg: TMessage); virtual id_First + id_But1;
        procedure IDBut2 (var Msg: TMessage); virtual id_First + id_But2;
        procedure IDBut3 (var Msg: TMessage); virtual id_First + id_But3;
        procedure IDBut4 (var Msg: TMessage); virtual id_First + id_But4;
        procedure IDBut5 (var Msg: TMessage); virtual id_First + id_But5;
    end;

    PMultiApp = ^TMultiApp;
    TMultiApp = object(TApplication)
        procedure InitMainWindow; virtual;
    end;

{********** TMultiApp **********}

procedure TMultiApp.InitMainWindow;
begin
    MainWindow := New(PMultiDlg, Init(nil, AppName));
end;

{********** TMultiDlg **********}

constructor TMultiDlg.Init(AParent: PWindowsObject; AName: PChar);
begin
    TDlgWindow.Init(AParent, AName);
    Attr.Param := mws_SFXFrame or MWS_SFXCAPTION;
    Shade := New(PSFXShade, InitResource(@Self, id_Shade));
    Toolbar := New(PSFXToolbar, InitResource(@Self, id_Toolbar));
    NextDlg := nil;
    PrevDlg := nil;
end;

destructor TMultiDlg.Done;
begin
    TDlgWindow.Done;
end;

function TMultiDlg.GetClassName;
begin
    GetClassName := AppName;
end;

procedure TMultiDlg.GetWindowClass(var AWndClass: TWndClass);
begin
    TDlgWindow.GetWindowClass(AWndClass);
    AWndClass.hIcon := LoadIcon(HInstance, AppName);
end;

procedure TMultiDlg.SetUpWindow;
var
    Msg     : TMessage;
    WinRect : TRect;
begin
    TDlgWindow.SetUpWindow;
    IDBut1(Msg);
    Toolbar^.CheckTool(id_But1);
    if GetSystemMetrics(SM_CYSIZE) = 26 then
    begin
        GetWindowRect(HWindow, WinRect);
        with WinRect do
            SetWindowPos(HWindow, 0, 0, 0, Right- Left- 22, Bottom-Top, SWP_NOZORDER or SWP_NOMOVE);
        ShowWindow(GetDlgItem(HWindow, id_Cancel), SW_SHOW);
    end;
    CenterWindow(0, HWindow);
end;

procedure TMultiDlg.CreateChildDialog (AnID: Integer; Title: PChar);
var
    WinRect : TRect;
begin
    PrevDlg := NextDlg;
    NextDlg := New(PChildDlg, Init(@Self, MakeIntResource(AnID)));
    Application^.MakeWindow(NextDlg);
    SetWindowPos(NextDlg^.HWindow, HWND_TOP, 33, 50, 0, 0, SWP_NOSIZE);
    SetWindowText(Shade^.HWindow, Title);
    ShowWindow(NextDlg^.HWindow, SW_NORMAL);
    if (PrevDlg <> nil) and (PrevDlg^.HWindow <> 0) then
        DestroyWindow(PrevDlg^.HWindow);
end;

procedure TMultiDlg.IDBut1 (var Msg: TMessage);
begin
    CreateChildDialog(id_Dlg1, ' Edit Controls...');
end;

procedure TMultiDlg.IDBut2 (var Msg: TMessage);
begin
    CreateChildDialog(id_Dlg2, ' List Boxes...');
end;

procedure TMultiDlg.IDBut3 (var Msg: TMessage);
begin
    CreateChildDialog(id_Dlg3, ' Combo Boxes...');
end;

procedure TMultiDlg.IDBut4 (var Msg: TMessage);
begin
    CreateChildDialog(id_Dlg4, ' Check Boxes...');
end;

procedure TMultiDlg.IDBut5 (var Msg: TMessage);
begin
    CreateChildDialog(id_Dlg5, ' Radio Buttons...');
end;

{********** TChildDlg **********}

procedure TChildDlg.Ok (var Msg: TMessage);
begin
    with Msg do
        SendMessage(Parent^.HWindow, Message, wParam, lParam);
end;

procedure TChildDlg.Cancel (var Msg: TMessage);
begin
    with Msg do
        SendMessage(Parent^.HWindow, Message, wParam, lParam);
end;

{********** Main program **********}

var
    App: TMultiApp;
begin
    App.Init(AppName);
    App.Run;
    App.Done;
end.