TComponent,TControl,TWinControl,TGraphic的DefineProperties赏析与说明(不懂)
先观赏一下最后的实现效果:
object Form1: TForm1
Left =
Top =
Width =
Height =
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -
Font.Name = 'MS Shell Dlg 2'
Font.Style = []
OldCreateOrder = False
PixelsPerInch =
TextHeight =
object Image1: TImage
Left =
Top =
Width =
Height =
Picture.Data = {
0A544A504547496D616765784A0000FFD8FFE000104A46494600010100000100
010000FFFE003B43524541544F523A2067642D6A7065672076312E3020287573
696E6720494A47204A50454720763632292C207175616C697479203D2035350A
FFDB0043000E0A0B0D0B090E0D0C0D100F0E11162417161414162C20211A2434
2E3736332E32323A4153463A3D4E3E32324862494E56585D5E5D3845666D655A
6C535B5D59FFDB0043010F10101613162A17172A593B323B5959595959595959
A790060033A74F4EB4EFEDBD1F83FDA761C74FF484E3F5AF11A427934728F94F
6B5D5743495A55BFD35646FBCE26404FD4E69C359D195D9C6A5A7ABBE37113A6
4E3A679AF123C527B51617297B5B9125D775192370E8F73232B29C86058E0834
550A29947FFFD9}
end
object Panel1: TPanel
Left =
Top =
Width =
Height =
Caption = 'Panel1'
TabOrder =
end
object Button1: TButton
Left =
Top =
Width =
Height =
Caption = 'Button1'
TabOrder =
OnClick = Button1Click
end
object Button2: TButton
Left =
Top =
Width =
Height =
Caption = 'Button2'
TabOrder =
OnClick = Button2Click
end
object Timer1: TTimer
OnTimer = Timer1Timer
Left =
Top =
end
end
VCL的实现代码:
procedure TComponent.DefineProperties(Filer: TFiler);
var
Ancestor: TComponent;
Info: Longint;
begin
Info := ;
Ancestor := TComponent(Filer.Ancestor);
if Ancestor <> nil then Info := Ancestor.FDesignInfo;
Filer.DefineProperty('Left', ReadLeft, WriteLeft,
LongRec(FDesignInfo).Lo <> LongRec(Info).Lo);
Filer.DefineProperty('Top', ReadTop, WriteTop,
LongRec(FDesignInfo).Hi <> LongRec(Info).Hi);
end;
存储Left与Top的值。另外Height和Width是在哪里存储的?
procedure TControl.DefineProperties(Filer: TFiler); function DoWriteIsControl: Boolean;
begin
if Filer.Ancestor <> nil then
Result := TControl(Filer.Ancestor).IsControl <> IsControl else
Result := IsControl;
end;
begin
{ The call to inherited DefinedProperties is omitted since the Left and
Top special properties are redefined with real properties }
Filer.DefineProperty('IsControl', ReadIsControl, WriteIsControl, DoWriteIsControl);
end;
存储IsControl的值,但是我怎么没见到?
procedure TWinControl.DefineProperties(Filer: TFiler); function PointsEqual(const P1, P2: TPoint): Boolean;
begin
Result := ((P1.X = P2.X) and (P1.Y = P2.Y));
end; function DoWriteDesignSize: Boolean;
var
I: Integer;
begin
Result := True;
if (Filer.Ancestor = nil) or not PointsEqual(FDesignSize,
TWinControl(Filer.Ancestor).FDesignSize) then
begin
if FControls <> nil then
for I := 0 to FControls.Count - 1 do
with TControl(FControls[I]) do
if (Align = alNone) and (Anchors <> [akLeft, akTop]) then
Exit;
if FWinControls <> nil then
for I := 0 to FWinControls.Count - 1 do
with TControl(FWinControls[I]) do
if (Align = alNone) and (Anchors <> [akLeft, akTop]) then
Exit;
end;
Result := False;
end; begin
inherited;
Filer.DefineProperty('DesignSize', ReadDesignSize, WriteDesignSize,
DoWriteDesignSize);
end;
存储DesignSize的值
procedure TCustomForm.DefineProperties(Filer: TFiler);
begin
inherited DefineProperties(Filer);
Filer.DefineProperty('PixelsPerInch', nil, WritePixelsPerInch, not IsControl);
Filer.DefineProperty('TextHeight', ReadTextHeight, WriteTextHeight, not IsControl);
Filer.DefineProperty('IgnoreFontProperty', ReadIgnoreFontProperty, nil, False);
end;
写入三个值,但是我怎么没见到?
procedure TGraphic.DefineProperties(Filer: TFiler); function DoWrite: Boolean;
begin
if Filer.Ancestor <> nil then
Result := not (Filer.Ancestor is TGraphic) or
not Equals(TGraphic(Filer.Ancestor))
else
Result := not Empty;
end; begin
Filer.DefineBinaryProperty('Data', ReadData, WriteData, DoWrite);
end;
写入Data的二进制数据
// TPicture直接继承于TInterfacedPersistent,与TGraphic相互独立
procedure TPicture.DefineProperties(Filer: TFiler); function DoWrite: Boolean;
var
Ancestor: TPicture;
begin
if Filer.Ancestor <> nil then
begin
Result := True;
if Filer.Ancestor is TPicture then
begin
Ancestor := TPicture(Filer.Ancestor);
Result := not ((Graphic = Ancestor.Graphic) or
((Graphic <> nil) and (Ancestor.Graphic <> nil) and
Graphic.Equals(Ancestor.Graphic)));
end;
end
else Result := Graphic <> nil;
end; begin
Filer.DefineBinaryProperty('Data', ReadData, WriteData, DoWrite);
end;
写入Data的二进制数据
---------------------------------------------------------------------------
其中TControl的IsControl使用方法如下:
constructor TControl.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FWindowProc := WndProc;
FControlStyle := [csCaptureMouse, csClickEvents, csSetCaption, csDoubleClicks];
FFont := TFont.Create;
FFont.OnChange := FontChanged;
FAnchors := [akLeft, akTop];
FConstraints := TSizeConstraints.Create(Self);
FConstraints.OnChange := DoConstraintsChange;
FColor := clWindow;
FVisible := True;
FEnabled := True;
FParentFont := True;
FParentColor := True;
FParentShowHint := True;
FParentBiDiMode := True;
FIsControl := False;
FDragCursor := crDrag;
FFloatingDockSiteClass := TCustomDockForm;
FHelpType := htContext;
end; procedure TControl.ReadIsControl(Reader: TReader);
begin
FIsControl := Reader.ReadBoolean;
end; procedure TControl.WriteIsControl(Writer: TWriter);
begin
Writer.WriteBoolean(FIsControl);
end;
测试代码:
procedure TForm1.Button1Click(Sender: TObject);
begin
if Image1.IsControl then
ShowMessage('Image1 is control')
else
ShowMessage('Image1 is not control'); // 走这里 if Button2.IsControl then
ShowMessage('Button2 is control')
else
ShowMessage('Button2 is not control'); // 走这里
end;
继续:
TComponent,TControl,TWinControl,TGraphic的DefineProperties赏析与说明(不懂)的更多相关文章
- TApplication,TForm,TControl,TComponent,TWinControl研究(博客索引)good
TApplication,TForm,TControl,TComponent,TWinControl研究 http://blog.csdn.net/suiyunonghen/article/detai ...
- TObject、TPersisent 、TComponent、TControl、TGraphicControl、TWinControl 关系图
VCL的类图结构 TObject | TPersisent | ...
- TGraphicControl(自绘就2步,直接自绘自己,不需要调用VCL框架提供的函数重绘所有子控件,也不需要自己来提供PaintWindow函数让管理框架来调用)与TControl关键属性方法速记(Repaint要求父控件执行详细代码来重绘自己,还是直接要求Invalidate无效后Update刷新父控件,就看透明不透明这个属性,因为计算显示的区域有所不同)
TGraphicControl = class(TControl) private FCanvas: TCanvas; procedure WMPaint(var Message: TWMPaint) ...
- Delphi7.0常用函数-属性-事件
abort 函数 引起放弃的意外处理 addexitproc 函数 将一过程添加到运行时库的结束过程表中 addr 函数 返回指定对象的地址 adjustlinebreaks 函数 将给定字符串的行分 ...
- Delphi 7以来的Delphi 2009测试版新语法特性
我晕,Delphi 7 以后增加了这么多有用的语法,我都不知道.真是越学越觉得自己浅薄,自己所作的Delphi项目所用的知识还不够Delphi知识储备体系的十分之一,更别说Delphi还在继续发展. ...
- delphi override、overload、reintroduce的区别-0613.txt
http://blog.csdn.net/honglixx/article/details/3624934 1.override overload reintroduce的中文叫法是什么? overr ...
- Delphi OO
深入Delphi编程(OOP) 日期:2007年11月9日 作者:左轻侯 人气: 2595 查看:[大字体 中字体 小字体] 刚刚接触的Delphi的朋友,可能最感兴趣的就是它丰富.强大的VCL(可视 ...
- override overload reintroduce的区别(delphi)
1.override overload reintroduce的中文叫法是什么? override:覆盖:overload:重载:Reintroduce:重定义 2.在子类中override或ov ...
- Delphi 类(TObject、TPersistent、TComponent、TControl、TWinControl、TCustomControl、TGraphicControl、TInterfacedObject)简单介绍
TObject: VCL中所有类的根类,即是说:VCL中所有的类/组件/控件都是从TObject中继承而来.TObject类中定义了基本的 构造方法和析构方法. TPersistent: ...
随机推荐
- linux 远程桌面工具NX
1.在linux服务器上需要安装3个文件,下载地址为: http://www.nomachine.com/download-package.php?Prod_Id=1977 nxclient-3.4. ...
- 制作Linux(Fedora、Ubuntu、CentOS)优盘启动
随着嵌入式技术的快速发展,Linux快速发展过一段时间.虽然现在不是很热,但是linux在现实社会的使用还是很有用处.而光盘有有些落伍,不仅浪费而且不环保,所以质优价廉的优盘就脱颖而出.所以,用优盘制 ...
- northern truck 是什么牌子?具体_百度知道
northern truck 是什么牌子?具体_百度知道 northern truck 是什么牌子?具体
- Use Node.js DDP Client on Arduino Yun to Access Meteor Server
Use Node.js DDP Client on Arduino Yun to Access Meteor Server 概述 在Arduino Yun上安装 Node.js, 并測试与 Meteo ...
- linux stat系统调用,获取文件信息。
stat 函数原型: int stat(const char *path, struct stat *buf); struct stat 说明 struct stat { mode_t st_mode ...
- shell登录模式及其相应配置文件(转)
参考<linux命令.编辑器与shell编程>(清华大学出版社) 当启动shell时,它将运行启动文件来初始化自己.具体运行哪个文件取决于该shell是登陆shell还是非登陆shell的 ...
- [置顶] Hibernate从入门到精通(七)多对一单向关联映射
上次的博文Hibernate从入门到精通(六)一对一双向关联映射中我们介绍了一下一对一双向关联映射,本次博文我们讲解一下多对一关联映射 多对一单向关联映射 多对一关联映射与一对一关联映射类似,只是在多 ...
- 网盘大全, 邮箱大全 good
网盘推荐 115网盘 注册 百度网盘 注册 微云 注册 360云盘 注册 金山快盘 注册 新浪微盘 注册 和彩云 注册 酷盘 注册 OneDrive 外链 BOX 注册 Dropbox 注册 国内网盘 ...
- SQL模板和模板实例化
需求:需要得出一个数据源DataTable,我已知SQL和HttpRequest如何,通过SQL模板的方式去实例化匹配HttpRequest中的参数实例化为查询SQL,最后返回DataTable 1. ...
- Javascript 调试利器 Firebug使用详解
Javascript 调试利器 Firebug使用详解 有时候,为了更清楚方便的查看输出信息,我们可能需要将一些调试信息进行分组输出,那么可以使用console.group来对信息进行分组,在组信息输 ...