Здравствуйте, melnaisogs, Вы писали:
M>MainForm.Component under MDI-Child Window ???
M>Как это сделать?
WM_NCXXX???
... << RSDN@Home 1.1 beta 2 >>
Если при компиляции и исполнении вашей программы не происходит ни одной ошибки — это ошибка компилятора :)))
Здравствуйте, melnaisogs, Вы писали:
M>MainForm.Component under MDI-Child Window ???
M>Как это сделать?
Попробовал — вот что получилось:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
// Эта кнопка будет создана в OnCreate формы
// Прототип Button1Click выглядит как OnMouseDown, т.к. по непонятным
// причинам OnClick не заработал
Button1: TButton;
procedure Button1Click(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
// Родная функция окна MDICLIENT. Это окно создается, если главное окно
// имеет свойство FormStyle = fsMDIForm, и при этом свойство ClientHandle
// представляет именно его
var
FOldClientWndProc: Pointer;
{ ---------------------------------------------------------------------------- }
// Новая функция окна MDICLIENT. Перекрыт WM_PAINT для отрисовки
// кнопки на панели
function NewWndProc(AHandle: THandle; AMsgCode: Integer;
WParam, LParam: Integer): Integer; stdcall;
var
LDC: HDC;
begin
Result := CallWindowProc(FOldClientWndProc, AHandle, AMsgCode,
WParam, LParam);
if AMsgCode = WM_PAINT then
with Form1.Button1 do
begin
// Этот вызов нужен для того, чтобы убрать странный эффект плавания
// кнопки поверх остальных MDIChild-окон после того, как она была нажата
SendToBack;
// Кнопка рисует себя на девайс контексте окна MDICLIENT
// на том самом месте, где она была бы, если бы все было
// по-человечески :-)
LDC := GetDC(AHandle);
PaintTo(LDC, Left, Top);
ReleaseDC(AHandle, LDC);
end;
end;
{ ---------------------------------------------------------------------------- }
// Некий обработчик нажатия кнопки
procedure TForm1.Button1Click(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
ShowMessage('Clicked');
end;
{ ---------------------------------------------------------------------------- }
// В OnCreate создается кнопка и производится субклассирование
// MDICLIENT
procedure TForm1.FormCreate(Sender: TObject);
begin
// Создаем кнопку. Важный номент - присвоение свойства ParentWindow
Button1 := TButton.Create(Self);
with Button1 do
begin
Caption := 'Test';
ParentWindow := ClientHandle;
OnMouseDown := Button1Click;
Top := 50;
Left := 100;
end;
// Субклассирование окна
FOldClientWndProc := Pointer(GetWindowLong(ClientHandle, GWL_WNDPROC));
SetWindowLong(ClientHandle, GWL_WNDPROC, Integer(@NewWndProc));
end;
end.
Здравствуйте, Sergey Ten, Вы писали:
ST>Здравствуйте, melnaisogs, Вы писали:
M>>MainForm.Component under MDI-Child Window ???
M>>Как это сделать?
ST>Попробовал — вот что получилось:
ST>ST> // Кнопка рисует себя на девайс контексте окна MDICLIENT
ST> // на том самом месте, где она была бы, если бы все было
ST> // по-человечески :-)
ST> LDC := GetDC(AHandle);
ST> PaintTo(LDC, Left, Top);
ST> ReleaseDC(AHandle, LDC);
ST>
Да и рисовать-то было необязательно — этот кусок можно убрать. А SendToBack все-таки нужен, но его можно вызывать в WM_ERASEBKGND:
function NewWndProc(AHandle: THandle; AMsgCode: Integer;
WParam, LParam: Integer): Integer; stdcall;
begin
Result := CallWindowProc(FOldClientWndProc, AHandle, AMsgCode,
WParam, LParam);
if AMsgCode = WM_ERASEBKGND then
Form1.Button1.SendToBack;
end;