TScrollBox: make opaque for ParentColor=False and ParentBackground=False. Issue #40047

This commit is contained in:
Ondrej Pokorny 2022-12-14 21:37:52 +01:00
parent ca9b4579d0
commit 7d00a524a4
5 changed files with 58 additions and 22 deletions

View File

@ -1431,6 +1431,7 @@ type
protected protected
procedure Changed; procedure Changed;
function GetPalette: HPalette; virtual; function GetPalette: HPalette; virtual;
function GetParentBackground: Boolean;
function ChildClassAllowed(ChildClass: TClass): Boolean; virtual; function ChildClassAllowed(ChildClass: TClass): Boolean; virtual;
procedure ReadState(Reader: TReader); override; // called procedure ReadState(Reader: TReader); override; // called
procedure Loaded; override; procedure Loaded; override;
@ -1453,6 +1454,7 @@ type
procedure SetHint(const Value: TTranslateString); virtual; procedure SetHint(const Value: TTranslateString); virtual;
procedure SetName(const Value: TComponentName); override; procedure SetName(const Value: TComponentName); override;
procedure SetParent(NewParent: TWinControl); virtual; procedure SetParent(NewParent: TWinControl); virtual;
procedure SetParentBackground(const AParentBackground: Boolean); virtual;
procedure SetParentComponent(NewParentComponent: TComponent); override; procedure SetParentComponent(NewParentComponent: TComponent); override;
procedure WndProc(var TheMessage: TLMessage); virtual; procedure WndProc(var TheMessage: TLMessage); virtual;
procedure ParentFormHandleInitialized; virtual; // called by ChildHandlesCreated of parent form procedure ParentFormHandleInitialized; virtual; // called by ChildHandlesCreated of parent form
@ -1504,6 +1506,7 @@ type
property DragKind: TDragKind read FDragKind write FDragKind default dkDrag; property DragKind: TDragKind read FDragKind write FDragKind default dkDrag;
property DragMode: TDragMode read FDragMode write SetDragMode default dmManual; property DragMode: TDragMode read FDragMode write SetDragMode default dmManual;
property MouseCapture: Boolean read GetMouseCapture write SetMouseCapture; property MouseCapture: Boolean read GetMouseCapture write SetMouseCapture;
property ParentBackground: Boolean read GetParentBackground write SetParentBackground;
property ParentColor: Boolean read FParentColor write SetParentColor default True; property ParentColor: Boolean read FParentColor write SetParentColor default True;
property ParentFont: Boolean read FParentFont write SetParentFont default True; property ParentFont: Boolean read FParentFont write SetParentFont default True;
property ParentShowHint: Boolean read FParentShowHint write SetParentShowHint default True; property ParentShowHint: Boolean read FParentShowHint write SetParentShowHint default True;
@ -2219,7 +2222,6 @@ type
function GetClientRect: TRect; override; function GetClientRect: TRect; override;
function GetControlOrigin: TPoint; override; function GetControlOrigin: TPoint; override;
function GetDeviceContext(var WindowHandle: HWND): HDC; override; function GetDeviceContext(var WindowHandle: HWND): HDC; override;
function GetParentBackground: Boolean;
function IsControlMouseMsg(var TheMessage): Boolean; function IsControlMouseMsg(var TheMessage): Boolean;
procedure CreateHandle; virtual; procedure CreateHandle; virtual;
procedure CreateParams(var Params: TCreateParams); virtual; procedure CreateParams(var Params: TCreateParams); virtual;
@ -2243,7 +2245,6 @@ type
procedure SetBorderStyle(NewStyle: TBorderStyle); virtual; procedure SetBorderStyle(NewStyle: TBorderStyle); virtual;
procedure SetColor(Value: TColor); override; procedure SetColor(Value: TColor); override;
procedure SetChildZPosition(const AChild: TControl; const APosition: Integer); procedure SetChildZPosition(const AChild: TControl; const APosition: Integer);
procedure SetParentBackground(const AParentBackground: Boolean); virtual;
procedure ShowControl(AControl: TControl); virtual; procedure ShowControl(AControl: TControl); virtual;
procedure UpdateControlState; procedure UpdateControlState;
procedure UpdateShowing; virtual; // checks control's handle visibility, called by DoAllAutoSize and UpdateControlState procedure UpdateShowing; virtual; // checks control's handle visibility, called by DoAllAutoSize and UpdateControlState
@ -2255,7 +2256,6 @@ type
property BorderStyle: TBorderStyle read GetBorderStyle write SetBorderStyle default bsNone; property BorderStyle: TBorderStyle read GetBorderStyle write SetBorderStyle default bsNone;
property OnGetSiteInfo: TGetSiteInfoEvent read FOnGetSiteInfo write FOnGetSiteInfo; property OnGetSiteInfo: TGetSiteInfoEvent read FOnGetSiteInfo write FOnGetSiteInfo;
property OnGetDockCaption: TGetDockCaptionEvent read FOnGetDockCaption write FOnGetDockCaption; property OnGetDockCaption: TGetDockCaptionEvent read FOnGetDockCaption write FOnGetDockCaption;
property ParentBackground: Boolean read GetParentBackground write SetParentBackground;
public public
// properties which are supported by all descendents // properties which are supported by all descendents
property BorderWidth: TBorderWidth read FBorderWidth write SetBorderWidth default 0; property BorderWidth: TBorderWidth read FBorderWidth write SetBorderWidth default 0;

View File

@ -205,6 +205,12 @@ type
TScrollBox = class(TScrollingWinControl) TScrollBox = class(TScrollingWinControl)
protected protected
class procedure WSRegisterClass; override; class procedure WSRegisterClass; override;
procedure SetParentBackground(const AParentBackground: Boolean); override;
procedure CMParentColorChanged(var Message: TLMessage); message CM_PARENTCOLORCHANGED;
procedure Loaded; override;
procedure UpdateParentColorChange;
public public
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
published published
@ -227,7 +233,7 @@ type
property Enabled; property Enabled;
property Color nodefault; property Color nodefault;
property Font; property Font;
property ParentBackground default False; property ParentBackground default True;
property ParentBiDiMode; property ParentBiDiMode;
property ParentColor; property ParentColor;
property ParentFont; property ParentFont;

View File

@ -1343,6 +1343,11 @@ begin
Result:=0; Result:=0;
end; end;
function TControl.GetParentBackground: Boolean;
begin
Result := csParentBackground in ControlStyle;
end;
function TControl.ChildClassAllowed(ChildClass: TClass): Boolean; function TControl.ChildClassAllowed(ChildClass: TClass): Boolean;
begin begin
Result:=false; Result:=false;
@ -1837,6 +1842,7 @@ begin
begin begin
FColor := Value; FColor := Value;
ParentColor := False; ParentColor := False;
ParentBackground := False;
Perform(CM_COLORCHANGED, 0, 0); Perform(CM_COLORCHANGED, 0, 0);
Invalidate; Invalidate;
end; end;
@ -4422,6 +4428,18 @@ begin
end; end;
end; end;
procedure TControl.SetParentBackground(const AParentBackground: Boolean);
begin
if ParentBackground = AParentBackground then
Exit;
if AParentBackground then
ControlStyle := ControlStyle + [csParentBackground]
else
ControlStyle := ControlStyle - [csParentBackground];
Invalidate;
end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
TControl SetParentComponent TControl SetParentComponent
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}

View File

@ -19,9 +19,38 @@ constructor TScrollBox.Create(AOwner: TComponent);
begin begin
Inherited Create(AOwner); Inherited Create(AOwner);
fCompStyle:= csScrollBox; fCompStyle:= csScrollBox;
ControlStyle := ControlStyle + [csCaptureMouse]; ControlStyle := ControlStyle + [csCaptureMouse]
- [csOpaque] + [csParentBackground]; // we need the default background
AutoScroll := True; AutoScroll := True;
BorderStyle := bsSingle; BorderStyle := bsSingle;
end; end;
procedure TScrollBox.CMParentColorChanged(var Message: TLMessage);
begin
UpdateParentColorChange;
inherited;
end;
procedure TScrollBox.Loaded;
begin
inherited Loaded;
UpdateParentColorChange;
end;
procedure TScrollBox.SetParentBackground(const AParentBackground: Boolean);
begin
if ParentBackground=AParentBackground then
Exit;
inherited;
UpdateParentColorChange;
end;
procedure TScrollBox.UpdateParentColorChange;
begin
if ParentColor or ParentBackground then
ControlStyle := ControlStyle - [csOpaque]
else
ControlStyle := ControlStyle + [csOpaque];
end;
// included by forms.pp // included by forms.pp

View File

@ -6529,18 +6529,6 @@ begin
InvalidatePreferredSize; InvalidatePreferredSize;
end; end;
procedure TWinControl.SetParentBackground(const AParentBackground: Boolean);
begin
if ParentBackground = AParentBackground then
Exit;
if AParentBackground then
ControlStyle := ControlStyle + [csParentBackground]
else
ControlStyle := ControlStyle - [csParentBackground];
Invalidate;
end;
procedure TWinControl.SetParentDoubleBuffered(Value: Boolean); procedure TWinControl.SetParentDoubleBuffered(Value: Boolean);
begin begin
if FParentDoubleBuffered <> Value then if FParentDoubleBuffered <> Value then
@ -7730,11 +7718,6 @@ begin
Result:=HandleAllocated and (GetCaptureControl=Self); Result:=HandleAllocated and (GetCaptureControl=Self);
end; end;
function TWinControl.GetParentBackground: Boolean;
begin
Result := csParentBackground in ControlStyle;
end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
function TWinControl.ParentHandlesAllocated: boolean; function TWinControl.ParentHandlesAllocated: boolean;