Как в MDI-форме получить message при создании MDI-Child-окна?

← →
GUNski (2003-12-09 20:51) [0]

Проблема в чем: у меня сначала криэйтится форма, а затем ее стайл меняется ран-тайм на MDI-Child.

Что нужно: при создании или закрытии дочерней формы на тул-баре создавать/удалять кнопку с ее заголовком!

← →
Игорь Шевченко (2003-12-09 20:59) [1]

unit main;

interface

uses
Windows, Messages, SysUtils,
Classes, Graphics, Controls, Forms,
Dialogs, Menus, ExtCtrls, UserMessages, Buttons;

type
TfMain = class(TForm)
MainMenu: TMainMenu;
New1: TMenuItem;
Child1: TMenuItem;
Iterate1: TMenuItem;
Window1: TMenuItem;
ilehorizontal1: TMenuItem;
ilevertical1: TMenuItem;
Cascade1: TMenuItem;
ButtonsPanel: TPanel;
Childwithicon1: TMenuItem;
procedure Iterate1Click(Sender: TObject);
procedure Child1Click(Sender: TObject);
procedure ilehorizontal1Click(Sender: TObject);
procedure ilevertical1Click(Sender: TObject);
procedure Cascade1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Childwithicon1Click(Sender: TObject);
procedure ButtonsPanelResize(Sender: TObject);
private
FButtons : TList;
FClientInstance : TFarProc;
FPrevClientProc : TFarProc;
procedure ClientWndProc(var Message: TMessage);
procedure AddButtonToPanel (AWindowHandle : HWND);
procedure RemoveButtonFromPanel (AWindowHandle : HWND);
procedure UmMDIActive (var Message : TMessage); message UM_MDIACTIVE;
procedure RedrawButtons;
procedure WindowButtonClick (Sender : TObject);
procedure DrawWindowButton (AButton : TSpeedButton; ADown : Boolean);
end;

var
fMain: TfMain;

implementation

uses
Child, ChildWithIcon;

{$R *.dfm}

const MaxButtonWidth = 140;

procedure TfMain.Iterate1Click(Sender: TObject);
var
Wnd : HWND;
Count : Integer;
begin
Count := 0;
Wnd := GetWindow(ClientHandle, GW_CHILD);
while Wnd <> 0 do begin
if GetWindow (Wnd, GW_OWNER) = 0 then
Inc(Count);
Wnd := GetWindow (Wnd, GW_HWNDNEXT);
end;
ShowMessageFmt("Counts %d childs", [Count]);
end;

procedure TfMain.Child1Click(Sender: TObject);
begin
with TfChild.Create(Application) do
Show();
end;

procedure TfMain.ilehorizontal1Click(Sender: TObject);
begin
TileMode := tbHorizontal;
Tile();
end;

procedure TfMain.ilevertical1Click(Sender: TObject);
begin
TileMode := tbVertical;
Tile();
end;

procedure TfMain.Cascade1Click(Sender: TObject);
begin
Cascade();
end;

procedure TfMain.UmMDIActive (var Message : TMessage);
var
I : Integer;
begin
for I:=0 to Pred(FButtons.Count) do
with TSpeedButton(FButtons[I]) do
if Tag = Message.WParam then
DrawWindowButton (TSpeedButton(FButtons[I]), true)
else if Tag = Message.LParam then
DrawWindowButton (TSpeedButton(FButtons[I]), false);
end;

procedure TfMain.FormCreate(Sender: TObject);
begin
FButtons := TList.Create();
FClientInstance := MakeObjectInstance(ClientWndProc);
FPrevClientProc := Pointer(GetWindowLong(ClientHandle,
GWL_WNDPROC));
SetWindowLong(ClientHandle,
GWL_WNDPROC, LongInt(FClientInstance));
end;

procedure TfMain.ClientWndProc(var Message: TMessage);
begin
with Message do
case Msg of
WM_MDICREATE:
begin
Result := CallWindowProc(FPrevClientProc,
ClientHandle,
Msg,
wParam,
lParam);
AddButtonToPanel (Result);
end;
WM_MDIDESTROY:
begin
RemoveButtonFromPanel(wParam);
Result := CallWindowProc(FPrevClientProc,
ClientHandle,
Msg,
wParam,
lParam);
end;
else
Result := CallWindowProc(FPrevClientProc,
ClientHandle,
Msg,
wParam,
lParam);
end;
end;

procedure TfMain.FormDestroy(Sender: TObject);
begin
FButtons.Free();
end;

procedure TfMain.AddButtonToPanel (AWindowHandle : HWND);
var
mdiButton : TSpeedButton;
AText : array[0..MAX_PATH] of char;
begin
GetWindowText(AWindowHandle, AText, SizeOf(AText));
DEBUGSTR("Window Text = %s", [AText]);
mdiButton := TSpeedButton.Create(Self);
with mdiButton do begin
Tag := AWindowHandle;
Parent := ButtonsPanel;
Width := 70;
Height := 22;
Left := FButtons.Count * (Width + 2) + 8;
Top := 4;
GroupIndex := 1;
AllowAllUp := true;
Glyph.Width := 16;
Glyph.Height := 16;
Glyph.TransparentColor := clCaptionText;
Layout := blGlyphLeft;
Margin := 2;
OnClick := WindowButtonClick;
FButtons.Add(mdiButton);
end;
RedrawButtons();
end;

procedure TfMain.RemoveButtonFromPanel (AWindowHandle : HWND);
var
I : Integer;
begin
for I:=0 to Pred(FButtons.Count) do
if TSpeedButton(FButtons[I]).Tag = Integer(AWindowHandle) then begin
TSpeedButton(FButtons[I]).Free();
FButtons.Delete(I);
Break;
end;
RedrawButtons();
end;

procedure TfMain.RedrawButtons;
var
ButtonWidth : Integer;
I : Integer;
begin
ButtonsPanel.Invalidate();
if FButtons.Count = 0 then
Exit;
ButtonWidth := (ButtonsPanel.Width - 16 - (FButtons.Count * 2)) DIV
FButtons.Count;
if ButtonWidth > MaxButtonWidth then
ButtonWidth := MaxButtonWidth;
for I:=0 to Pred(FButtons.Count) do
with TSpeedButton(FButtons[I]) do begin
Width := ButtonWidth;
Left := I * (Width + 2) + 8;
end;
end;

procedure TfMain.WindowButtonClick(Sender: TObject);
begin
with Sender AS TSpeedButton do
PostMessage(ClientHandle, WM_MDIACTIVATE, Tag, 0);
end;

procedure TfMain.DrawWindowButton(AButton: TSpeedButton; ADown : Boolean);
var
AText : array[0..255] of char;
Icon : TIcon;
IconHandle : THandle;
AWindowHandle : THandle;
begin
AWindowHandle := THandle(AButton.Tag);
GetWindowText(AWindowHandle, AText, SizeOf(AText));
AButton.Caption := AText;
AButton.Down := ADown;
IconHandle := GetClassLong(AWindowHandle, GCL_HICONSM);
if IconHandle = 0 then
IconHandle := GetClassLong(AWindowHandle, GCL_HICON);
if IconHandle = 0 then
IconHandle := SendMessage(AWindowHandle, WM_GETICON, ICON_SMALL, 0);
if IconHandle = 0 then
Iconhandle := SendMessage(AWindowHandle, WM_GETICON, ICON_BIG, 0);
if IconHandle = 0 then
IconHandle := Application.Icon.Handle;
if IconHandle <> 0 then begin
Icon := TIcon.Create();
Icon.Handle := IconHandle;
try
DrawIconEx(AButton.Glyph.Canvas.Handle, 0, 0, Icon.Handle,
AButton.Glyph.Width, AButton.Glyph.Height, 0, 0, DI_NORMAL);
finally
Icon.ReleaseHandle();
Icon.Free();
end;
end;
end;

procedure TfMain.Childwithicon1Click(Sender: TObject);
begin
with TfChildWithIcon.Create(Application) do
Show();
end;

procedure TfMain.ButtonsPanelResize(Sender: TObject);
begin
RedrawButtons();
end;

end.

← →
Игорь Шевченко (2003-12-09 21:02) [2]

unit Child;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TfChild = class(TForm)
ListBox: TListBox;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
procedure WM_MDIACTIVATE (var Message : TMessage); message WM_MDIACTIVATE;
end;

var
fChild: TfChild;
GlobalChildCount : Integer = 0;

implementation
uses
UserMessages;

{$R *.dfm}

procedure TfChild.FormCreate(Sender: TObject);
begin
Inc(GlobalChildCount);
Caption := Format("%d", [GlobalChildCount]);
end;

procedure TfChild.WM_MDIACTIVATE (var Message : TMessage);
var
Buf : array[0..255] of char;
begin
if THandle(Message.WParam) = Handle then begin
ListBox.Items.Add("Ich bin deactivated :-(");
if Message.LParam <> 0 then begin
GetWindowText(Message.LParam, Buf, sizeof(Buf));
ListBox.Items.Add (Format("%s is more lucky guy", [Buf]));
end;
SendMessage (Application.MainForm.Handle, UM_MDIACTIVE, Message.WParam,
Handle);
end else if THandle(Message.LParam) = Handle then begin
ListBox.Items.Add("Hurray! I am active again!");
if Message.WParam <> 0 then begin
GetWindowText(Message.WParam, Buf, sizeof(Buf));
ListBox.Items.Add (Format("%s is gone loser", [Buf]));
end;
SendMessage (Application.MainForm.Handle, UM_MDIACTIVE, Handle,
Message.LParam);
end;
end;

procedure TfChild.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caFree;
end;

end.

← →
Игорь Шевченко (2003-12-09 21:04) [3]

unit UserMessages;

interface
uses
Messages;
const
UM_MDIACTIVE = WM_USER + 555;

implementation

end.

← →
Игорь Шевченко (2003-12-09 21:05) [4]

unit ChildWithIcon;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Child, StdCtrls;

type
TfChildWithIcon = class(TfChild)
end;

implementation

{$R *.DFM}

end.

← →
Игорь Шевченко (2003-12-09 21:09) [5]

Программа имитирует Таксбар для MDI-окон

Как в MDI-форме получить message при создании MDI-Child-окна? Найти похожие ветки