DELPHI盒子
!实时搜索: 盒子论坛 | 注册用户 | 修改信息 | 退出
检举帖 | 全文检索 | 关闭广告 | 捐赠
技术论坛
 用户名
 密  码
自动登陆(30天有效)
忘了密码
≡技术区≡
DELPHI技术
lazarus/fpc/Free Pascal
移动应用开发
Web应用开发
数据库专区
报表专区
网络通讯
开源项目
论坛精华贴
≡发布区≡
发布代码
发布控件
文档资料
经典工具
≡事务区≡
网站意见
盒子之家
招聘应聘
信息交换
论坛信息
最新加入: hebhanax
今日帖子: 48
在线用户: 16
导航: 论坛 -> DELPHI技术 斑竹:liumazi,sephil  
作者:
男 machcat (机器猫) ★☆☆☆☆ -
盒子活跃会员
2022/6/23 21:15:43
标题:
图形子控件(继承自TGraphicControl)为何无法显示 浏览:1588
加入我的收藏
楼主: 开发了一个继承自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.
此帖子包含附件:
PNG 图像
大小: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楼: 感谢回复!虽然我用的是D7,但我明白你的意思了,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楼: 示例程序运行后的结果如下:
此帖子包含附件:
PNG 图像
大小: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设置了正确的值。

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

看下面的例子:
此帖子包含附件:
PNG 图像
大小: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,就没有上述问题了.
----------------------------------------------
机器猫
信息
登陆以后才能回复
Copyright © 2CCC.Com 盒子论坛 v3.0.1 版权所有 页面执行136.7188毫秒 RSS