Форум: "Основная";
Текущий архив: 2002.10.17;
Скачать: [xml.tar.bz2];

Вниз

Как в 5-х дельфях отследить добавление на форму MDIChild?   Найти похожие ветки 

← →
danilka   (2002-10-08 09:29) [0]

Как в 5-х дельфях отследить добавление на форму MDIChild или его закрытие?
без добавления кода в чилд-формы.

---

← →
Sectey   (2002-10-08 09:45) [1]

Сформулируй более конкретно, что ты хочишь получить.

---

← →
danilka   (2002-10-08 09:58) [2]

Есть форма имеющая FormStyle = fsMDIForm.
Есть куча различных форм с FormStyle = fsMDIChild
эти формы в различных местах, по нажатиям мышки там, по выборе пункта меню, добавляются на главную форму примерно таким образом:
Form1 :=TForm1.Create(Application);
Наверняка при этом генерируется какое-нибудь сообщение для главной формы или для application. какое?
мне надо перехватить создание и закрытие этих форм.
Достаточно подробно? :))

---

← →
Игорь Шевченко   (2002-10-08 10:03) [3]

Пример:


unit main;

interface

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

type
TfMain = class(TForm)
MainMenu1: TMainMenu;
Window1: TMenuItem;
New1: TMenuItem;
ButtonsPanel: TPanel;
NewIconChild1: TMenuItem;
Log1: TMenuItem;
View1: TMenuItem;
procedure New1Click(Sender: TObject);
procedure NewIconChild1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure View1Click(Sender: TObject);
private
ButtonsCount : Integer;
FClientInstance : TFarProc;
FPrevClientProc : TFarProc;

procedure ClientWndProc(var Message: TMessage);
procedure AddWindowToMonitor (WindowHandle : HWND);
procedure RemoveButtonFromPanel (TagValue : Integer);
public
{ Public declarations }
end;

var
fMain: TfMain;

implementation

uses
Child, IconChild, Monitor, Log;

{$R *.DFM}

{ TfMain }

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


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


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

procedure TfMain.ClientWndProc(var Message: TMessage);
var
AText : array[0..MAX_PATH] of char;
AControl : TWinControl;
LogString : String;
begin
with Message do
case Msg of
WM_MDICREATE:
begin
Result := CallWindowProc(FPrevClientProc,
ClientHandle,
Msg,
wParam,
lParam);
AddWindowToMonitor (Result);
LogString := "";
if GetWindowText(Result, AText, SizeOf(AText)) <> 0 then
LogString := Format("MDI child %s created", [AText]);
AControl := FindControl(Result);
if AControl <> nil then
LogString := LogString + " VCL component name is "+AControl.Name;
LogEvent(LogString);
end;
WM_MDIDESTROY:
begin
LogString := "";
if GetWindowText(wParam, AText, SizeOf(AText)) <> 0 then
LogString := Format("MDI child %s destroyed", [AText]);
AControl := FindControl(wParam);
if AControl <> nil then
LogString := LogString + " VCL component name is "+AControl.Name;
LogEvent(LogString);
RemoveButtonFromPanel(wParam);
Result := CallWindowProc(FPrevClientProc,
ClientHandle,
Msg,
wParam,
lParam);
end;
else
Result := CallWindowProc(FPrevClientProc,
ClientHandle,
Msg,
wParam,
lParam);
end;
end;


procedure TfMain.AddWindowToMonitor(WindowHandle: HWND);
var
AText : array[0..MAX_PATH] of char;
begin
GetWindowText(WindowHandle, AText, SizeOf(AText));
fMonitor.ListBox.Items.AddObject(AText, TObject(WindowHandle));
end;

procedure TfMain.View1Click(Sender: TObject);
begin
if Assigned(fLog) then
fLog.Show();
end;

procedure TfMain.RemoveButtonFromPanel(TagValue: Integer);
var
I : Integer;
begin
for I:=0 to Pred(ButtonsPanel.ControlCount) do
if ButtonsPanel.Controls[I].Tag = TagValue then begin
ButtonsPanel.Controls[I].Enabled := false;
Break;
end;
end;

end.


С уважением,

---

← →
danilka   (2002-10-08 10:06) [4]

:))
пасиба

---

Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2002.10.17;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.46 MB
Время: 0.007 c