paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-16 04:39:22 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: TCustomImageList: added Equals and comparing data with Ancestor

Browse Source 
git-svn-id: trunk@22766 -
This commit is contained in:
mattias 2009-11-25 13:08:41 +00:00
parent 2f998fb898
commit ad6266815d
3 changed files with 44 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
lcl/imglist.pp
View File

@ -157,6 +157,7 @@ type
procedure Assign(Source: TPersistent); override; procedure Assign(Source: TPersistent); override;
procedure WriteData(AStream: TStream); virtual; procedure WriteData(AStream: TStream); virtual;
procedure ReadData(AStream: TStream); virtual; procedure ReadData(AStream: TStream); virtual;
function Equals(Obj: TObject): boolean; override;
procedure BeginUpdate; procedure BeginUpdate;
procedure EndUpdate; procedure EndUpdate;

33
lcl/include/imglist.inc
View File

@ -386,13 +386,9 @@ procedure TCustomImageList.DefineProperties(Filer: TFiler);
function DoWrite: Boolean; function DoWrite: Boolean;
begin begin
{ if Filer.Ancestor <> nil then if (Filer.Ancestor <> nil) and (Filer.Ancestor is TCustomImageList) then
begin Result := not Equals(Filer.Ancestor)
Result := (not (Filer.Ancestor is TCustomImageList) or
not Equal(TCustomImageList(Filer.Ancestor)));
end
else else
}
Result := Count > 0; Result := Count > 0;
end; end;
@ -1180,6 +1176,31 @@ begin
end; end;
end; end;
function TCustomImageList.Equals(Obj: TObject): boolean;
var
SrcList: TCustomImageList;
CurStream: TMemoryStream;
SrcStream: TMemoryStream;
begin
if Obj is TCustomImageList then begin
SrcList:=TCustomImageList(Obj);
Result:=false;
if SrcList.Count<>Count then exit;
if Count=0 then exit(true);
CurStream:=TMemoryStream.Create;
SrcStream:=TMemoryStream.Create;
try
WriteData(CurStream);
SrcList.WriteData(SrcStream);
Result:=CompareMemStreams(CurStream,SrcStream);
finally
SrcStream.Free;
CurStream.Free;
end;
end else
Result:=inherited Equals(Obj);
end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
Method: TCustomImageList.RegisterChanges Method: TCustomImageList.RegisterChanges
Params: Value: a reference to changelink object Params: Value: a reference to changelink object

28
lcl/lresources.pp
View File

@ -1060,23 +1060,27 @@ end;
function CompareMemStreams(Stream1, Stream2: TCustomMemoryStream function CompareMemStreams(Stream1, Stream2: TCustomMemoryStream
): boolean; ): boolean;
var var
Buffer1, Buffer2: array[1..1024] of byte; p1: Pointer;
BufLength: Integer; p2: Pointer;
Count: LongInt; Cnt: Int64;
CurCnt: cardinal;
begin begin
if Stream1=Stream2 then exit(true); if Stream1=Stream2 then exit(true);
Result:=false; Result:=false;
if (Stream1=nil) or (Stream2=nil) then exit; if (Stream1=nil) or (Stream2=nil) then exit;
if Stream1.Size<>Stream2.Size then exit; if Stream1.Size<>Stream2.Size then exit;
Stream1.Position:=0; Cnt:=Stream1.Size;
Stream2.Position:=0; p1:=Stream1.Memory;
BufLength:=High(Buffer1)-Low(Buffer1)+1; p2:=Stream2.Memory;
repeat while Cnt>0 do begin
Count:=Stream1.Read(Buffer1[1],BufLength); CurCnt:=Cnt;
if Count=0 then exit(true); if CurCnt>=High(Cardinal) then CurCnt:=High(Cardinal);
Stream2.Read(Buffer2[1],BufLength); if not CompareMem(p1,p2,CurCnt) then exit;
if not CompareMem(@Buffer1[1],@Buffer2[1],Count) then exit; inc(p1,CurCnt);
until false; inc(p2,CurCnt);
dec(Cnt,CurCnt);
end;
Result:=true;
end; end;
procedure BinaryToLazarusResourceCode(BinStream,ResStream:TStream; procedure BinaryToLazarusResourceCode(BinStream,ResStream:TStream;