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

LCL: TFrame, TGroupBox: Set ParentBackGround to False if color is changed and visa versa as requested in German LazarusForum from wp. Related to 64871, 64872

Browse Source 
git-svn-id: trunk@64882 -
This commit is contained in:
michl 2021-03-28 19:32:11 +00:00
parent 8a0e6f91ee
commit cafbad9bab
4 changed files with 29 additions and 0 deletions

1
lcl/forms.pp
View File

@ -301,6 +301,7 @@ type
class procedure WSRegisterClass; override;
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
procedure SetColor(Value: TColor); override;
procedure SetParent(AParent: TWinControl); override;
procedure SetParentBackground(const AParentBackground: Boolean); override;
procedure CMParentColorChanged(var Message: TLMessage); message CM_PARENTCOLORCHANGED;

14
lcl/include/customframe.inc
View File

@ -95,6 +95,13 @@ begin
end;
end;
procedure TCustomFrame.SetColor(Value: TColor);
begin
inherited SetColor(Value);
if Color <> clDefault then
ParentBackground := False;
end;
procedure TCustomFrame.SetParent(AParent: TWinControl);
procedure UpdateActionLists(Root: TComponent; Operation: TOperation);
@ -140,6 +147,13 @@ end;
procedure TCustomFrame.SetParentBackground(const AParentBackground: Boolean);
begin
inherited SetParentBackground(AParentBackground);
if AParentBackground then
if (ParentColor) and Assigned(Parent) then
Color := Parent.Color
else
Color := clDefault;
UpdateOpaque;
end;

13
lcl/include/customgroupbox.inc
View File

@ -24,6 +24,12 @@ procedure TCustomGroupBox.SetParentBackground(const AParentBackground: Boolean);
begin
inherited SetParentBackground(AParentBackground);
if AParentBackground then
if (ParentColor) and Assigned(Parent) then
Color := Parent.Color
else
Color := clDefault;
UpdateOpaque;
end;
@ -41,6 +47,13 @@ begin
Params.Style := Params.Style or BS_GROUPBOX;
end;
procedure TCustomGroupBox.SetColor(Value: TColor);
begin
inherited SetColor(Value);
if Color <> clDefault then
ParentBackground := False;
end;
{------------------------------------------------------------------------------
function TCustomGroupBox.Create
------------------------------------------------------------------------------}

1
lcl/stdctrls.pp
View File

@ -169,6 +169,7 @@ type
procedure UpdateOpaque;
procedure CreateParams(var Params: TCreateParams); override;
procedure SetColor(Value: TColor); override;
procedure SetParentBackground(const AParentBackground: Boolean); override;
procedure CMParentColorChanged(var Message: TLMessage); message CM_PARENTCOLORCHANGED;
public