paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-23 00:59:31 +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
);
TDefaultColorType = (
dctBrush,
dctFont
);
{* Note on TControl.Caption
* The VCL implementation relies on the virtual Get/SetTextBuf to
* exchange text between widgets and VCL. This means a lot of
@ -1288,7 +1293,7 @@ type
WithThemeSpace: boolean = true); virtual;
function GetDefaultWidth: integer;
function GetDefaultHeight: integer;
function GetDefaultColor: TColor; virtual;
function GetDefaultColor(const DefaultColorType: TDefaultColorType): TColor; virtual;
function GetSidePosition(Side: TAnchorKind): integer;
procedure CNPreferredSizeChanged;
procedure InvalidatePreferredSize; virtual;

13
lcl/include/control.inc
View File

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

2
lcl/include/controlcanvas.inc
View File

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

6
lcl/include/wincontrol.inc
View File

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

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

@ -1367,7 +1367,7 @@ begin
Windows.SetTextColor(WindowDC, Windows.COLORREF(ColorToRGB(ChildWinControl.Font.Color)));
WindowColor := ChildWinControl.Brush.Color;
if WindowColor = clDefault then
WindowColor := ChildWinControl.GetDefaultColor;
WindowColor := ChildWinControl.GetDefaultColor(dctBrush);
Windows.SetBkColor(WindowDC, Windows.COLORREF(ColorToRGB(WindowColor)));
LMessage.Result := LResult(ChildWinControl.Brush.Reference.Handle);
//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
Exit;
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
Windows.SendMessage(AWinControl.Handle, SB_SETBKCOLOR, 0, ColorToRGB(AWinControl.Color));
end;

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

@ -991,7 +991,7 @@ begin
Exit;
Color := AWinControl.Color;
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_SETTEXTBKCOLOR, 0, ColorToRGB(Color));
end;

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

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

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

@ -731,7 +731,7 @@ begin
Exit;
Color := AWinControl.Color;
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_SETTEXTBKCOLOR, 0, ColorToRGB(Color));
end;

11
lcl/widgetset/wscomctrls.pp
View File

@ -59,7 +59,7 @@ type
class procedure SetPanelText(const AStatusBar: TStatusBar; PanelIndex: integer); virtual;
class procedure SetSizeGrip(const AStatusBar: TStatusBar; SizeGrip: Boolean); 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;
{ TWSTabSheet }
@ -250,9 +250,14 @@ class procedure TWSStatusBar.Update(const AStatusBar: TStatusBar);
begin
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
Result := clBtnFace;
Result := DefColors[ADefaultColorType];
end;
{ TWSCustomListView }

6
lcl/widgetset/wscontrols.pp
View File

@ -66,14 +66,14 @@ type
end;
TWSDragImageListClass = class of TWSDragImageList;
{ TWSControl }
TWSControl = class(TWSLCLComponent)
published
class procedure AddControl(const AControl: TControl); 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 ConstraintHeight(const AControl: TControl; const AConstraints: TObject; var aHeight: integer); virtual;
end;
@ -163,7 +163,7 @@ begin
Result := WidgetSet.GetControlConstraints(AConstraints);
end;
class function TWSControl.GetDefaultColor(const AControl: TControl): TColor;
class function TWSControl.GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor;
begin
Result := clDefault;
end;

11
lcl/widgetset/wsextctrls.pp
View File

@ -174,7 +174,7 @@ type
TWSCustomPanel = class(TWSCustomControl)
published
class function GetDefaultColor(const AControl: TControl): TColor; override;
class function GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor; override;
end;
{ TWSPanel }
@ -512,9 +512,14 @@ end;
{ 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
Result := clBtnFace;
Result := DefColors[ADefaultColorType];
end;
end.

11
lcl/widgetset/wsforms.pp
View File

@ -95,7 +95,7 @@ type
const APopupMode: TPopupMode; const APopupParent: TCustomForm); virtual;
class procedure SetShowInTaskbar(const AForm: TCustomForm; const AValue: TShowInTaskbar); 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;
TWSCustomFormClass = class of TWSCustomForm;
@ -180,9 +180,14 @@ class procedure TWSCustomForm.SetZPosition(const AWinControl: TWinControl; const
begin
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
Result := clForm;
Result := DefColors[ADefaultColorType];
end;
class procedure TWSCustomForm.ShowModal(const ACustomForm: TCustomForm);

11
lcl/widgetset/wsstdctrls.pp
View File

@ -209,7 +209,7 @@ type
TWSButtonControl = class(TWSWinControl)
published
class function GetDefaultColor(const AControl: TControl): TColor; override;
class function GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor; override;
end;
{ TWSButton }
@ -778,9 +778,14 @@ end;
{ 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
Result := clBtnFace;
Result := DefColors[ADefaultColorType];
end;
end.