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

LCL: Make TCoolBar themed background optional. Issue #30464, patch from regs.

Browse Source 
git-svn-id: trunk@52963 -
This commit is contained in:
juha 2016-09-13 19:44:43 +00:00
parent 3463c904e7
commit 7ae08629ca
2 changed files with 17 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
lcl/comctrls.pp
View File

@ -2445,6 +2445,7 @@ type
FImageChangeLink: TChangeLink; FImageChangeLink: TChangeLink;
FOnChange: TNotifyEvent; FOnChange: TNotifyEvent;
FShowText: Boolean; FShowText: Boolean;
FThemed: Boolean;
FVertical: Boolean; FVertical: Boolean;
FVerticalSpacing: Integer; FVerticalSpacing: Integer;
function GetAlign: TAlign; function GetAlign: TAlign;
@ -2457,6 +2458,7 @@ type
procedure SetHorizontalSpacing(AValue: Integer); procedure SetHorizontalSpacing(AValue: Integer);
procedure SetImages(AValue: TCustomImageList); procedure SetImages(AValue: TCustomImageList);
procedure SetShowText(AValue: Boolean); procedure SetShowText(AValue: Boolean);
procedure SetThemed(AValue: Boolean);
procedure SetVertical(AValue: Boolean); procedure SetVertical(AValue: Boolean);
procedure SetVerticalSpacing(AValue: Integer); procedure SetVerticalSpacing(AValue: Integer);
protected const protected const
@ -2523,6 +2525,7 @@ type
property HorizontalSpacing: Integer read FHorizontalSpacing write SetHorizontalSpacing default cDefHorSpacing; property HorizontalSpacing: Integer read FHorizontalSpacing write SetHorizontalSpacing default cDefHorSpacing;
property Images: TCustomImageList read FImages write SetImages; property Images: TCustomImageList read FImages write SetImages;
property ShowText: Boolean read FShowText write SetShowText default True; property ShowText: Boolean read FShowText write SetShowText default True;
property Themed: Boolean read FThemed write SetThemed default True;
property Vertical: Boolean read FVertical write SetVertical default False; property Vertical: Boolean read FVertical write SetVertical default False;
property VerticalSpacing: Integer read FVerticalSpacing write SetVerticalSpacing default cDefVertSpacing; property VerticalSpacing: Integer read FVerticalSpacing write SetVerticalSpacing default cDefVertSpacing;
property OnChange: TNotifyEvent read FOnChange write FOnChange; property OnChange: TNotifyEvent read FOnChange write FOnChange;
@ -2564,6 +2567,7 @@ type
property PopupMenu; property PopupMenu;
property ShowHint; property ShowHint;
property ShowText; property ShowText;
property Themed;
property Vertical; property Vertical;
property VerticalSpacing; property VerticalSpacing;
property Visible; property Visible;

11
lcl/include/coolbar.inc
View File

@ -361,6 +361,7 @@ begin
FImageChangeLink := TChangeLink.Create; FImageChangeLink := TChangeLink.Create;
FImageChangeLink.OnChange := @BitmapOrImageListChange; FImageChangeLink.OnChange := @BitmapOrImageListChange;
FShowText := True; FShowText := True;
FThemed := True;
FVerticalSpacing := cDefVertSpacing; FVerticalSpacing := cDefVertSpacing;
end; end;
@ -461,6 +462,14 @@ begin
Invalidate; Invalidate;
end; end;
procedure TCustomCoolBar.SetThemed(AValue: Boolean);
begin
if FThemed = AValue then Exit;
FThemed := AValue;
Invalidate;
end;
procedure TCustomCoolBar.SetVertical(AValue: Boolean); procedure TCustomCoolBar.SetVertical(AValue: Boolean);
var aRect: TRect; var aRect: TRect;
begin begin
@ -1167,9 +1176,11 @@ begin
if FBitmap.Width > 0 then if FBitmap.Width > 0 then
DrawTiledBitmap(ClientRect, FBitmap) DrawTiledBitmap(ClientRect, FBitmap)
else begin else begin
if FThemed then begin
aBackground:=ThemeServices.GetElementDetails(trRebarRoot); aBackground:=ThemeServices.GetElementDetails(trRebarRoot);
ThemeServices.DrawElement(Canvas.Handle,aBackground,ClientRect); ThemeServices.DrawElement(Canvas.Handle,aBackground,ClientRect);
end; end;
end;
aCountM1 := length(FVisiBands)-1; aCountM1 := length(FVisiBands)-1;
if aCountM1 >= 0 then begin if aCountM1 >= 0 then begin
aRaisedBevel := (FBandBorderStyle = bsSingle) and aRaisedBevel := (FBandBorderStyle = bsSingle) and