控件的层次问题(100分)

  • 主题发起人 主题发起人 小妖刀
  • 开始时间 开始时间

小妖刀

Unregistered / Unconfirmed
GUEST, unregistred user!
怎样把一个没有taboder的控件放到有taboder的控件上面.
比如:(delphi中)
Tshape放到TPanel上面,注意:shape和panel都在form上
 
在设计阶段,把TShape剪切。
然后点击TPanel,粘贴就可以了。

在运行阶段,设置TShape的Parent属性为TPanel就可以了。
 
谢谢,我说的是shape和panel的parent 都是Form1.
 
不懂你的意思,能说得详细一点吗?
 
那是不可能的事情!因为TShape属于图形控件(TGraphControl)本身并没有句柄。
而TPanel属于窗口控件(TWinControl)。图形控件是永远不能置于窗口控件之下。
要解决这一问题,必须找到从TWinControl继续下来的Shape控件才可以。
要不,自己写一个也可以。
 
问题换成这样子呢:
我从TCustomControl继承一个控件,然后要在运行时让我的组件位于同一个
parent 的所有控件得最上面.怎么办,有人能给个小例子吗???
 
如果你的控件确实是继续于TCustomControl的话,可以这样写:
Obj.BringToFront;
 
To 小妖刀:
TShape 同从 TCustomControls 继承的控件并不是一回事,前者不行,后者可以。
BringToFront 方法可以把一个 Window Control 放到最上面。而 TShape 并不是 Window
Control 。
你到底说的是 TShape 还是 TCustomControl ?
 
刚刚写个继续于TCustomControl的Shape控件,
希望你会满意。

unit JShape;

interface

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

type
TJShape = class(TCustomControl)
private
{ Private declarations }
FPen: TPen;
FBrush: TBrush;
FShape: TShapeType;
procedure SetBrush(Value: TBrush);
procedure SetPen(Value: TPen);
procedure SetShape(Value: TShapeType);
protected
{ Protected declarations }
procedure Paint; override;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
{ Published declarations }
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('Samples', [TJShape]);
end;

constructor TJShape.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csReplicatable];
Width := 65;
Height := 65;
FPen := TPen.Create;
FPen.OnChange := StyleChanged;
FBrush := TBrush.Create;
FBrush.OnChange := StyleChanged;
end;

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

procedure TJShape.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 TJShape.StyleChanged(Sender: TObject);
begin
Invalidate;
end;

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

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

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

end.
 
啊,打错字!真不好意思,应该是“继承于”。呵呵。
 
谢谢两位的回复,正如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.
 
太麻烦啦,TCustomControl已经为你写好了一切。
你直接重载Paint方法就行了。根本不用自己去写窗口过程。
 
TO: :JohnsonGuo
谢谢你的TJshape.我再试一下直接重载paint方法
 
后退
顶部