怎样在组件中获取父窗体的事件？

[hangguojun]

我要开发一个组件，希望组件能随父窗体的变化（比如：移动、大小等）而变化。

如何实现？

[hangguojun]

有人知道吗？

[hangguojun]

这样的问题很难吗？

[王集鹄]

//参考如下代码
type
TTest = class(TControl)
private
FParentWndMethod: TWndMethod;
procedure ParentWndProc(var Msg: TMessage);
protected
procedure SetParent(AParent: TWinControl); override;
destructor Destroy; override;
end;

destructor TTest.Destroy;
begin
if Assigned(Parent) then
Parent.WindowProc := FParentWndMethod;
inherited;
end;

procedure TTest.ParentWndProc(var Msg: TMessage);
begin
case Msg.Msg of
WM_MOUSEMOVE:
begin
TForm1(Parent).Memo1.Lines.Add(
IntToStr(LOWORD(Msg.lParam)) + ',' + IntToStr(HIWORD(Msg.lParam))
);
end;
end;
if Assigned(FParentWndMethod) then FParentWndMethod(Msg);
end;

procedure TTest.SetParent(AParent: TWinControl);
begin
inherited;
if Assigned(AParent) then
begin
FParentWndMethod := AParent.WindowProc;
AParent.WindowProc := ParentWndProc;
end else FParentWndMethod := nil;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
with TTest.Create(Self) do
Parent := Self;
end;

[亮剑_]

楼上的不错，可一试

[hangguojun]

感谢：zswang(伴水清清)(专家门诊清洁工)

这样可以截获父窗体信息WM_WINDOWPOSCHANGED，但是父窗体不能改变大小，而且将组件放到Form上时，Delphi突然无提示关闭(原来正常)。

不知何原因？

[hangguojun]

我自己来提前

[王集鹄]

//我测试了可以改变大小
procedure TTest.ParentWndProc(var Msg: TMessage);
begin
case Msg.Msg of
WM_WINDOWPOSCHANGED:
begin
Form1.Memo1.Lines.Add(
IntToStr(PWINDOWPOS(Msg.LParam).x) + ',' + IntToStr(PWINDOWPOS(Msg.LParam).y));
end;
end;
if Assigned(FParentWndMethod) then FParentWndMethod(Msg);
end;
//注意最后一条语句 //需要调用Parent原来的句柄处理方法

[hangguojun]

经测试，可以改变大小。
但是需自己修改父窗体的ClientWidth、ClientHeight。

还有一点：组件中修改了重载了父窗体的WindowProc，并以可视组件的形式放置到Form上时，造成Delphi突然关闭。

谁能帮助解决？

[王集鹄]

procedure TTest.SetParent(AParent: TWinControl);
begin
inherited;
if csDesigning in ComponentState then Exit; //判断一下,在设计期间就不启用
if Assigned(AParent) then
begin
FParentWndMethod := AParent.WindowProc;
AParent.WindowProc := ParentWndProc;
end else FParentWndMethod := nil;
end;

[hangguojun]

谢谢，和我的想法一致
我原本想将你加的这一句写上去的。

启用这一句后，设计期是解决了，可是执行错误。

在ParentWndProc时出现错误：Stack overflow

为什么？

[hangguojun]

有人会吗？

[阿呆_]

hehe, 这么明显的出错地方都看不出来?

Hint: 请连续执行Parent := Form1两遍.

[hangguojun]

真的吗？不信！

[hangguojun]

此贴很难!

难倒众人

[hangguojun]

顶上去

[atsoftworld]

学习

[gpg]

关于捕获消息的问题已经解决了。楼主要考虑处理别的问题。

[GoldProgramer]

Align属性不行吗？

[hangguojun]

To GoldParamer: Align可以，但是用它之后。我其他的控件对齐就不好解决了。

To gpg(snake): 捕获消息的问题其实没有彻底解决，正是因为增加了AParent,WndProc导致控件错误

[hangguojun]

明日散分