为什么不行?我的代码就是这么写的
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.