先观赏一下最后的实现效果：
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;
继续：