From 8944d373f9be90d7e5f605cb1c4e7b050e03081f Mon Sep 17 00:00:00 2001 From: paul Date: Sun, 7 Nov 2010 12:54:33 +0000 Subject: [PATCH] win32, lcl: further work on clDefault implementation git-svn-id: trunk@28111 - --- lcl/interfaces/win32/win32winapi.inc | 30 ++++++++++++++++++++++++---- lcl/widgetset/wscomctrls.pp | 8 +++++++- lcl/widgetset/wscontrols.pp | 6 ++++++ lcl/widgetset/wsextctrls.pp | 8 ++++++++ lcl/widgetset/wsforms.pp | 10 ++++++++-- lcl/widgetset/wsstdctrls.pp | 10 +++++++++- 6 files changed, 64 insertions(+), 8 deletions(-) diff --git a/lcl/interfaces/win32/win32winapi.inc b/lcl/interfaces/win32/win32winapi.inc index 429856a6ac..738e17cfc8 100644 --- a/lcl/interfaces/win32/win32winapi.inc +++ b/lcl/interfaces/win32/win32winapi.inc @@ -232,20 +232,42 @@ var procedure CallEraseBkgndHandler; var ARect: TRect; + AColor: TColor; + ABrush: HBrush; begin // if window has a default bg brush or no DC is passed then just call a // default windows handler - if (GetClassLongPtr(Handle, GCLP_HBRBACKGROUND) <> 0) or (TLMessage(Message).WParam = 0) then + if TLMessage(Message).WParam = 0 then begin with TLMessage(Message) do Result := CallDefaultWindowProc(Handle, Msg, WParam, LParam); end else + // we have a DC, so lets draw ourself + if GetClientRect(Handle, ARect) then begin + ABrush := GetClassLongPtr(Handle, GCLP_HBRBACKGROUND); + if ABrush <> 0 then + begin + //DebugLn(['Found class color for window: ', WndClassName(Handle)]); + FillRect(HDC(TLMessage(Message).WParam), ARect, ABrush); + Exit; + end; //DebugLn(['No class color for window: ', WndClassName(Handle)]); - // erase with clBtnFace color - if GetClientRect(Handle, ARect) then - FillRect(HDC(TLMessage(Message).WParam), ARect, GetSysColorBrush(COLOR_BTNFACE)); + // get the default color + if Sender is TControl then + AColor := TWSWinControlClass(TControl(Sender).WidgetSetClass).GetDefaultColor(TControl(Sender)) + else + AColor := clBtnFace; + if IsSysColor(AColor) then + FillRect(HDC(TLMessage(Message).WParam), ARect, GetSysColorBrush(SysColorToSysColorIndex(AColor))) + else + begin + // not possible since default color must be system color. but who knows? + ABrush := CreateSolidBrush(AColor); + FillRect(HDC(TLMessage(Message).WParam), ARect, ABrush); + DeleteObject(ABrush); + end; end; end; diff --git a/lcl/widgetset/wscomctrls.pp b/lcl/widgetset/wscomctrls.pp index 414b9f7738..5988b29851 100644 --- a/lcl/widgetset/wscomctrls.pp +++ b/lcl/widgetset/wscomctrls.pp @@ -45,7 +45,7 @@ uses // To get as little as posible circles, // uncomment only when needed for registration //////////////////////////////////////////////////// - ComCtrls, Controls, ImgList, StdCtrls, + Graphics, ImgList, Controls, StdCtrls, ComCtrls, //////////////////////////////////////////////////// WSLCLClasses, WSControls, WSExtCtrls, WSToolwin, WSFactory; @@ -59,6 +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; end; { TWSTabSheet } @@ -248,6 +249,11 @@ end; class procedure TWSStatusBar.Update(const AStatusBar: TStatusBar); begin end; + +class function TWSStatusBar.GetDefaultColor(const AControl: TControl): TColor; +begin + Result := clBtnFace; +end; { TWSCustomListView } diff --git a/lcl/widgetset/wscontrols.pp b/lcl/widgetset/wscontrols.pp index 2ffb0ef442..12af6140ad 100644 --- a/lcl/widgetset/wscontrols.pp +++ b/lcl/widgetset/wscontrols.pp @@ -73,6 +73,7 @@ type 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 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; @@ -162,6 +163,11 @@ begin Result := WidgetSet.GetControlConstraints(AConstraints); end; +class function TWSControl.GetDefaultColor(const AControl: TControl): TColor; +begin + Result := clWindow; +end; + class procedure TWSControl.ConstraintWidth(const AControl: TControl; const AConstraints: TObject; var aWidth: integer); begin diff --git a/lcl/widgetset/wsextctrls.pp b/lcl/widgetset/wsextctrls.pp index 417cd87e8f..3a9232a58a 100644 --- a/lcl/widgetset/wsextctrls.pp +++ b/lcl/widgetset/wsextctrls.pp @@ -174,6 +174,7 @@ type TWSCustomPanel = class(TWSCustomControl) published + class function GetDefaultColor(const AControl: TControl): TColor; override; end; { TWSPanel } @@ -509,4 +510,11 @@ begin Done := True; end; +{ TWSCustomPanel } + +class function TWSCustomPanel.GetDefaultColor(const AControl: TControl): TColor; +begin + Result := clBtnFace; +end; + end. diff --git a/lcl/widgetset/wsforms.pp b/lcl/widgetset/wsforms.pp index f5d31b5d1b..8fefa41e46 100644 --- a/lcl/widgetset/wsforms.pp +++ b/lcl/widgetset/wsforms.pp @@ -44,9 +44,9 @@ uses // To get as little as posible circles, // uncomment only when needed for registration //////////////////////////////////////////////////// - Forms, + Graphics, Controls, Forms, LCLType, //////////////////////////////////////////////////// - WSLCLClasses, WSControls, Controls, LCLType, WSFactory; + WSLCLClasses, WSControls, WSFactory; type { TWSScrollingWinControl } @@ -95,6 +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; end; TWSCustomFormClass = class of TWSCustomForm; @@ -178,6 +179,11 @@ end; class procedure TWSCustomForm.SetZPosition(const AWinControl: TWinControl; const APosition: TWSZPosition); begin end; + +class function TWSCustomForm.GetDefaultColor(const AControl: TControl): TColor; +begin + Result := clForm; +end; class procedure TWSCustomForm.ShowModal(const ACustomForm: TCustomForm); begin diff --git a/lcl/widgetset/wsstdctrls.pp b/lcl/widgetset/wsstdctrls.pp index 678843c8ab..5f62c44729 100644 --- a/lcl/widgetset/wsstdctrls.pp +++ b/lcl/widgetset/wsstdctrls.pp @@ -44,7 +44,7 @@ uses // To get as little as posible circles, // uncomment only when needed for registration //////////////////////////////////////////////////// - StdCtrls, Graphics, + Graphics, Controls, StdCtrls, //////////////////////////////////////////////////// WSLCLClasses, WSControls, Classes, WSFactory, Clipbrd; @@ -209,6 +209,7 @@ type TWSButtonControl = class(TWSWinControl) published + class function GetDefaultColor(const AControl: TControl): TColor; override; end; { TWSButton } @@ -775,4 +776,11 @@ begin Done := True; end; +{ TWSButtonControl } + +class function TWSButtonControl.GetDefaultColor(const AControl: TControl): TColor; +begin + Result := clBtnFace; +end; + end.