盒子论坛 v2.1

开发了一个继承自TCustomControl的控件，有一个图形子控件(继承自TGraphicControl)始终无法显示，已设置了Parent，用Delphi自带图形控件(如TShape,TPaintBox等)仍然不显示，实在搞不明白，有谁能指教一二
----------------------------------------------
机器猫

作者：

machcat (机器猫)	★☆☆☆☆	-
	盒子活跃会员

2022/6/23 21:21:55

1楼：

为什么TPanel这些容器控件上面的图形子控件都可以正常显示
----------------------------------------------
机器猫

作者：

emailx45 (emailx45)	▲▲▲▲△	-
	普通会员

2022/6/24 1:06:04

2楼：

I'm not xpert in "build" new class / objects, but your can try "override" the "Paint" method in your class!

look my sample to create a new TGraphicControl object in my form:

I'M NOT CREATE A NEW CLASS.... JUST RE-DEFINING A "VIRTUAL"-original method in TGraphicControl... ok?
--------
implementation

{$R *.dfm}

type
  TGraphicControl = class(Vcl.Controls.TGraphicControl)
  protected
    procedure Paint; override;
  end;

procedure TForm1.Button1Click(Sender: TObject);
var
  MyGraphicControl: TGraphicControl;
begin
  MyGraphicControl          := TGraphicControl.Create(self);
  MyGraphicControl.Name     := 'MyGraphicControl001';
  MyGraphicControl.Left     := 20;
  MyGraphicControl.Top      := 20;
  MyGraphicControl.Height   := 100;
  MyGraphicControl.Width    := 100;
  MyGraphicControl.Visible  := true;
  MyGraphicControl.Hint     := 'hello world';
  MyGraphicControl.ShowHint := true;
  //
  MyGraphicControl.Parent := self;
  // MyGraphicControl.Show;
end;

{ TGraphicControl }

procedure TGraphicControl.Paint;
var
  MyRect: TRect;
begin
  inherited;
  //
  MyRect          := TRect.Create(self.Left, self.Top, self.Width, self.Height);
  self.Canvas.Brush.Color := clBlue;
  self.Canvas.FillRect(MyRect)
end;

end.

此帖子包含附件:

大小:16.8K

----------------------------------------------
The higher the degree, the greater the respect given to the humblest!RAD 11.3

作者：

emailx45 (emailx45)	▲▲▲▲△	-
	普通会员

2022/6/24 1:08:27

3楼：

in "Vcl.Controls.pas"

  TGraphicControl = class(TControl)
...
  protected
    procedure Paint; virtual;

procedure TGraphicControl.Paint;   /// <--- it is a "virtual" method
begin
end;
----------------------------------------------
The higher the degree, the greater the respect given to the humblest!RAD 11.3

作者：

iamdream (银河恒久远，梦想无止境！)	★☆☆☆☆	-
	大贡献会员

2022/6/24 20:22:58

4楼：

把你的代码贴出来别人一看就清楚了，敏感代码可以移除。简单来说，从TGraphicControl派生过来的组件本身没有句柄，它实际上是画在父组件上的。
----------------------------------------------
-广袤璀璨的银河,永无止境的梦想(梦无止境游银河) 博客挂了……

作者：

machcat (机器猫)	★☆☆☆☆	-
	盒子活跃会员

2022/6/24 20:36:39

4楼：

感谢回复！虽然我用的是Ｄ7，但我明白你的意思了，Paint方法已经定义并且override;但依然无法在界面出现．我的意思是这个图形子控件可以在Form上单独显示，但做为自开发的TCustomControl的控件的子控件时却无法显示，或者说是被父控件遮盖了，设置父控件SendtoBack或子控件BringToFront都无法显现．
----------------------------------------------
机器猫

作者：

machcat (机器猫)	★☆☆☆☆	-
	盒子活跃会员

2022/6/24 20:45:37

5楼：

to iamdream: 图形子控件代码很简单，用TImage或TPaintBox也可以,子控件设置了ControlStyle := ControlStyle + [csReplicatable];
父控件：ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents,csOpaque, csDoubleClicks, csReplicatable, csParentBackground];
确切的说子控件仍然被遮盖无法在父控件上显示
----------------------------------------------
机器猫

作者：

iamdream (银河恒久远，梦想无止境！)	★☆☆☆☆	-
	大贡献会员

2022/6/24 21:40:32

6楼：

我估计是被其他有句柄的组件挡住了。注意：从TGraphicControl派生过来的组件如果与其他有句柄的组件重叠，则会显示在后面。
看下面的简单例子：
----------------------------------------------
-广袤璀璨的银河,永无止境的梦想(梦无止境游银河) 博客挂了……

作者：

iamdream (银河恒久远，梦想无止境！)	★☆☆☆☆	-
	大贡献会员

2022/6/24 21:40:58

7楼：

unit Unit1;

interface

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

type
  TChild = class(TGraphicControl)
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
  end;

  TSample = class(TCustomControl)
  private
    FChild: TChild;
    FButton: TButton;
    procedure ButtonClick(Sender: TObject);
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
  end;

  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  with TSample.Create(Self) do begin
    Parent := Self;
    Left := 50;
    Top := 50;
  end;
end;

{ TChild }

constructor TChild.Create(AOwner: TComponent);
begin
  inherited;
  Width := 300;
  Height := 88;
end;

procedure TChild.Paint;
begin
  Canvas.Brush.Color := clNavy;
  Canvas.FillRect(Canvas.ClipRect);
  Canvas.Font.Color := clWhite;
  Canvas.TextOut(5, 35, 'Child Component');
end;

{ TSample }

procedure TSample.ButtonClick(Sender: TObject);
begin
  FChild.BringToFront; //Child 是从 TGraphicControl 派生而来，如有重叠，将显示在其他有句柄的组件后面
end;

constructor TSample.Create(AOwner: TComponent);
begin
  inherited;
  Width := 400;
  Height := 300;

  FButton := TButton.Create(Self);
  FButton.Parent := Self;
  FButton.Left   := 80;
  FButton.Top    := 40;
  FButton.Width  := 120;
  FButton.Caption := 'This is a Button';
  FButton.OnClick := ButtonClick;

  FChild := TChild.Create(Self);
  FChild.Parent := Self;
  FChild.Left := 50;
  FChild.Top  := 50;
end;

procedure TSample.Paint;
begin
  Canvas.Pen.Color  := clBlue;
  Canvas.Pen.Style  := psSolid;
  Canvas.Brush.Color := clSilver;
  Canvas.Rectangle(Canvas.ClipRect);

end;

end.
----------------------------------------------
-广袤璀璨的银河,永无止境的梦想(梦无止境游银河) 博客挂了……

作者：

iamdream (银河恒久远，梦想无止境！)	★☆☆☆☆	-
	大贡献会员

2022/6/24 21:43:07

8楼：

示例程序运行后的结果如下：

此帖子包含附件:

大小:9.8K

----------------------------------------------
-广袤璀璨的银河,永无止境的梦想(梦无止境游银河) 博客挂了……

作者：

machcat (机器猫)	★☆☆☆☆	-
	盒子活跃会员

2022/6/24 23:45:51

9楼：

谢谢指点！子控件被父控件遮挡无法显示在前面，用了BringToFront都没用．类似于：TShape放在TPanel上可以正常显示，但把TShape放在TStringGrid上就会被遮挡而不显示．子控件设置了ControlStyle := ControlStyle + [csReplicatable];
父控件：ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents,csOpaque, csDoubleClicks, csReplicatable, csParentBackground];依然如是
----------------------------------------------
机器猫

作者：

emailx45 (emailx45)	▲▲▲▲△	-
	普通会员

2022/6/25 4:31:20

10楼：

NO NEEDS "BringToFront" usage!

We need at least:
----------
1) inherit from TGraphControl = OK! No needs invent the whells!
2) declare the property or fields Ancestral if needs changes!
...2.1) ex.: Width, Height, mouse events or any others for you!
...2.2) you can create yourself properties and fields too!
3) IMPORTANT: re-implement the "Paint" method in your new component!
4) register and install on IDE for easy use!
----------------------------------------------
The higher the degree, the greater the respect given to the humblest!RAD 11.3

作者：

iamdream (银河恒久远，梦想无止境！)	★☆☆☆☆	-
	大贡献会员

2022/6/25 8:38:47

11楼：

唉，都告诉你了，从TGraphicControl派生而来的组件没有句柄，实际上是画在父组件上的，所以会排列在所有有句柄的组件（从TWinControl派生而来）后面。我上面的例子里用BringToFront只是演示这样做并不能将组件提到前面。TShape同样是没有句柄的，它也是从TGraphicControl派生而来的。你所谓的不显示，请确定正确设置了TShape.Parent，并且TShape.Left/Top/Width/Height设置了正确的值。

我们讨论问题的时候一般都是把代码贴出来，你这样空对空别人也帮不了你。

看下面的例子：

此帖子包含附件:

大小:8.9K

----------------------------------------------
-广袤璀璨的银河,永无止境的梦想(梦无止境游银河) 博客挂了……

作者：

iamdream (银河恒久远，梦想无止境！)	★☆☆☆☆	-
	大贡献会员

2022/6/25 8:39:13

12楼：

unit Unit1;

interface

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

type
  TChild = class(TGraphicControl)
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
  end;

  TForm1 = class(TForm)
    StringGrid1: TStringGrid;
    procedure FormCreate(Sender: TObject);
    procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
  private
    { Private declarations }
    FChild: TChild;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

{ TChild }

constructor TChild.Create(AOwner: TComponent);
begin
  inherited;
  Width := 200;
  Height := 40;
end;

procedure TChild.Paint;
var
  s: string;
  r: TRect;
begin
  r := Canvas.ClipRect;

  Canvas.Brush.Color := clNavy;
  Canvas.Pen.Color   := clFuchsia;
  Canvas.Pen.Style   := psSolid;
  Canvas.Pen.Width   := 2;
  Canvas.Rectangle(r);

  s := 'This is a child component';
  Canvas.Font.Color  := clWhite;
  DrawText(Canvas.Handle, PChar(s), Length(s), r, DT_SINGLELINE or DT_CENTER or DT_VCENTER);
end;

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
  FChild := TChild.Create(Self);
  FChild.Parent := StringGrid1;
  FChild.Left := 10;
  FChild.Top  := 5;
end;

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
begin
  if (ACol = 1) and (ARow = 1) then begin
    FChild.Left := Rect.Left;
    FChild.Top  := Rect.Top;
    FChild.Width := Rect.Right - Rect.Left;
    FChild.Height := Rect.Bottom - Rect.Top;
  end;
end;

end.
----------------------------------------------
-广袤璀璨的银河,永无止境的梦想(梦无止境游银河) 博客挂了……

作者：

machcat (机器猫)	★☆☆☆☆	-
	盒子活跃会员

2022/6/27 20:18:30

13楼：

感谢楼上各位大侠的热情指点与回复，特别感谢iamdream老师，问题症结已找到．我在父控件的MouseMove方法里有刷新界面的代码，造成图形子控件被父控件反复遮盖，不断闪烁而变得忽隐忽现．用TPanel控件做了个测试，上面放置几个TShape/TBevel/TEdit/TListBox等控件，在MouseMove方法写入刷新TPanel界面的代码，TShape/TBevel等无句柄控件会不断闪烁，而TEdit\TListBox等控件就没有影响．我把子控件改成继承自TCustomControl，就没有上述问题了.
----------------------------------------------
机器猫

信息

登陆以后才能回复