paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-13 10:19:16 +02:00
Code Issues Packages Projects Releases Wiki Activity

lcl: fix TRasterImage.Clear, TIcon.Clear

Browse Source 
git-svn-id: trunk@15509 -
This commit is contained in:
paul 2008-06-22 15:37:58 +00:00
parent 770a306580
commit 7b5d91c581
3 changed files with 23 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
lcl/graphics.pp
View File

@ -1390,6 +1390,7 @@ type
public
constructor Create; override;
destructor Destroy; override;
procedure Clear;
procedure Delete(Aindex: Integer);
function GetIndex(AFormat: TPixelFormat; AHeight, AWidth: Word): Integer;
end;

20
lcl/include/icon.inc
View File

@ -111,13 +111,18 @@ begin
end;
destructor TSharedIcon.Destroy;
begin
Clear;
FreeAndNil(FImages);
inherited Destroy;
end;
procedure TSharedIcon.Clear;
var
n: Integer;
begin
for n := 0 to FImages.Count - 1 do
TObject(FImages[n]).Free;
FreeAndNil(FImages);
inherited Destroy;
end;
function TSharedIcon.GetIndex(AFormat: TPixelFormat; AHeight, AWidth: Word): Integer;
@ -258,8 +263,15 @@ end;
procedure TCustomIcon.Clear;
begin
FreeSaveStream;
FCurrent := -1;
if not Empty then
begin
FreeSaveStream;
FSharedImage.Release;
FSharedImage := GetSharedImageClass.Create;
FSharedImage.Reference;
FCurrent := -1;
Changed(Self);
end;
end;
function TCustomIcon.BitmapHandleAllocated: boolean;

8
lcl/include/rasterimage.inc
View File

@ -98,8 +98,12 @@ end;
procedure TRasterImage.Clear;
begin
FreeSaveStream;
SetSize(0, 0);
if not Empty then
begin
FreeSaveStream;
SetSize(0, 0);
Changed(Self);
end;
end;
procedure TRasterImage.BitmapHandleNeeded;