mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-06-16 21:28:23 +02:00
TScrollBox: make opaque for ParentColor=False and ParentBackground=False. Issue #40047
This commit is contained in:
parent
ca9b4579d0
commit
7d00a524a4
@ -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;
|
||||||
|
@ -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;
|
||||||
|
@ -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
|
||||||
------------------------------------------------------------------------------}
|
------------------------------------------------------------------------------}
|
||||||
|
@ -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
|
||||||
|
@ -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;
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user