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

LCL: New BevelColor property for TCustomPanel. Issue #31009, patch from AlexeyT.

Browse Source 
git-svn-id: trunk@53634 -
This commit is contained in:
juha 2016-12-11 15:18:24 +00:00
parent 3e93d719cd
commit 02052bcaa9
2 changed files with 28 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
lcl/extctrls.pp
View File

@ -1025,12 +1025,15 @@ type
TCustomPanel = class(TCustomControl) TCustomPanel = class(TCustomControl)
private private
FBevelColor : TColor;
FBevelInner, FBevelOuter : TPanelBevel; FBevelInner, FBevelOuter : TPanelBevel;
FBevelWidth : TBevelWidth; FBevelWidth : TBevelWidth;
FAlignment : TAlignment; FAlignment : TAlignment;
FFullRepaint: Boolean; FFullRepaint: Boolean;
FWordWrap: Boolean; FWordWrap: Boolean;
procedure PaintBevel(var ARect: TRect; ABevel: TPanelBevel);
procedure SetAlignment(const Value : TAlignment); procedure SetAlignment(const Value : TAlignment);
procedure SetBevelColor(AValue: TColor);
procedure SetBevelInner(const Value: TPanelBevel); procedure SetBevelInner(const Value: TPanelBevel);
procedure SetBevelOuter(const Value: TPanelBevel); procedure SetBevelOuter(const Value: TPanelBevel);
procedure SetBevelWidth(const Value: TBevelWidth); procedure SetBevelWidth(const Value: TBevelWidth);
@ -1050,6 +1053,7 @@ type
constructor Create(TheOwner: TComponent); override; constructor Create(TheOwner: TComponent); override;
property Align default alNone; property Align default alNone;
property Alignment: TAlignment read FAlignment write SetAlignment default taCenter; property Alignment: TAlignment read FAlignment write SetAlignment default taCenter;
property BevelColor: TColor read FBevelColor write SetBevelColor default clDefault;
property BevelInner: TPanelBevel read FBevelInner write SetBevelInner default bvNone; property BevelInner: TPanelBevel read FBevelInner write SetBevelInner default bvNone;
property BevelOuter: TPanelBevel read FBevelOuter write SetBevelOuter default bvRaised; property BevelOuter: TPanelBevel read FBevelOuter write SetBevelOuter default bvRaised;
property BevelWidth: TBevelWidth read FBevelWidth write SetBevelWidth default 1; property BevelWidth: TBevelWidth read FBevelWidth write SetBevelWidth default 1;
@ -1069,6 +1073,7 @@ type
property Anchors; property Anchors;
property AutoSize; property AutoSize;
property BorderSpacing; property BorderSpacing;
property BevelColor;
property BevelInner; property BevelInner;
property BevelOuter; property BevelOuter;
property BevelWidth; property BevelWidth;

32
lcl/include/custompanel.inc
View File

@ -29,6 +29,7 @@ begin
csClickEvents, csSetCaption, csDoubleClicks, csReplicatable, csClickEvents, csSetCaption, csDoubleClicks, csReplicatable,
csNoFocus, csAutoSize0x0] csNoFocus, csAutoSize0x0]
- [csOpaque]; // we need the default background - [csOpaque]; // we need the default background
FBevelColor := clDefault;
FBevelOuter := bvRaised; FBevelOuter := bvRaised;
FBevelInner := bvNone; FBevelInner := bvNone;
FBevelWidth := 1; FBevelWidth := 1;
@ -53,6 +54,15 @@ begin
end; end;
end; end;
procedure TCustomPanel.SetBevelColor(AValue: TColor);
begin
if FBevelColor <> AValue then
begin
FBevelColor := AValue;
Invalidate;
end;
end;
procedure TCustomPanel.SetBevelWidth(const Value: TBevelWidth); procedure TCustomPanel.SetBevelWidth(const Value: TBevelWidth);
begin begin
if FBevelWidth <> Value then if FBevelWidth <> Value then
@ -62,7 +72,7 @@ begin
end; end;
end; end;
procedure TCustomPanel.SetWordWrap(const Value: boolean); procedure TCustomPanel.SetWordwrap(const Value: Boolean);
begin begin
if FWordwrap <> Value then if FWordwrap <> Value then
begin begin
@ -95,6 +105,16 @@ begin
end; end;
end; end;
procedure TCustomPanel.PaintBevel(var ARect: TRect; ABevel: TPanelBevel);
begin
if ABevel <> bvNone then
if BevelColor = clDefault then
Canvas.Frame3d(ARect, BevelWidth, ABevel)
else
Canvas.Frame3d(ARect, BevelColor, BevelColor, BevelWidth);
// Note: Frame3D inflates ARect
end;
procedure TCustomPanel.Paint; procedure TCustomPanel.Paint;
var var
ARect: TRect; ARect: TRect;
@ -102,15 +122,9 @@ var
begin begin
ARect := GetClientRect; ARect := GetClientRect;
// if BevelOuter is set then draw a frame with BevelWidth PaintBevel(ARect, BevelOuter);
if (BevelOuter <> bvNone) then
Canvas.Frame3d(ARect, BevelWidth, BevelOuter); // Note: Frame3D inflates ARect
InflateRect(ARect, -BorderWidth, -BorderWidth); InflateRect(ARect, -BorderWidth, -BorderWidth);
PaintBevel(ARect, BevelInner);
// if BevelInner is set then skip the BorderWidth and draw a frame with BevelWidth
if (BevelInner <> bvNone) then
Canvas.Frame3d(ARect, BevelWidth, BevelInner); // Note: Frame3D inflates ARect
if Caption <> '' then if Caption <> '' then
begin begin