paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-29 15:10:22 +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)
private
FBevelColor : TColor;
FBevelInner, FBevelOuter : TPanelBevel;
FBevelWidth : TBevelWidth;
FAlignment : TAlignment;
FFullRepaint: Boolean;
FWordWrap: Boolean;
procedure PaintBevel(var ARect: TRect; ABevel: TPanelBevel);
procedure SetAlignment(const Value : TAlignment);
procedure SetBevelColor(AValue: TColor);
procedure SetBevelInner(const Value: TPanelBevel);
procedure SetBevelOuter(const Value: TPanelBevel);
procedure SetBevelWidth(const Value: TBevelWidth);
@ -1050,6 +1053,7 @@ type
constructor Create(TheOwner: TComponent); override;
property Align default alNone;
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 BevelOuter: TPanelBevel read FBevelOuter write SetBevelOuter default bvRaised;
property BevelWidth: TBevelWidth read FBevelWidth write SetBevelWidth default 1;
@ -1069,6 +1073,7 @@ type
property Anchors;
property AutoSize;
property BorderSpacing;
property BevelColor;
property BevelInner;
property BevelOuter;
property BevelWidth;

32
lcl/include/custompanel.inc
View File

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