paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-18 01:29:33 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: TSpeedButton: added PaintBackground

Browse Source 
git-svn-id: trunk@11852 -
This commit is contained in:
mattias 2007-08-23 20:31:46 +00:00
parent 4c1b802fe1
commit 99e2799127
2 changed files with 14 additions and 8 deletions

1
lcl/buttons.pp
View File

@ -240,6 +240,7 @@ type
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure Paint; override;
procedure PaintBackground(var PaintRect: TRect); virtual;
procedure SetDown(Value: Boolean);
procedure SetGroupIndex(const Value: Integer);
procedure SetFlat(const Value: Boolean);

21
lcl/include/speedbutton.inc
View File

@ -491,15 +491,9 @@ begin
if FGlyph=nil then exit;
PaintRect:=ClientRect;
FLastDrawDetails := GetDrawDetails;
if not Transparent and ThemeServices.HasTransparentParts(FLastDrawDetails) then
begin
Canvas.Brush.Color := Color;
Canvas.FillRect(PaintRect);
end;
ThemeServices.DrawElement(Canvas.Handle, FLastDrawDetails, PaintRect);
PaintRect := ThemeServices.ContentRect(Canvas.Handle, FLastDrawDetails, PaintRect);
PaintBackground(PaintRect);
GlyphSize := GetGlyphSize(PaintRect);
GlyphWidth := GlyphSize.CX;
@ -604,6 +598,17 @@ begin
inherited Paint;
end;
procedure TCustomSpeedButton.PaintBackground(var PaintRect: TRect);
begin
if not Transparent and ThemeServices.HasTransparentParts(FLastDrawDetails) then
begin
Canvas.Brush.Color := Color;
Canvas.FillRect(PaintRect);
end;
ThemeServices.DrawElement(Canvas.Handle, FLastDrawDetails, PaintRect);
PaintRect := ThemeServices.ContentRect(Canvas.Handle, FLastDrawDetails, PaintRect);
end;
{------------------------------------------------------------------------------
Method: TCustomSpeedButton.MouseDown
Params: Button: