Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/PCTV3N3.ZIP/MDITOOL.ZIP/MDITOOL.PAS

Pascal/Delphi Source File | 1992-05-26 | 5.2 KB | 196 lines

{ mditool.pas --Demonstrate TPW 1.5 Toolbar unit. By Tom Swan }

{$R mditool.res}

program MDITool;

uses WinTypes, WinProcs, WObjects, Toolbar, IDs;

const
  NumWindows: Word = 0;  { Number of MDI windows open }

type
  TMDIToolApp = object(TApplication)
    procedure InitInstance; virtual;
    procedure InitMainWindow; virtual;
  end;

  PMDIToolFrame = ^TMDIToolFrame;
  TMDIToolFrame = object(TMDIWindow)
    Toolbar: PToolbar;
    constructor Init(ATitle: PChar; AMenu: HMenu);
    procedure SetupWindow; virtual;
    procedure GetWindowClass(var AWndClass: TWndClass); virtual;
    function GetClassName: PChar; virtual;
    procedure EnableCommand(Cmd: Word; EnableCmd: Boolean);
    function InitChild: PWindowsObject; virtual;
    procedure CMFileExit(var Msg: TMessage);
      virtual cm_First + cm_FileExit;
    procedure CMHelpAbout(var Msg: TMessage);
      virtual cm_First + cm_HelpAbout;
    procedure WMSize(var Msg: TMessage);
      virtual wm_First + wm_Size;
  end;

  PMDIToolWin = ^TMDIToolWin;
  TMDIToolWin = object(TWindow)
    constructor Init(AParent: PWindowsObject; ATitle: PChar);
    destructor Done; virtual;
  end;

{- Enable or disable the Window menu's commands }
procedure EnableWindowMenu(Enable: Boolean);
var
  pw: PWindowsObject;
begin
  pw := Application^.MainWindow;
  if pw^.HWindow <> 0 then with PMDIToolFrame(pw)^ do
  begin
    EnableCommand(cm_CascadeChildren, Enable);
    EnableCommand(cm_TileChildren, Enable);
    EnableCommand(cm_ArrangeIcons, Enable);
    EnableCommand(cm_CloseChildren, Enable);
  end;
end;

{- Initialize this instance of the application }
procedure TMDIToolApp.InitInstance;
begin
  TApplication.InitInstance;
  HAccTable := LoadAccelerators(HInstance, PChar(id_Acc));
end;

{- Initialize TMDIToolApp object's window }
procedure TMDIToolApp.InitMainWindow;
begin
  MainWindow := New(PMDIToolFrame, Init('MDI Toolbar Demonstration',
    LoadMenu(HInstance, PChar(id_Menu))));
end;

{- Construct TMDIDemoWin desktop object }
constructor TMDIToolFrame.Init(ATitle: PChar; AMenu: HMenu);
begin
  TMDIWindow.Init(ATitle, AMenu);
  with Attr do
  begin
    X := GetSystemMetrics(sm_CXScreen) div 8;
    Y := GetSystemMetrics(sm_CYScreen) div 8;
    H := Y * 6;
    W := X * 6;
  end;
  ChildMenuPos := 1;   { Location of Window menu }
  Toolbar := New(PToolbar, Init(@Self, 'ids_Toolbar'));
end;

{- Perform window initializations that require HWindow }
procedure TMDIToolFrame.SetupWindow;
begin
  TMDIWindow.SetupWindow;
  EnableWindowMenu(false);
end;

{- Modify window class to attach a desktop icon }
procedure TMDIToolFrame.GetWindowClass(var AWndClass: TWndClass);
begin
  TMDIWindow.GetWindowClass(AWndClass);
  AWndClass.HIcon := LoadIcon(HInstance, PChar(id_Icon));
end;

{- Return new class name }
function TMDIToolFrame.GetClassName: PChar;
begin
  GetClassName := 'TMDIToolFrame';
end;

{- Enable or disable a menu and toolbar command icon }
procedure TMDIToolFrame.EnableCommand(Cmd: Word; EnableCmd: Boolean);
var
  CmdFlags: Word;
begin
  if EnableCmd then
    CmdFlags := mf_ByCommand or mf_Enabled
  else
    CmdFlags := mf_ByCommand or mf_Disabled or mf_Grayed;
  EnableMenuItem(Attr.Menu, Cmd, CmdFlags);
  if Toolbar <> nil
    then Toolbar^.EnableTool(Cmd, EnableCmd);
end;

{- Create child MDI window. }
function TMDIToolFrame.InitChild: PWindowsObject;
begin
  InitChild := New(PMDIToolWin, Init(@Self, '[untitled]'));
end;

{- Execute File:Exit command }
procedure TMDIToolFrame.CMFileExit(var Msg: TMessage);
begin
  if MessageBox(HWindow, 'End program now?', 'MDITool',
    mb_IconQuestion or mb_YesNo) = idYes then
    CloseWindow;
end;

{- Execute Help:About command }
procedure TMDIToolFrame.CMHelpAbout(var Msg: TMessage);
var
  Dialog: TDialog;
begin
  Dialog.Init(@Self, PChar(id_About));
  Dialog.Execute;
  Dialog.Done;
end;

{- Handle window size (wm_Size) message }
procedure TMDIToolFrame.WMSize(var Msg: TMessage);
var
  R: TRect;
  {- Tell children not to "play" outside of the frame's yard! }
  procedure NotifyChild(P: PWindow); far;
  begin
    if P^.HWindow <> 0 then
      SendMessage(P^.HWindow, am_SetParentClientRect,
        Msg.WParam, Longint(@R));
  end;
begin
  if (Scroller <> nil) and (Msg.WParam <> sizeIconic) then
    Scroller^.SetPageSize;
  if Msg.wParam = sizeNormal then
  begin
    GetWindowRect(HWindow, R);
    Attr.H := R.bottom - R.top;
    Attr.W := R.right - R.left;
  end;
  GetClientRect(HWindow, R);
  ForEach(@NotifyChild);
  with R do
    SetWindowPos(ClientWnd^.HWindow, 0,
      Left, Top, Right - Left, Bottom - Top, swp_NoZOrder);
end;

{- Construct new MDI child window }
constructor TMDIToolWin.Init(AParent: PWindowsObject; ATitle: PChar);
begin
  TWindow.Init(AParent, ATitle);
  if NumWindows = 0 then
    EnableWindowMenu(true);
  inc(NumWindows);
end;

{- Destroy MDI child window }
destructor TMDIToolWin.Done;
begin
  if NumWindows > 0 then
    dec(NumWindows);
  if NumWindows = 0 then
    EnableWindowMenu(false);
  TWindow.Done;
end;

var
  MDIToolApp: TMDIToolApp;
begin
  MDIToolApp.Init('MDITool');
  MDIToolApp.Run;
  MDIToolApp.Done;
end.