paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-12-06 05:37:38 +01:00
Code Issues Packages Projects Releases Wiki Activity

lcl: increase visibility of some icon internals to allow override it and reuse some parts in the another unit

Browse Source 
git-svn-id: trunk@15580 -
This commit is contained in:
paul 2008-06-27 02:30:39 +00:00
parent f32d59efb7
commit 774ad4aa28
2 changed files with 17 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
lcl/graphics.pp
View File

@ -1114,7 +1114,6 @@ type
TRasterImage = class(TGraphic)
private
FCanvas: TCanvas;
FSharedImage: TSharedRasterImage;
FTransparentColor: TColor;
FTransparentMode: TTransparentMode;
FInternalState: TBitmapInternalState;
@ -1124,6 +1123,7 @@ type
function GetCanvas: TCanvas;
procedure SetTransparentColor(AValue: TColor);
protected
FSharedImage: TSharedRasterImage;
function CanShareImage(AClass: TSharedRasterImageClass): Boolean; virtual;
procedure Changed(Sender: TObject); override;
procedure Changing(Sender: TObject); virtual;
@ -1386,13 +1386,15 @@ type
FImages: TFPList;
protected
procedure FreeHandle; override;
class function GetImagesClass: TIconImageClass; virtual;
public
constructor Create; override;
destructor Destroy; override;
procedure Clear;
procedure Delete(Aindex: Integer);
function GetIndex(AFormat: TPixelFormat; AHeight, AWidth: Word): Integer;
class function GetImagesClass: TIconImageClass; virtual;
procedure Add(AIconImage: TIconImage);
function Count: Integer;
end;
{ TIconImage }
@ -1442,10 +1444,10 @@ type
TCustomIcon = class(TRasterImage)
private
FCurrent: Integer;
function GetCount: Integer;
procedure SetCurrent(const AValue: Integer);
protected
FCurrent: Integer;
procedure MaskHandleNeeded; override;
procedure PaletteNeeded; override;
function GetIndex(AFormat: TPixelFormat; AHeight, AWidth: Word): Integer;
@ -1504,6 +1506,7 @@ type
TSharedCursorImage = class(TSharedIcon)
protected
procedure FreeHandle; override;
public
class function GetImagesClass: TIconImageClass; override;
end;

12
lcl/include/icon.inc
View File

@ -95,6 +95,11 @@ begin
Result := TIconImage;
end;
procedure TSharedIcon.Add(AIconImage: TIconImage);
begin
FImages.Add(AIconImage);
end;
constructor TSharedIcon.Create;
begin
inherited Create;
@ -142,6 +147,11 @@ begin
Result := -1;
end;
function TSharedIcon.Count: Integer;
begin
Result := FImages.Count;
end;
////////////////////////////////////////////////////////////////////////////////
{ TIconImage }
@ -302,7 +312,7 @@ end;
function TCustomIcon.GetCount: Integer;
begin
Result := TSharedIcon(FSharedImage).FImages.Count;
Result := TSharedIcon(FSharedImage).Count;
end;
procedure TCustomIcon.GetDescription(Aindex: Integer; out AFormat: TPixelFormat; out AHeight, AWidth: Word);