win32, lcl: further work on clDefault implementation

git-svn-id: trunk@28111 -

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;
 

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 }
 

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

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.

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

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.