先观赏一下最后的实现效果:

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赏析与说明(不懂)的更多相关文章

  1. TApplication,TForm,TControl,TComponent,TWinControl研究(博客索引)good

    TApplication,TForm,TControl,TComponent,TWinControl研究 http://blog.csdn.net/suiyunonghen/article/detai ...

  2. TObject、TPersisent 、TComponent、TControl、TGraphicControl、TWinControl 关系图

    VCL的类图结构               TObject                 |               TPersisent                 |         ...

  3. TGraphicControl(自绘就2步,直接自绘自己,不需要调用VCL框架提供的函数重绘所有子控件,也不需要自己来提供PaintWindow函数让管理框架来调用)与TControl关键属性方法速记(Repaint要求父控件执行详细代码来重绘自己,还是直接要求Invalidate无效后Update刷新父控件,就看透明不透明这个属性,因为计算显示的区域有所不同)

    TGraphicControl = class(TControl) private FCanvas: TCanvas; procedure WMPaint(var Message: TWMPaint) ...

  4. Delphi7.0常用函数-属性-事件

    abort 函数 引起放弃的意外处理 addexitproc 函数 将一过程添加到运行时库的结束过程表中 addr 函数 返回指定对象的地址 adjustlinebreaks 函数 将给定字符串的行分 ...

  5. Delphi 7以来的Delphi 2009测试版新语法特性

    我晕,Delphi 7 以后增加了这么多有用的语法,我都不知道.真是越学越觉得自己浅薄,自己所作的Delphi项目所用的知识还不够Delphi知识储备体系的十分之一,更别说Delphi还在继续发展. ...

  6. delphi override、overload、reintroduce的区别-0613.txt

    http://blog.csdn.net/honglixx/article/details/3624934 1.override overload reintroduce的中文叫法是什么? overr ...

  7. Delphi OO

    深入Delphi编程(OOP) 日期:2007年11月9日 作者:左轻侯 人气: 2595 查看:[大字体 中字体 小字体] 刚刚接触的Delphi的朋友,可能最感兴趣的就是它丰富.强大的VCL(可视 ...

  8. override overload reintroduce的区别(delphi)

    1.override overload reintroduce的中文叫法是什么?   override:覆盖:overload:重载:Reintroduce:重定义 2.在子类中override或ov ...

  9. Delphi 类(TObject、TPersistent、TComponent、TControl、TWinControl、TCustomControl、TGraphicControl、TInterfacedObject)简单介绍

      TObject:    VCL中所有类的根类,即是说:VCL中所有的类/组件/控件都是从TObject中继承而来.TObject类中定义了基本的 构造方法和析构方法.   TPersistent: ...

随机推荐

  1. linux 远程桌面工具NX

    1.在linux服务器上需要安装3个文件,下载地址为: http://www.nomachine.com/download-package.php?Prod_Id=1977 nxclient-3.4. ...

  2. 制作Linux(Fedora、Ubuntu、CentOS)优盘启动

    随着嵌入式技术的快速发展,Linux快速发展过一段时间.虽然现在不是很热,但是linux在现实社会的使用还是很有用处.而光盘有有些落伍,不仅浪费而且不环保,所以质优价廉的优盘就脱颖而出.所以,用优盘制 ...

  3. northern truck 是什么牌子?具体_百度知道

    northern truck 是什么牌子?具体_百度知道 northern truck 是什么牌子?具体

  4. 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 ...

  5. linux stat系统调用,获取文件信息。

    stat 函数原型: int stat(const char *path, struct stat *buf); struct stat 说明 struct stat { mode_t st_mode ...

  6. shell登录模式及其相应配置文件(转)

    参考<linux命令.编辑器与shell编程>(清华大学出版社) 当启动shell时,它将运行启动文件来初始化自己.具体运行哪个文件取决于该shell是登陆shell还是非登陆shell的 ...

  7. [置顶] Hibernate从入门到精通(七)多对一单向关联映射

    上次的博文Hibernate从入门到精通(六)一对一双向关联映射中我们介绍了一下一对一双向关联映射,本次博文我们讲解一下多对一关联映射 多对一单向关联映射 多对一关联映射与一对一关联映射类似,只是在多 ...

  8. 网盘大全, 邮箱大全 good

    网盘推荐 115网盘 注册 百度网盘 注册 微云 注册 360云盘 注册 金山快盘 注册 新浪微盘 注册 和彩云 注册 酷盘 注册 OneDrive 外链 BOX 注册 Dropbox 注册 国内网盘 ...

  9. SQL模板和模板实例化

    需求:需要得出一个数据源DataTable,我已知SQL和HttpRequest如何,通过SQL模板的方式去实例化匹配HttpRequest中的参数实例化为查询SQL,最后返回DataTable 1. ...

  10. Javascript 调试利器 Firebug使用详解

    Javascript 调试利器 Firebug使用详解 有时候,为了更清楚方便的查看输出信息,我们可能需要将一些调试信息进行分组输出,那么可以使用console.group来对信息进行分组,在组信息输 ...