求TWinControl继承下的TShape! ( 积分: 100 )

要这样控件的原因：
TShape继承TgraphicControl 这样的控件会被TWincontrol压在后面
只有TShape在改变大小和移动时下方的控件不会闪烁。。

求大侠帮忙！

把TShape的源码复制过来，让它从TCustomControl继承下来，再把csCaptureMouse加入ControlStyle就行了。

unit WinShape;

interface

uses
SysUtils, Classes, Controls, Graphics, extctrls;

type
TShapeType = (stRectangle, stSquare, stRoundRect, stRoundSquare,
stEllipse, stCircle);

//TShape = class(TGraphicControl) //改这行↓
TWinShape = class(TCustomControl)
private
FPen: TPen;
FBrush: TBrush;
FShape: TShapeType;
procedure SetBrush(Value: TBrush);
procedure SetPen(Value: TPen);
procedure SetShape(Value: TShapeType);
protected
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
procedure StyleChanged(Sender: TObject);
property Align;
property Anchors;
property Brush: TBrush read FBrush write SetBrush;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Constraints;
property ParentShowHint;
property Pen: TPen read FPen write SetPen;
property Shape: TShapeType read FShape write SetShape default stRectangle;
property ShowHint;
property Visible;
property OnContextPopup;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDock;
property OnStartDrag;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('My Controls', [TWinShape]);
end;

{ TWinShape }

constructor TWinShape.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
//ControlStyle := ControlStyle + [csReplicatable]; //改这行↓
ControlStyle := ControlStyle + [csCaptureMouse, csReplicatable];
Width := 65;
Height := 65;
FPen := TPen.Create;
FPen.OnChange := StyleChanged;
FBrush := TBrush.Create;
FBrush.OnChange := StyleChanged;
end;

destructor TWinShape.Destroy;
begin
FPen.Free;
FBrush.Free;
inherited Destroy;
end;

procedure TWinShape.Paint;
var
X, Y, W, H, S: Integer;
begin
with Canvas do
begin
Pen := FPen;
Brush := FBrush;
X := Pen.Width div 2;
Y := X;
W := Width - Pen.Width + 1;
H := Height - Pen.Width + 1;
if Pen.Width = 0 then
begin
Dec(W);
Dec(H);
end;
if W < H then S := W else S := H;
if FShape in [stSquare, stRoundSquare, stCircle] then
begin
Inc(X, (W - S) div 2);
Inc(Y, (H - S) div 2);
W := S;
H := S;
end;
case FShape of
stRectangle, stSquare:
Rectangle(X, Y, X + W, Y + H);
stRoundRect, stRoundSquare:
RoundRect(X, Y, X + W, Y + H, S div 4, S div 4);
stCircle, stEllipse:
Ellipse(X, Y, X + W, Y + H);
end;
end;
end;

procedure TWinShape.StyleChanged(Sender: TObject);
begin
Invalidate;
end;

procedure TWinShape.SetBrush(Value: TBrush);
begin
FBrush.Assign(Value);
end;

procedure TWinShape.SetPen(Value: TPen);
begin
FPen.Assign(Value);
end;

procedure TWinShape.SetShape(Value: TShapeType);
begin
if FShape <> Value then
begin
FShape := Value;
Invalidate;
end;
end;

end.

WinShape.pas 加入
procedure CreateParams(var Params: TCreateParams); override;

procedure TWinShape.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);

Params.ExStyle := Params.ExStyle + WS_EX_TRANSPARENT; //透明
end;


//////////////////////////////////////////////////////////////////////
主窗体 当动态建立winshape控件，
当控件 width = width + 1 时 ，下面的控件还是闪烁
要贴代码吗？

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if isCanvas then begin
if (X<startPoint.X)and(Y<startPoint.Y) then begin // 第四象素
setWinShape1(X,Y,startPoint.X-X,startPoint.Y-Y); //过程 只是修改高度和宽度
end else if (X>startPoint.X)and(Y<startPoint.Y) then begin // 第一象素
setWinShape1(startPoint.X,Y,X-startPoint.X,startPoint.Y-Y);
end else if (X<startPoint.X)and(Y>startPoint.Y) then begin // 第三象素
setWinShape1(X,startPoint.Y,startPoint.X-X,Y-startPoint.Y);
end else begin // 第二象素
setWinShape1(startPoint.X,startPoint.Y,X-startPoint.X,Y-startPoint.Y);
end ;
end ;
end;


程序的意图是像DELPHI IDE一样 选择多个控件。。。。有没有其它解决方案，关键是不闪烁啊...

已设置 form1.DoubleBuffered := true ;

直接从TWincontrol继承一个，把tsharp的属性和方法复制过来，稍微改动下就可以了，我就是这么干的，效果不错