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

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. Struts2 学习笔记16 struts标签 part2

    接下来说一下if标签.下面是结果图. <li><s:if test="#parameters.age[0]<0">error!</s:if> ...

  2. sprintf,你知道多少?

    选自<CSDN 社区电子杂志——C/C++杂志>http://emag.csdn.net 2005 年1 月 总第1 期 - 93 -本文作者:steedhorse(晨星)printf 可 ...

  3. C# 多媒体播放器

    //停止播放 public void stopFile() { axWindowsMediaPlayer1.Ctlcontrols.stop(); } //暂停文件 public void pause ...

  4. 以前学习cisco ccna 课程的时候做的笔记

    由于学习的专业是计算机网络技术,可是在上学的时候,并没有学习到多少网络知识,所以为了对得起学的专业,在06年工作的时候,在哈工大银河教育报了个ccna的班,两个星期的课程,每天上那么几个小时. 结果依 ...

  5. sqlplus

    以超级管理员登录 sqlplus sys/123 as sysdba 解锁用户 alter user xutianhao account unlock

  6. 08-IOSCore - App Store、国际化/本地化

    App Store 1. 帐号身份 0. 有Xcode 写程序,在虚拟机上运行 1. 成为苹果使用者 appleid 验证邮箱 权限: 能下载应用程序 2. 成为苹果开发者 https://devel ...

  7. Qt实现不同Treewidget之间拖拽

    拖拽是编程中经常要用到的,我这里主要是实习了Treewidget之间直接拖拽Item,按下Ctrl键的话是copy,不按Ctrl则是Move.以下是实现代码 class TreeItemMimeDat ...

  8. ubuntu 12.04 安装sublime2

    add-apt-repository ppa:webupd8team/sublime-text-2 apt-get update apt-get install sublime-text 安装控制器: ...

  9. 娓娓道来c指针 (0)c语言的梦魇:c指针

    (0)c语言的梦魇:c指针 序 c语言中有一个重点:c指针.它也是一个难点.当然,这是一句废话:重点往往也是难点.在c标准中,对指针的定义是这种: 指针的类型是derived from其他类型,也就是 ...

  10. PS 滤镜算法原理 ——马赛克

    % method : 利用邻域的随意一点取代当前邻域全部像素点 %%%% mosaic clc; clear all; addpath('E:\PhotoShop Algortihm\Image Pr ...