组件??? ( 积分: 20 )

  • 主题发起人 主题发起人 oer_2001
  • 开始时间 开始时间
O

oer_2001

Unregistered / Unconfirmed
GUEST, unregistred user!
我写了一个组件,组件上有一个方法:RaiseSize;
construcotr create(AOwner: TComponent); override;
begin

end;
我想在AOwner上的某个消息如procedure WM_KEYDown......执得我这个组件上的RaiseSize方法。
不能去改AOwner上的代码,可能我没有源代码???
怎么做??
 
我写了一个组件,组件上有一个方法:RaiseSize;
construcotr create(AOwner: TComponent); override;
begin

end;
我想在AOwner上的某个消息如procedure WM_KEYDown......执得我这个组件上的RaiseSize方法。
不能去改AOwner上的代码,可能我没有源代码???
怎么做??
 
AOwner是TWinControl的话,不过一般可试化组件都是:
var
a:TWndMethod;
procedure MyWndProc(...);
begin
a(...);
....//你的处理
end;
constructor Create(AOwner: TComponent);
begin
inherited;
a:=TWinControl(AOwner).WindowProc;
b:=MyWndProc;
end;
 
这样不行
 
我的想法,不知是否可行。应该可以。你试试。
private
{ Private declarations }
xxxx :Txxxx;
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);

constructor Create(AOwner: TComponent);
begin
inherited;
xxxx:= (AOwner as Txxxx);
xxxx.onFormKeyDown := FormKeyDown;
end;

procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
....
....
end;
 
OK,这个问题很好办。
在你的控件中增加如下定义:
OldWndProc, NewWndProc: Pointer; // Procedure variables

procedure HookForm;
procedure UnhookForm;
procedure HookFormProc(var Msg: TMessage);

procedure [你的控件类型].HookForm;
begin
if (Owner as TWinControl) <> nil then
begin
// Hook the parent window
OldWndProc := Pointer(GetWindowLong((Owner as TWinControl).Handle, GWL_WNDPROC));
{$IFDEF DELPHI_6_UP}
NewWndProc := Classes.MakeObjectInstance(HookFormProc);
{$ELSE}
NewWndProc := MakeObjectInstance(HookFormProc);
{$ENDIF}
SetWindowLong((Owner as TWinControl).Handle, GWL_WNDPROC, LongInt(NewWndProc));
end;
end;

procedure [你的控件类型].HookFormProc(var Msg: TMessage);
begin
case Msg.Msg of
WM_KEYDown:
begin
RaiseSize;
end;

end;

// Pass the message on
Msg.Result := CallWindowProc(OldWndProc, (Owner as TWinControl).Handle,
Msg.Msg, Msg.wParam, Msg.lParam);
end;

procedure [你的控件类型].UnhookForm;
begin
if ((Owner as TWinControl) <> nil) and (Assigned(OldWndProc)) then
SetWindowLong((Owner as TWinControl).Handle, GWL_WNDPROC, LongInt(OldWndProc));
if Assigned(NewWndProc) then
{$IFDEF DELPHI_6_UP}
Classes.FreeObjectInstance(NewWndProc);
{$ELSE}
FreeObjectInstance(NewWndProc);
{$ENDIF}
NewWndProc := nil;
OldWndProc := nil;
end;

在控件的构造和析构增加如下代码:
procedure [你的控件类型].Create(AOwner: TComponent);
begin
inherited;
...
if Owner is TWinControl then
HookForm;
end;

destructor [你的控件类型].Destroy;
begin
try
...
finally
if not (csDesigning in ComponentState) then
begin
if Owner is TWinControl then UnhookForm;
end;
end
end;
 
hxb_leiyuan,可以了,
destructor [你的控件类型].Destroy;
begin
 //要加这一行
inherited;
try
...
finally
if not (csDesigning in ComponentState) then
begin
if Owner is TWinControl then UnhookForm;
end;
end
end;
 
为什么不行?我的代码就是这么写的
unit RoundRectPanel;

interface

uses
SysUtils, Classes, Controls, ExtCtrls,Graphics,Windows,messages,Forms,Dialogs;

type
TRoundRectPanel = class(TCustomPanel)
private
FRoundRect:Boolean;
procedure SetRoundRect(const Value: Boolean);
protected
procedure paint;override;
procedure resize;override;
procedure MyWndProc(Var msg:Tmessage);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property RoundRect:Boolean read FRoundRect write SetRoundRect;
property Align;
property Alignment;
property Anchors;
property AutoSize;
property BevelInner;
property BevelOuter;
property BevelWidth;
property BiDiMode;
property Caption;
property Color;
property FullRepaint;
property ParentShowHint;
property PopupMenu;
property TabOrder;
property TabStop;
property Visible;
property OnCanResize;
property OnClick;
property OnDblClick;
property OnEnter;
property OnExit;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnResize;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('QuickTone', [TRoundRectPanel]);
end;

{ TRoundRectPanel }
var
a:TWndMethod;
procedure TRoundRectPanel.MyWndProc(Var msg:Tmessage);
begin
if msg.Msg=WM_Close then
ShowMessage('关闭');
a(msg);


//....//你的处理
end;



constructor TRoundRectPanel.Create(AOwner: TComponent);
begin
inherited;
FRoundRect:=True;
a:=TWincontrol(AOwner).WindowProc;
TWincontrol(AOwner).WindowProc:=MyWndProc;
end;

destructor TRoundRectPanel.Destroy;
begin
inherited;
end;

procedure TRoundRectPanel.paint;
begin
inherited;
end;

procedure TRoundRectPanel.resize;
var
rgn:HRGN;
begin
inherited;
if RoundRect then
rgn:=CreateRoundRectRgn(0,0,width,height,20,20)
else
rgn:=CreateRectRgn(0,0,width,height);
SetWindowRgn(handle,rgn,True);
DeleteObject(rgn);{}
end;

procedure TRoundRectPanel.SetRoundRect(const Value: Boolean);
begin
FRoundRect := Value;
resize;
end;

end.
 
后退
顶部