先观赏一下最后的实现效果:
object Form1: TForm1 Left = 192 Top = 107 Width = 870 Height = 500 Caption = 'Form1' Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'MS Shell Dlg 2' Font.Style = [] OldCreateOrder = False PixelsPerInch = 96 TextHeight = 13 object Image1: TImage Left = 112 Top = 160 Width = 105 Height = 105 Picture.Data = { 0A544A504547496D616765784A0000FFD8FFE000104A46494600010100000100 010000FFFE003B43524541544F523A2067642D6A7065672076312E3020287573 696E6720494A47204A50454720763632292C207175616C697479203D2035350A FFDB0043000E0A0B0D0B090E0D0C0D100F0E11162417161414162C20211A2434 2E3736332E32323A4153463A3D4E3E32324862494E56585D5E5D3845666D655A 6C535B5D59FFDB0043010F10101613162A17172A593B323B5959595959595959 A790060033A74F4EB4EFEDBD1F83FDA761C74FF484E3F5AF11A427934728F94F 6B5D5743495A55BFD35646FBCE26404FD4E69C359D195D9C6A5A7ABBE37113A6 4E3A679AF123C527B51617297B5B9125D775192370E8F73232B29C86058E0834 550A29947FFFD9} end object Panel1: TPanel Left = 480 Top = 40 Width = 185 Height = 41 Caption = 'Panel1' TabOrder = 0 end object Button1: TButton Left = 288 Top = 32 Width = 75 Height = 25 Caption = 'Button1' TabOrder = 1 OnClick = Button1Click end object Button2: TButton Left = 376 Top = 168 Width = 75 Height = 25 Caption = 'Button2' TabOrder = 2 OnClick = Button2Click end object Timer1: TTimer OnTimer = Timer1Timer Left = 136 Top = 48 end end
VCL的实现代码:
procedure TComponent.DefineProperties(Filer: TFiler); var Ancestor: TComponent; Info: Longint; begin Info := 0; 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;
继续: