paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-18 03:59:13 +02:00
Code Issues Packages Projects Releases Wiki Activity

lcl: extent GetDefaultColor function to get default Brush and Font colors

Browse Source 
git-svn-id: trunk@28306 -
This commit is contained in:
paul 2010-11-18 02:19:50 +00:00
parent d94f345335
commit 2fd8aba64b
14 changed files with 59 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
lcl/controls.pp
View File

@ -846,6 +846,11 @@ type
chtOnKeyDown chtOnKeyDown
); );
TDefaultColorType = (
dctBrush,
dctFont
);
{* Note on TControl.Caption {* Note on TControl.Caption
* The VCL implementation relies on the virtual Get/SetTextBuf to * The VCL implementation relies on the virtual Get/SetTextBuf to
* exchange text between widgets and VCL. This means a lot of * exchange text between widgets and VCL. This means a lot of
@ -1288,7 +1293,7 @@ type
WithThemeSpace: boolean = true); virtual; WithThemeSpace: boolean = true); virtual;
function GetDefaultWidth: integer; function GetDefaultWidth: integer;
function GetDefaultHeight: integer; function GetDefaultHeight: integer;
function GetDefaultColor: TColor; virtual; function GetDefaultColor(const DefaultColorType: TDefaultColorType): TColor; virtual;
function GetSidePosition(Side: TAnchorKind): integer; function GetSidePosition(Side: TAnchorKind): integer;
procedure CNPreferredSizeChanged; procedure CNPreferredSizeChanged;
procedure InvalidatePreferredSize; virtual; procedure InvalidatePreferredSize; virtual;

13
lcl/include/control.inc
View File

@ -932,14 +932,19 @@ begin
Result := not ParentColor; Result := not ParentColor;
end; end;
function TControl.GetDefaultColor: TColor; function TControl.GetDefaultColor(const DefaultColorType: TDefaultColorType): TColor;
const
DefColors: array[TDefaultColorType] of TColor = (
{ dctBrush } clWindow,
{ dctFont } clWindowText
);
begin begin
Result := TWSControlClass(WidgetSetClass).GetDefaultColor(Self); Result := TWSControlClass(WidgetSetClass).GetDefaultColor(Self, DefaultColorType);
if (Result = clDefault) then if (Result = clDefault) then
if ParentColor and Assigned(Parent) then if ParentColor and Assigned(Parent) then
Result := Parent.GetDefaultColor Result := Parent.GetDefaultColor(DefaultColorType)
else else
Result := clWindow; Result := DefColors[DefaultColorType];
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------

2
lcl/include/controlcanvas.inc
View File

@ -45,7 +45,7 @@ end;
function TControlCanvas.GetDefaultColor: TColor; function TControlCanvas.GetDefaultColor: TColor;
begin begin
if Assigned(FControl) then if Assigned(FControl) then
Result := FControl.GetDefaultColor Result := FControl.GetDefaultColor(dctBrush)
else else
Result := inherited GetDefaultColor; Result := inherited GetDefaultColor;
end; end;

6
lcl/include/wincontrol.inc
View File

@ -4623,11 +4623,11 @@ end;
procedure TWinControl.SetColor(Value: TColor); procedure TWinControl.SetColor(Value: TColor);
begin begin
if Value=Color then exit; if Value = Color then Exit;
inherited SetColor(Value); inherited SetColor(Value);
if BrushCreated then if BrushCreated then
if Color = clDefault then if Color = clDefault then
FBrush.Color := GetDefaultColor FBrush.Color := GetDefaultColor(dctBrush)
else else
FBrush.Color := Color; FBrush.Color := Color;
if HandleAllocated and ([csLoading,csDestroying]*ComponentState=[]) then if HandleAllocated and ([csLoading,csDestroying]*ComponentState=[]) then
@ -4828,7 +4828,7 @@ begin
if BrushCreated then exit; if BrushCreated then exit;
FBrush := TBrush.Create; FBrush := TBrush.Create;
if Color = clDefault then if Color = clDefault then
FBrush.Color := GetDefaultColor FBrush.Color := GetDefaultColor(dctBrush)
else else
FBrush.Color := Color; FBrush.Color := Color;
end; end;

2
lcl/interfaces/win32/win32callback.inc
View File

@ -1367,7 +1367,7 @@ begin
Windows.SetTextColor(WindowDC, Windows.COLORREF(ColorToRGB(ChildWinControl.Font.Color))); Windows.SetTextColor(WindowDC, Windows.COLORREF(ColorToRGB(ChildWinControl.Font.Color)));
WindowColor := ChildWinControl.Brush.Color; WindowColor := ChildWinControl.Brush.Color;
if WindowColor = clDefault then if WindowColor = clDefault then
WindowColor := ChildWinControl.GetDefaultColor; WindowColor := ChildWinControl.GetDefaultColor(dctBrush);
Windows.SetBkColor(WindowDC, Windows.COLORREF(ColorToRGB(WindowColor))); Windows.SetBkColor(WindowDC, Windows.COLORREF(ColorToRGB(WindowColor)));
LMessage.Result := LResult(ChildWinControl.Brush.Reference.Handle); LMessage.Result := LResult(ChildWinControl.Brush.Reference.Handle);
//DebugLn(['WindowProc ', ChildWinControl.Name, ' Brush: ', LMessage.Result]); //DebugLn(['WindowProc ', ChildWinControl.Name, ' Brush: ', LMessage.Result]);

2
lcl/interfaces/win32/win32wscomctrls.pp
View File

@ -456,7 +456,7 @@ begin
if not WSCheckHandleAllocated(AWinControl, 'TWin32WSStatusBar.SetColor') then if not WSCheckHandleAllocated(AWinControl, 'TWin32WSStatusBar.SetColor') then
Exit; Exit;
if AWinControl.Color = clDefault then if AWinControl.Color = clDefault then
Windows.SendMessage(AWinControl.Handle, SB_SETBKCOLOR, 0, ColorToRGB(AWinControl.GetDefaultColor)) Windows.SendMessage(AWinControl.Handle, SB_SETBKCOLOR, 0, ColorToRGB(AWinControl.GetDefaultColor(dctBrush)))
else else
Windows.SendMessage(AWinControl.Handle, SB_SETBKCOLOR, 0, ColorToRGB(AWinControl.Color)); Windows.SendMessage(AWinControl.Handle, SB_SETBKCOLOR, 0, ColorToRGB(AWinControl.Color));
end; end;

2
lcl/interfaces/win32/win32wscustomlistview.inc
View File

@ -991,7 +991,7 @@ begin
Exit; Exit;
Color := AWinControl.Color; Color := AWinControl.Color;
if Color = clDefault then if Color = clDefault then
Color := AWinControl.GetDefaultColor; Color := AWinControl.GetDefaultColor(dctBrush);
Windows.SendMessage(AWinControl.Handle, LVM_SETBKCOLOR, 0, ColorToRGB(Color)); Windows.SendMessage(AWinControl.Handle, LVM_SETBKCOLOR, 0, ColorToRGB(Color));
Windows.SendMessage(AWinControl.Handle, LVM_SETTEXTBKCOLOR, 0, ColorToRGB(Color)); Windows.SendMessage(AWinControl.Handle, LVM_SETTEXTBKCOLOR, 0, ColorToRGB(Color));
end; end;

2
lcl/interfaces/wince/wincecallback.inc
View File

@ -1302,7 +1302,7 @@ begin
Windows.SetTextColor(HDC(WParam), Windows.COLORREF(ColorToRGB(ChildWinControl.Font.Color))); Windows.SetTextColor(HDC(WParam), Windows.COLORREF(ColorToRGB(ChildWinControl.Font.Color)));
WindowColor := ChildWinControl.Brush.Color; WindowColor := ChildWinControl.Brush.Color;
if WindowColor = clDefault then if WindowColor = clDefault then
WindowColor := ChildWinControl.GetDefaultColor; WindowColor := ChildWinControl.GetDefaultColor(dctBrush);
Windows.SetBkColor(HDC(WParam), Windows.COLORREF(ColorToRGB(WindowColor))); Windows.SetBkColor(HDC(WParam), Windows.COLORREF(ColorToRGB(WindowColor)));
LMessage.Result := LResult(ChildWinControl.Brush.Reference.Handle); LMessage.Result := LResult(ChildWinControl.Brush.Reference.Handle);
//DebugLn(['WindowProc ', ChildWinControl.Name, ' Brush: ', LMessage.Result]); //DebugLn(['WindowProc ', ChildWinControl.Name, ' Brush: ', LMessage.Result]);

2
lcl/interfaces/wince/wincewscustomlistview.inc
View File

@ -731,7 +731,7 @@ begin
Exit; Exit;
Color := AWinControl.Color; Color := AWinControl.Color;
if Color = clDefault then if Color = clDefault then
Color := AWinControl.GetDefaultColor; Color := AWinControl.GetDefaultColor(dctBrush);
Windows.SendMessage(AWinControl.Handle, LVM_SETBKCOLOR, 0, ColorToRGB(Color)); Windows.SendMessage(AWinControl.Handle, LVM_SETBKCOLOR, 0, ColorToRGB(Color));
Windows.SendMessage(AWinControl.Handle, LVM_SETTEXTBKCOLOR, 0, ColorToRGB(Color)); Windows.SendMessage(AWinControl.Handle, LVM_SETTEXTBKCOLOR, 0, ColorToRGB(Color));
end; end;

11
lcl/widgetset/wscomctrls.pp
View File

@ -59,7 +59,7 @@ type
class procedure SetPanelText(const AStatusBar: TStatusBar; PanelIndex: integer); virtual; class procedure SetPanelText(const AStatusBar: TStatusBar; PanelIndex: integer); virtual;
class procedure SetSizeGrip(const AStatusBar: TStatusBar; SizeGrip: Boolean); virtual; class procedure SetSizeGrip(const AStatusBar: TStatusBar; SizeGrip: Boolean); virtual;
class procedure Update(const AStatusBar: TStatusBar); virtual; class procedure Update(const AStatusBar: TStatusBar); virtual;
class function GetDefaultColor(const AControl: TControl): TColor; override; class function GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor; override;
end; end;
{ TWSTabSheet } { TWSTabSheet }
@ -250,9 +250,14 @@ class procedure TWSStatusBar.Update(const AStatusBar: TStatusBar);
begin begin
end; end;
class function TWSStatusBar.GetDefaultColor(const AControl: TControl): TColor; class function TWSStatusBar.GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor;
const
DefColors: array[TDefaultColorType] of TColor = (
{ dctBrush } clBtnFace,
{ dctFont } clBtnText
);
begin begin
Result := clBtnFace; Result := DefColors[ADefaultColorType];
end; end;
{ TWSCustomListView } { TWSCustomListView }

4
lcl/widgetset/wscontrols.pp
View File

@ -73,7 +73,7 @@ type
published published
class procedure AddControl(const AControl: TControl); virtual; class procedure AddControl(const AControl: TControl); virtual;
class function GetConstraints(const AControl: TControl; const AConstraints: TObject): Boolean; virtual; class function GetConstraints(const AControl: TControl; const AConstraints: TObject): Boolean; virtual;
class function GetDefaultColor(const AControl: TControl): TColor; virtual; class function GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor; virtual;
class procedure ConstraintWidth(const AControl: TControl; const AConstraints: TObject; var aWidth: integer); virtual; class procedure ConstraintWidth(const AControl: TControl; const AConstraints: TObject; var aWidth: integer); virtual;
class procedure ConstraintHeight(const AControl: TControl; const AConstraints: TObject; var aHeight: integer); virtual; class procedure ConstraintHeight(const AControl: TControl; const AConstraints: TObject; var aHeight: integer); virtual;
end; end;
@ -163,7 +163,7 @@ begin
Result := WidgetSet.GetControlConstraints(AConstraints); Result := WidgetSet.GetControlConstraints(AConstraints);
end; end;
class function TWSControl.GetDefaultColor(const AControl: TControl): TColor; class function TWSControl.GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor;
begin begin
Result := clDefault; Result := clDefault;
end; end;

11
lcl/widgetset/wsextctrls.pp
View File

@ -174,7 +174,7 @@ type
TWSCustomPanel = class(TWSCustomControl) TWSCustomPanel = class(TWSCustomControl)
published published
class function GetDefaultColor(const AControl: TControl): TColor; override; class function GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor; override;
end; end;
{ TWSPanel } { TWSPanel }
@ -512,9 +512,14 @@ end;
{ TWSCustomPanel } { TWSCustomPanel }
class function TWSCustomPanel.GetDefaultColor(const AControl: TControl): TColor; class function TWSCustomPanel.GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor;
const
DefColors: array[TDefaultColorType] of TColor = (
{ dctBrush } clBtnFace,
{ dctFont } clBtnText
);
begin begin
Result := clBtnFace; Result := DefColors[ADefaultColorType];
end; end;
end. end.

11
lcl/widgetset/wsforms.pp
View File

@ -95,7 +95,7 @@ type
const APopupMode: TPopupMode; const APopupParent: TCustomForm); virtual; const APopupMode: TPopupMode; const APopupParent: TCustomForm); virtual;
class procedure SetShowInTaskbar(const AForm: TCustomForm; const AValue: TShowInTaskbar); virtual; class procedure SetShowInTaskbar(const AForm: TCustomForm; const AValue: TShowInTaskbar); virtual;
class procedure SetZPosition(const AWinControl: TWinControl; const APosition: TWSZPosition); virtual; class procedure SetZPosition(const AWinControl: TWinControl; const APosition: TWSZPosition); virtual;
class function GetDefaultColor(const AControl: TControl): TColor; override; class function GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor; override;
end; end;
TWSCustomFormClass = class of TWSCustomForm; TWSCustomFormClass = class of TWSCustomForm;
@ -180,9 +180,14 @@ class procedure TWSCustomForm.SetZPosition(const AWinControl: TWinControl; const
begin begin
end; end;
class function TWSCustomForm.GetDefaultColor(const AControl: TControl): TColor; class function TWSCustomForm.GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor;
const
DefColors: array[TDefaultColorType] of TColor = (
{ dctBrush } clForm,
{ dctFont } clBtnText
);
begin begin
Result := clForm; Result := DefColors[ADefaultColorType];
end; end;
class procedure TWSCustomForm.ShowModal(const ACustomForm: TCustomForm); class procedure TWSCustomForm.ShowModal(const ACustomForm: TCustomForm);

11
lcl/widgetset/wsstdctrls.pp
View File

@ -209,7 +209,7 @@ type
TWSButtonControl = class(TWSWinControl) TWSButtonControl = class(TWSWinControl)
published published
class function GetDefaultColor(const AControl: TControl): TColor; override; class function GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor; override;
end; end;
{ TWSButton } { TWSButton }
@ -778,9 +778,14 @@ end;
{ TWSButtonControl } { TWSButtonControl }
class function TWSButtonControl.GetDefaultColor(const AControl: TControl): TColor; class function TWSButtonControl.GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor;
const
DefColors: array[TDefaultColorType] of TColor = (
{ dctBrush } clBtnFace,
{ dctFont } clBtnText
);
begin begin
Result := clBtnFace; Result := DefColors[ADefaultColorType];
end; end;
end. end.