谁有画直线的控件呀？？？小弟急用！！！(75分)

那位大哥有比较好的画直线的控件呀？比如huizhang的Tline等等，类似的~！
最好有源码的~！！！有的话，发到dangmengfei@163.com 万分感谢~！！！

请各位大哥帮帮小弟吧~！！。。斑竹，救命啊~~~~~~~~~~

这儿有一个


unit LinLine;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, CommCtrl;

type
TFrameType = (ftOuter,ftInner,ftMiddle);
TDragBox = (dbNone,dbDrag,dbPoint1,dbPoint2);
TOnPaintEvent = procedure (Sender: TObject; Canvas: TCanvas; Rect: TRect) of object;

TLinLine = class(TGraphicControl)
private
{ Private declarations }
FPoint1,FPoint2:TPoint;
FHasInit:Boolean;
FAutoForeGround: Boolean;
FReadOnly: Boolean;
FOnPaint: TOnPaintEvent;
FFrameType: TFrameType;
FAutoSize: Boolean;
FCaption: String;
FHideFrame: Boolean;
FFrameColor: TColor;
FBoxSize: Integer;
FBoxColor: TColor;
FActiveFrameColor: TColor;
FPassiveFrameColor: TColor;
FTextColor: TColor;
FDrawFrame: Boolean;
FDrawBoxes: Boolean;
FShowPos: Boolean;
FShowSize: Boolean;
FDragBox: TDragBox;
FPosX: Integer;
FPosY: Integer;
FHasFocus: Boolean;
procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
procedure SetFocus(Value: Boolean);
procedure SetAutoSize(Value: Boolean);
procedure SetHideFrame(Value: Boolean);
procedure SetCaption(Value: String);
procedure SetFrameBox(PLeft,PTop,PWidth,PHeight: Integer);
procedure SetFrameType(Value: TFrameType);
procedure SetBoxSize(Value: Integer);
procedure SetBoxColor(Value: TColor);
procedure SetActiveFrameColor(Value: TColor);
procedure SetPassiveFrameColor(Value: TColor);
procedure SetTextColor(Value: TColor);
procedure SetDrawFrame(Value: Boolean);
procedure SetDrawBoxes(Value: Boolean);
procedure SetShowPos(Value: boolean);
procedure SetShowSize(Value: Boolean);
procedure WMLMouseDown(var Message: TMessage); message WM_LBUTTONDOWN;
procedure WMLMouseUp(var Message: TMessage); message WM_LBUTTONUP;
procedure MouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
function NearLine(X,Y: Integer):boolean;
protected
procedure paint; override;
public
procedure RemoveAllFocus;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property AutoForeGround: Boolean read FAutoForeGround write FAutoForeGround;
property AutoSize: Boolean read FAutoSize write SetAutoSize;
property FrameType: TFrameType read FFrameType write SetFrameType;
property HidePassiveFrame: Boolean read FHideFrame write SetHideFrame;
property Caption: String read FCaption write SetCaption;
property BoxSize: Integer read FBoxSize write SetBoxSize;
property BoxColor: TColor read FBoxColor write SetBoxColor;
property ActiveFrameColor: TColor read FActiveFrameColor write SetActiveFrameColor;
property PassiveFrameColor: TColor read FPassiveFrameColor write SetPassiveFrameColor;
property DrawFrame: Boolean read FDrawFrame write SetDrawFrame;
property DrawBoxes: Boolean read FDrawBoxes write SetDrawBoxes;
property ShowPos: Boolean read FShowPos write SetShowPos;
property ShowSize: Boolean read FShowSize write SetShowSize;
property InfoTextColor: TColor read FTextColor write SetTextColor;
property Focus: Boolean read FHasFocus write SetFocus;
property Font;
property OnClick;
property PopupMenu;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnDblClick;
property OnStartDrag;
property OnDragOver;
property OnDragDrop;
property OnEndDrag;
property OnPaint: TOnPaintEvent read FOnPaint write FOnPaint;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('DPD', [TLinLine]);
end;

function between(PVal1,PVal2,PVal3: Integer):Boolean;
begin
if (PVal1 > PVal2) and (PVal1 < PVal3) then Result := True
else if (PVal1 > PVal3) and (PVal1 < PVal2) then result := True
else Result := False;
end;


constructor TLinLine.Create(AOwner: TComponent);
begin
inherited create(AOwner);
FBoxColor := clBlack;
FActiveFrameColor := clBlack;
FPassiveFrameColor := clGray;
FBoxSize := 5;
Height:=10; ////
Width:=20; ////
FHasInit:=false;
FDrawBoxes := True;
FDrawFrame := True;
FFrameType := ftOuter;
FAutoForeGround := True;
OnMouseMove := MouseMove;
end;

destructor TLinLine.Destroy;
begin
inherited Destroy;
end;

procedure TLinLine.Paint;
var
LHalfBox: Integer;
LRect,LClient: TRect;
Point1,Point2:Tpoint;

//StrTmp:string;
begin

if FAutoSize then SetBounds(Left,Top,Canvas.Textwidth(FCaption),Canvas.TextHeight(FCaption));
LRect := ClientRect;
if FFrameType = ftOuter then LHalfBox := 0
else if FFrameType = ftInner then LHalfBox := FBoxSize
else LHalfBox := (FBoxSize div 2);

if (not FHasInit) or (csDesigning in ComponentState) then
begin
FPoint1:=point(Left +FBoxSize ,top +FBoxSize );
FPoint2:=point(left+width -FBoxSize ,top+FBoxSize );
FHasInit:=true;
end;

//Calculate Client area that does not intercept the drag boxes;
LRect.Left := LRect.Left + LHalfBox + 1;
LRect.Right := LRect.Right - LHalfBox - 1;
LRect.Top := LRect.Top - LHalfBox;
LRect.Bottom := LRect.Bottom - LHalfBox - 1;

//client Area as defined by the frame drawn
LClient.Left := LHalfBox;
LClient.Top := LHalfBox;
LClient.right := width-1 - LHalfBox;
LClient.Bottom := Height - 1 - LHalfBox;

Point1:=ScreenToClient( Parent.ClientToScreen(FPoint1));
Point2:=ScreenToClient( Parent.ClientToScreen(FPoint2));
////MessageDlg(IntToStr(Point1.x)+':'+IntToStr(Point1.y)+':'+IntToStr(Point2.x)+':'+IntToStr(Point2.y), mtInformation, [mbOk], 0);

if assigned(FOnPaint) then FOnPaint(Self,Canvas,LClient);

//draw the frame
if (FHasFocus and DrawFrame) or (not FHasFocus and not FHideFrame) then begin
if FDrawFrame then begin
canvas.pen.color := FFrameColor;
Canvas.MoveTo(Point1.x,Point1.y+ LHalfBox);
Canvas.LineTo(Point2.x,Point2.y+ LHalfBox);
//Canvas.MoveTo(LClient.left,LClient.top);
//Canvas.LineTo(LClient.right,LClient.bottom);

end;
end;
//Draw the drag boxes
LHalfBox := (FBoxSize div 2);
if FDrawBoxes and (FHasFocus or (csDesigning in ComponentState)) then begin
Canvas.brush.color := FBoxColor;
Canvas.FillRect(rect(Point1.x - LHalfBox ,Point1.y - LHalfBox ,Point1.x + LHalfBox ,Point1.y + LHalfBox));
Canvas.FillRect(rect(Point2.x - LHalfBox ,Point2.y - LHalfBox ,Point2.x + LHalfBox ,Point2.y + LHalfBox));
end;

//Set the fixed font for the optional position information
Canvas.Font.Color := FTextColor;
Canvas.Brush.style := bsClear;
canvas.font.Name := 'MS Sans Serif';
canvas.font.Style := [];
canvas.font.height := 10;

if FShowPos and FHasFocus then begin
Canvas.Brush.style := bsClear;
Canvas.TextRect(LRect,FBoxSize+ 2,FBoxSize,'L:' + IntToStr(Left) + ' T:' + IntToStr(Top));
end;
if FShowSize and FHasFocus then begin
Canvas.TextRect(LRect,FBoxSize + 2,FBoxSize + (Canvas.font.Height * 1) + 3,'W:' + IntToStr(Width) + ' H:' + IntToStr(Height));
end;
Canvas.Font := Font;
Canvas.TextRect(LRect,(Width - Canvas.Textwidth(FCaption)) div 2,(Height - Canvas.TextHeight(FCaption)) div 2,FCaption);



//StrTmp:=IntToStr(Point1.x)+':'+IntToStr(Point1.y)+':'+IntToStr(Point2.x)+':'+IntToStr(Point2.y);
//Canvas.TextRect(LRect,2,2,Strtmp);

end;

procedure TLinLine.SetFrameType(Value: TFrameType);
begin
if FFrameType = Value then exit;
FFrameType := Value;
Invalidate;
end;

procedure TLinLine.SetBoxSize(Value: Integer);
begin
if Value = FBoxSize then exit;
if value < 2 then exit;
if value > 50 then exit;
FBoxSize := ((Value div 2) * 2) + 1; //保证是一个奇数
invalidate;
end;

procedure TLinLine.SetBoxColor(Value: Tcolor);
begin
if Value = FBoxColor then exit;
FBoxColor := Value;
invalidate;
end;

procedure TLinLine.SetActiveFrameColor(Value: Tcolor);
begin
if Value = FActiveFrameColor then exit;
FActiveFrameColor := Value;
invalidate;
end;

procedure TLinLine.SetPassiveFrameColor(Value: Tcolor);
begin
if Value = FPassiveFrameColor then exit;
FPassiveFrameColor := Value;
invalidate;
end;

procedure TLinLine.SetTextColor(Value: Tcolor);
begin
if Value = FTextColor then exit;
FTextColor := Value;
invalidate;
end;

procedure TLinLine.SetDrawFrame(Value: Boolean);
begin
if Value = FDrawFrame then exit;
FDrawFrame := Value;
invalidate;
end;


procedure TLinLine.SetDrawBoxes(Value: Boolean);
begin
if Value = FDrawBoxes then exit;
FDrawBoxes := Value;
invalidate;
end;

procedure TLinLine.SetShowPos(Value: boolean);
begin
if Value = FShowPos then exit;
FShowPos := Value;
invalidate;
end;

procedure TLinLine.SetShowSize(Value: Boolean);
begin
if Value = FShowSize then exit;
FShowSize := Value;
invalidate;
end;

procedure TLinLine.WMLMouseDown(var Message: TMessage);
begin
FPosX := Message.LParamLo;
FposY := Message.LParamHi;
if FAutoForeGround then BringToFront;
if (Message.WParamLo <> 5) then begin
if FHasFocus =false then begin
RemoveAllFocus;
FHasFocus := True;
end;
end else //Shift按键被按下，要多选
FHasFocus := not FHasFocus;
if FHasFocus then begin
FFrameColor := FActiveFrameColor;
SetCapture(TForm(Parent).handle);
TForm(Parent).OnMouseMove := FormMouseMove;
end;
invalidate;
end;

procedure TLinLine.WMLMouseUp(var Message: TMessage);
begin
releaseCapture;
FPosX := -1;
FPosY := -1;
FDragBox := dbNone;
invalidate
end;

procedure TLinLine.FormMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
var
LPoint: TPoint;
begin
//Translate coodinates to object
LPoint := ScreenToClient( Tform(Parent).ClientToScreen(point(X,Y)));
MouseMove(Sender,Shift,LPoint.X,Lpoint.Y);
end;

procedure TLinLine.MouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
var
Point1, Point2: TPoint;
HalfBoxSize,Temp:integer;
begin
//Prepare some variables
HalfBoxSize:=FBoxSize div 2;
Point1:=ScreenToClient( parent.ClientToScreen(FPoint1));
Point2:=ScreenToClient( parent.ClientToScreen(FPoint2));

if not (ssLeft in Shift) then begin
FDragBox := dbNone;
//Check if cursor is over any of the most left boxes
if (between(X,Point1.x - HalfBoxSize,Point1.x + HalfBoxSize) and between(Y,Point1.y - HalfBoxSize,Point1.y + HalfBoxSize)) then begin Cursor := crSizeALL; FDragBox := dbPoint1; end
else if (between(X,Point2.x - HalfBoxSize,Point2.x + HalfBoxSize) and between(Y,Point2.y - HalfBoxSize,Point2.y + HalfBoxSize)) then begin Cursor := crSizeALL; FDragBox := dbPoint2; end
else if (between(X,0,width) and between(Y,0,Height) and NearLine(X,Y)) or (FHasFocus and (ssShift in shift))then begin Cursor := crDefault; FDragBox := dbDrag; end; //用点到直线的距离来解决拖动问题
end else begin
//Make size changes if clicked
if (FPosX >= 0) and (FPosY >= 0 ) then begin
if FDragBox = dbPoint1 then begin
Point1.x:=X;Point1.y:= Y ;
FPoint1:=parent.ScreenToClient( ClientToScreen(Point1));
Temp:=Point1.x;
if Point2.x<Point1.x then begin
Point1.X:=Point2.x;
Point2.X:=Temp;
end;
Temp:=point1.Y;
if Point2.y<Point1.y then begin
Point1.Y:=Point2.y;
Point2.Y:=Temp;
end;

Point1:=parent.ScreenToClient( ClientToScreen(Point1));
Point2:=parent.ScreenToClient( ClientToScreen(Point2));
SetFrameBox(Point1.X - HalfBoxSize,Point1.Y - HalfBoxSize,Point2.X - Point1.X + FBoxSize,Point2.Y - Point1.Y + FBoxSize);
end else if FDragBox = dbPoint2 then begin
Point2.x:=X ;Point2.y:=Y ;
FPoint2:=parent.ScreenToClient( ClientToScreen(Point2));
Temp:=Point1.x;
if Point2.x<Point1.x then begin
Point1.X:=Point2.x;
Point2.X:=Temp;
end;
Temp:=point1.Y;
if Point2.y<Point1.y then begin
Point1.Y:=Point2.y;
Point2.Y:=Temp;
end;

Point1:=parent.ScreenToClient( ClientToScreen(Point1));
Point2:=parent.ScreenToClient( ClientToScreen(Point2));
SetFrameBox(Point1.X - HalfBoxSize,Point1.Y - HalfBoxSize,Point2.X - Point1.X + FBoxSize,Point2.Y - Point1.Y + FBoxSize);
end else if FDragBox = dbDrag then begin
FPoint1.X:=FPoint1.X+ X - FPosX;
FPoint1.Y:=FPoint1.Y+ Y - FPosY;
FPoint2.X:=FPoint2.X+ X - FPosX;
FPoint2.Y:=FPoint2.Y+ Y - FPosY;
SetFrameBox(Left - (FPosX - X),Top - (FPosY - Y),Width,Height);
invalidate;
end;
end;
end;
end;

function TLinLine.NearLine(X,Y: Integer):boolean;
begin
result := (self.Canvas.Pixels(X,Y)= self.FFrameColor) or (self.Canvas.Pixels(X-1,Y)= self.FFrameColor) or (self.Canvas.Pixels(X,Y -1)= self.FFrameColor) or (self.Canvas.Pixels(X+1,Y)= self.FFrameColor)or (self.Canvas.Pixels(X,Y+1)= self.FFrameColor) then

end;


procedure TLinLine.SetFrameBox(PLeft,PTop,PWidth,PHeight: Integer);
begin
if (PWidth < FBoxSize) or (PHeight < FBoxSize) then exit;
SetBounds(PLeft,PTop,PWidth,PHeight);
end;

procedure TLinLine.WMGetDlgCode(var Message: TWMGetDlgCode);
begin
inherited;
Message.Result := DLGC_WANTARROWS;
end;

procedure TLinLine.SetCaption(Value: String);
begin
if Value = FCaption then exit;
FCaption := Value;
invalidate;
end;

procedure TLinLine.SetHideFrame(Value: Boolean);
begin
if Value = FHideFrame then exit;
FHideFrame := Value;
Invalidate;
end;

procedure TLinLine.SetAutoSize(Value: Boolean);
begin
if Value = FAutoSize then exit;
FAutoSize := Value;
invalidate;
end;

procedure TLinLine.RemoveAllFocus;
//var
// i: Integer;
// LRectBox: TLinLine;
begin
SendMessage (parent.Handle, WM_RBUTTONDOWN,0, MakeLong (0, 0));
application.ProcessMessages;
application.ProcessMessages;
// for i := 0 to Owner.ComponentCount - 1 do begin
// if Owner.Components is TLinLine then begin
// LRectBox := TLinLine(Owner.Components);
// if LRectBox.FHasFocus then begin
// LRectBox.FHasFocus := False;
// LRectBox.Invalidate;
// end;
// end;
// end;
end;

procedure TLinLine.SetFocus(Value: Boolean);
begin
if Value = FHasFocus then exit;
FHasFocus := Value;
invalidate;
end;


end.

谢谢你给我提供的控件，arhaha，对于这个控件，我有几个问题问一下：
1、我自己做的其他图形空间是继承TCustomControl的，在和这个控件进行置前置后操作的时候，
发现这个控件总是在最底层，请问是什么原因，如何解决呢？？
2、控制这个控件的2个点，在点中后如何去掉呢？？
我是一个新手还请多多帮忙~！

画直线也要控件？画什么样的直线？

第一个问题，我也不太清楚，不知你的代码是咋样的？
第二个问题，
---控制这个控件的2个点，在点中后如何去掉呢？？
你应该删除paint过程中的
//Draw the drag boxes
LHalfBox := (FBoxSize div 2);
if FDrawBoxes and (FHasFocus or (csDesigning in ComponentState)) then begin
Canvas.brush.color := FBoxColor;
Canvas.FillRect(rect(Point1.x - LHalfBox ,Point1.y - LHalfBox ,Point1.x + LHalfBox ,Point1.y + LHalfBox));
Canvas.FillRect(rect(Point2.x - LHalfBox ,Point2.y - LHalfBox ,Point2.x + LHalfBox ,Point2.y + LHalfBox));
end;
部分。

第一个问题，我我用的是TCustomControl的BringToFront和SendToBack。。

mephi,
你可以将控件也继承自TCustomControl而不是TGraphicControl即可。
另外，
1、NearLine函数中的Pixels(a,b)应该是Pixels[a,b];
2、在TLinLine.WMLMouseDown(var Message: TMessage);
begin
FPosX := Message.LParamLo;
FposY := Message.LParamHi;
if FAutoForeGround then BringToFront;
....
改为：
TLinLine.WMLMouseDown(var Message: TMessage);
begin
FPosX := Message.LParamLo;
FposY := Message.LParamHi;
if not NearLine(FPosX ,FPosY) then
begin
.....//向下层控件发送被点击的消息
exit;
end;
if FAutoForeGround then BringToFront;
....

arhaha
谢谢你，你说的1我已经改了，之前说的，置前置后的问题，我也通过。该换继承类解决了。
关于2，你说的.....//向下层控件发送被点击的消息
是不是要用到windows的消息系统？？
对于这个方面我了解的不是很多，能不能说的稍微详细一点，辛苦了。

另外，还有问题。
1，当我把直线的继承类变为TCustomControl的时候，当拖动直线转动的时候，直线周围的矩形域
也会出现，当直线在前面的时候，会遮住后面的图形。有什么方法解决吗？？
2，如果当我把直线的继承类转变成TGraphicControl的时候，不会出现上面的问题，不过，牵扯
到另一个问题，我引用的一个在矩形周围生成8个黑框的的一个单元来控制我做的图形的改变大小，
拖放等等（源码一会附上），我在图形的MouseDown事件里创建了这8个黑框，改成GraphicControl
后，当拖动整个图形移动的时候，8个框会被擦掉，有什么好的解决办法吗？？

下面是画8个框的代码：

unit sizercontrol;

interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
type
TSizerControl = class(TGraphiccontrol)
private
FControl: TControl;
FRectList: Array [1..8] of TRect;
FPosList: Array [1..8] of Integer;

{ Private declarations }
protected
{ Protected declarations }
public
constructor Create(AOwner: TComponent; AControl: TControl);
procedure CreateParams(var Params: TCreateParams); override;
procedure Createhandle;override;
procedure WmNcHitTest(var Msg: TWmNcHitTest); message wm_NcHitTest;
procedure WmSize(var Msg:TWmSize); message wm_Size;
procedure WmLButtonDown(var Msg: TWmLButtonDown); message wm_LButtonDown;
procedure WmMove(var Msg: TWmMove); message Wm_Move;
procedure Paint; override;
procedure SizeControlExit(Sender: TObject);

{ Public declarations }
published
property PopUpMenu;
{ Published declarations }
end;
const
sc_DragMove: Longint = $F012;
procedure Register;


implementation

constructor TSizerControl.Create(AOwner: TComponent; AControl: TControl);
var
R: TRect;
begin
inherited Create(AOwner);
FControl := AControl;
OnExit := SizeControlExit;

R := FControl.BoundsRect;
InflateRect(R,2,2);
BoundsRect := R;
Parent := FControl.Parent;
FPosList[1] := htTopLeft;
FPosList[2] := htTop;
FPosList[3] := htTopRight;
FPosList[4] := htRight;
FPosList[5] := htBottomRight;
FPosList[6] := htBottom;
FPosList[7] := htBottomLeft;
FPosList[8] := htLeft;

end;
procedure TSizerControl.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
//&amp;Ocirc;&amp;ouml;&amp;frac14;&amp;Oacute;&amp;Iacute;&amp;cedil;&amp;Atilde;÷&amp;Igrave;&amp;Oslash;&amp;ETH;&amp;Ocirc;
Params.ExStyle := Params.ExStyle
+ WS_EX_TRANSPARENT;
end;

procedure TSizerControl.Createhandle;
begin
inherited Createhandle;
SetFocus;
end;

procedure TSizerControl.WmNcHitTest(var Msg: TWmNcHitTest);
var
Pt: TPoint;
I: Integer;
begin
Pt := Point(Msg.XPos, Msg.YPos);
Pt := ScreenToClient(Pt);
Msg.Result := 0;
//&amp;frac14;ì&amp;sup2;&amp;acirc;&amp;Ecirc;ó±ê&amp;Icirc;&amp;raquo;&amp;Ouml;&amp;Atilde;&amp;sup2;&amp;cent;&amp;cedil;&amp;Auml;±&amp;auml;×&amp;acute;&amp;Igrave;&amp;not;
for I := 1 to 8 do
if PtInRect(FRectList, Pt) then
Msg.Result := FPosList;
if Msg.Result = 0 then
inherited;
end;


procedure TSizerControl.WmSize(var Msg:TWmSize);
var
R: TRect;
begin
R := BoundsRect;
InflateRect( R, -2, -2);
FControl.BoundsRect := R;
//&amp;frac14;&amp;AElig;&amp;Euml;&amp;atilde;8&amp;cedil;&amp;ouml;&amp;ordm;&amp;Uacute;·&amp;frac12;&amp;iquest;ò
FRectList[1] := Rect(0 ,0, 5, 5);
FRectList[2] := Rect(Width div 2 - 3, 0, Width div 2 + 2, 5);
FRectList[3] := Rect(Width - 5, 0, Width, 5);
FRectList[4] := Rect(Width - 5, height div 2 - 3, Width, Height div 2 + 2);
FRectList[5] := Rect(Width - 5, Height - 5, Width, Height);
FRectList[6] := Rect(Width div 2 - 3, Height - 5, Width div 2 + 2, Height);
FRectList[7] := Rect(0, Height -5, 5, Height);
FRectList[8] := Rect(0, Height div 2 - 3, 5, Height div 2 + 2);
end;


procedure TSizerControl.WmLButtonDown(var Msg: TWmLButtonDown);
begin
//&amp;Ouml;&amp;acute;&amp;ETH;&amp;ETH;&amp;Iacute;&amp;Iuml;&amp;para;&amp;macr;&amp;Atilde;ü&amp;Aacute;&amp;icirc;
Perform(Wm_SysCommand, sc_DragMove, 0);
// self.Paint;
end;

procedure TSizerControl.WmMove(var Msg: TWmMove);
var
R: TRect;
begin
R := BoundsRect;
InflateRect( R, -2, -2);
FControl.Invalidate;
FControl.BoundsRect := R;
end;

procedure TSizerControl.Paint;
var
I: Integer;
begin
Canvas.Brush.Color := clBlack;
for I := 1 to 8 do
with FRectList do
Canvas.Rectangle (Left, Top, Right, Bottom);
// self.BringToFront;
end;

procedure TSizerControl.SizeControlExit(Sender: TObject);
begin
Free;
end;



procedure Register;
begin
RegisterNoicon([TSizerControl]);
end;


end.

纠正，sizercontrol是继承TCustomControl的。

其实我这儿有用TGraphicControl继承下来的直线、矩形、椭圆、圆角矩形的控件，
它们之间其实都差不多，你知道一个怎么做，其他的都一样了。没有必要这个用
TGraphicControl，那个用TCustomControl的，自然没有那么多问题。

直线和箭头要实现随意拖动，比较困难，而且还要在直线上实现右键菜单功能，
而且当这条直线成为斜线的时候，直线的周围出现了不可见的矩形域，则鼠标在上面无法
实现对它后面的画布的鼠标操作了。

關注一下

实现随意拖动，我的控件应该已经实现了。
实现右键菜单功能，你可以再在里面加一个TMenu的属性，并在MouseUp过程中进行处理就行了。或者在程序运行时由自己写的MouseUp事件代码进行处理。
至于鼠标在上面无法实现对它后面的画布的鼠标操作了，我的代码中已经提示了，如果鼠标没有点中直线，就发消息给下面一层的控件，
自然就可以了，不知你为什么还没有弄明白？

这些矢量编辑都是基于对象的，也可以直接在一个有Canvas属性得控件中用链表的形式记下在Canvas中直接画的几何图形的方式实现。
而且不会出现上层覆盖下层的问题。

关注

arhaha:
不好意思，因为我刚开始学DLEPHI不久，对于许多概念不是很清楚，请你别介意。

前面你给的提示我看过了，不过因为“是不是要用到windows的消息系统？？对于这个方面我
了解的不是很多，能不能说的稍微详细一点，辛苦了。”

右键菜单功能我已经实现，我把右键菜单的创建放到了LinLine.Create里，不过当我用到删除
命令的时候，系统会报错（我用的是self.free），是不是有别的方法进行自我删除？？

关于你提到的链表，是不是TObjectList?如果是，怎样在删除的时候，同时从链表里释放这个
对象？？
如果可能的话，可不可以把你的那些控件发到我的邮箱里，让我学习一下？我了解给的分少了
一些，有可能的话，我会多加的，万分感谢~！

你有邮箱吗??

我这有一个类似Windows画图板的实例程序,可以帮你学习!!

需要的话联络我,我的邮箱地址:cnzhw007@tellyes.com!!

cnzhw007:
谢谢你的程序，我收到了，虽然画的时候闪的太厉害，不过对我还是有启发的。

多人接受答案了。