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

lcl: add TCustomBitBtn.LoadGlyphFromStock, simplify LoadGlyphFromLazarusResource

Browse Source 
git-svn-id: trunk@19789 -
This commit is contained in:
paul 2009-05-04 04:34:39 +00:00
parent 5e1d90086d
commit f602e242f8
2 changed files with 29 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
lcl/buttons.pp
View File

@ -164,6 +164,7 @@ type
destructor Destroy; override; destructor Destroy; override;
procedure Click; override; procedure Click; override;
procedure LoadGlyphFromLazarusResource(const AName: String); procedure LoadGlyphFromLazarusResource(const AName: String);
procedure LoadGlyphFromStock(idButton: Integer);
public public
property Glyph: TBitmap read GetGlyph write SetGlyph stored IsGlyphStored; property Glyph: TBitmap read GetGlyph write SetGlyph stored IsGlyphStored;
property NumGlyphs: Integer read GetNumGlyphs write SetNumGlyphs default 1; property NumGlyphs: Integer read GetNumGlyphs write SetNumGlyphs default 1;
@ -394,6 +395,7 @@ var
function GetLCLDefaultBtnGlyph(Kind: TBitBtnKind): TGraphic; function GetLCLDefaultBtnGlyph(Kind: TBitBtnKind): TGraphic;
procedure LoadGlyphFromLazarusResource(AGlyph: TButtonGlyph; const AName: String); procedure LoadGlyphFromLazarusResource(AGlyph: TButtonGlyph; const AName: String);
procedure LoadGlyphFromStock(AGlyph: TButtonGlyph; idButton: Integer);
// helper functions (search LCLType for idButton) // helper functions (search LCLType for idButton)
function GetButtonCaption(idButton: Integer): String; function GetButtonCaption(idButton: Integer): String;
@ -452,7 +454,6 @@ end;
procedure LoadGlyphFromLazarusResource(AGlyph: TButtonGlyph; const AName: String); procedure LoadGlyphFromLazarusResource(AGlyph: TButtonGlyph; const AName: String);
var var
C: TCustomBitmap; C: TCustomBitmap;
B: TBitmap;
begin begin
if AName = '' then if AName = '' then
C := nil C := nil
@ -463,23 +464,31 @@ begin
then begin then begin
AGlyph.Glyph := nil; AGlyph.Glyph := nil;
Exit; Exit;
end; end
B := nil; else
try begin
if AGlyph.Glyph <> nil try
then begin
AGlyph.Glyph.Assign(C); AGlyph.Glyph.Assign(C);
Exit; finally
C.Free;
end; end;
end;
end;
// unfortunately a Glyph doesn't support a custom bitmap yet. procedure LoadGlyphFromStock(AGlyph: TButtonGlyph; idButton: Integer);
// So we need a Bitmap helper var
B := TBitmap.Create; C: TCustomBitmap;
B.Assign(C); begin
AGlyph.Glyph := B; C := GetButtonIcon(idButton);
finally if C = nil then
B.Free; AGlyph.Glyph := nil
C.Free; else
begin
try
AGlyph.Glyph.Assign(C);
finally
C.Free;
end;
end; end;
end; end;

5
lcl/include/bitbtn.inc
View File

@ -61,6 +61,11 @@ begin
Buttons.LoadGlyphFromLazarusResource(FButtonGlyph, AName); Buttons.LoadGlyphFromLazarusResource(FButtonGlyph, AName);
end; end;
procedure TCustomBitBtn.LoadGlyphFromStock(idButton: Integer);
begin
Buttons.LoadGlyphFromStock(FButtonGlyph, idButton);
end;
function TCustomBitBtn.GetGlyph : TBitmap; function TCustomBitBtn.GetGlyph : TBitmap;
begin begin
Result := FButtonGlyph.Glyph; Result := FButtonGlyph.Glyph;