谢谢两位的回复,正如BaKuBaKu所说,本来我用的TShape,后来改为TCustomControl,希望用到
TWincontrol的bringtofront方法,但是好像不管用.
我的控件的源程序如下:
请两位帮忙看看,关键是重画以后,线条始终被panel挡住一部分.
以下是控件源程序:
unit MyLine;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
const
SX_MYMESSAGE=WM_USER + 100;
type
TMyLine = class(TCustomControl)
private
{ Private declarations }
HdlRgn,HdlBrush:THandle;
FOldProc: TWndMethod;
// FWndProc: TWndMethod;
protected
{ Protected declarations }
procedure DoPaint(Var Msg: TMessage);message SX_MYMESSAGE;
procedure NewWndProc(var Message: TMessage);
public
{ Public declarations }
Constructor Create(AOwner:TComponent);override;
destructor Destroy; override;
procedure aaa;
procedure GetWndProc;
published
{ Published declarations }
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Samples', [TMyLine]);
end;
{ TMyLine }
procedure TMyLine.aaa;
Var
DC:HDC;
begin
DC:=GetDC(Parent.Handle);
FillRgn(DC,HdlRgn,HdlBrush);
end;
constructor TMyLine.Create(AOwner: TComponent);
Var
Pnts:Array[1..4]of TPoint;
begin
inherited;
Pnts[1].x:=20; Pnts[1].y:=20;
Pnts[2].x:=200; Pnts[2].y:=240;
Pnts[3].x:=239; Pnts[3].y:=245;
Pnts[4].x:=21; Pnts[4].y:=19;
HdlBrush:=CreateSolidBrush(clRed);
HdlRgn:=CreatePolygonRgn(Pnts,4,Winding);
end;
destructor TMyLine.Destroy;
begin
if Assigned(Parent) then Parent.WindowProc:=FOldProc;
inherited;
end;
procedure TMyLine.DoPaint(var Msg: TMessage);
Var
Pnts:Array[1..4]of TPoint;
begin
Pnts[1].x:=20; Pnts[1].y:=20;
Pnts[2].x:=200; Pnts[2].y:=240;
Pnts[3].x:=201; Pnts[3].y:=239;
Pnts[4].x:=21; Pnts[4].y:=19;
HdlBrush:=CreateSolidBrush(clRed);
HdlRgn:=CreatePolygonRgn(Pnts,4,Winding);
aaa;
end;
procedure TMyLine.GetWndProc;
begin
if Assigned(Parent) then
begin
FOldProc:=Parent.WindowProc;
Parent.WindowProc:=NewWndProc;
end;
end;
procedure TMyLine.NewWndProc(var Message: TMessage);
begin
inherited;
if Message.Msg=WM_PAINT then PostMessage(Handle,SX_MYMESSAGE,0,0);//截获WM_Paint消息
FOldProc(Message);
end;
以下是调用:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls,MyLine;
type
TForm1 = class(TForm)
Button1: TButton;
Shape1: TShape;
Panel1: TPanel;
Label1: TLabel;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Panel1Click(Sender: TObject);
private
{ Private declarations }
LineObj: TMyLine;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
begin
LineObj:=TMyLine.Create(self);
LineObj.Parent:=self;
LineObj.GetWndProc;
LineObj.aaa;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
LineObj.BringToFront;
end;
procedure TForm1.Panel1Click(Sender: TObject);
begin
showmessage('ok');
end;
end.