gtk: perform erasing background on non opaque controls

git-svn-id: trunk@13842 -

lcl/interfaces/gtk/gtkcallback.inc

@@ -27,15 +27,29 @@
 
 {$ENDIF}
 
+function DoDeliverPaintMessage(const Target: TObject; var PaintMsg: TLMPaint): PtrInt;
+begin
+  if (TObject(Target) is TCustomControl) and not (csOpaque in TWinControl(Target).ControlStyle) then
+  begin
+    Include(TWinControlAccess(Target).FWinControlFlags, wcfEraseBackground);
+    TWinControl(Target).Perform(LM_ERASEBKGND, PaintMsg.DC, 0);
+    Exclude(TWinControlAccess(Target).FWinControlFlags, wcfEraseBackground);
+  end;
+
+  Result := DeliverMessage(Target, PaintMsg);
+end;
+
 function DeliverPaintMessage(const Target: Pointer; var TheMessage): GBoolean;
 var
   PaintMsg: TLMPaint;
 begin
-  if TLMessage(TheMessage).Msg=LM_GtkPAINT then
+  if TLMessage(TheMessage).Msg = LM_GTKPAINT then
-    PaintMsg:= GtkPaintMessageToPaintMessage(TLMGtkPaint(TheMessage),true)
+    PaintMsg := GtkPaintMessageToPaintMessage(TLMGtkPaint(TheMessage), True)
   else
     PaintMsg := TLMPaint(TheMessage);
-  Result := DeliverMessage(Target,PaintMsg) = 0;
+
+  Result := DoDeliverPaintMessage(TObject(Target), PaintMsg) = 0;
+  
   FinalizePaintMessage(PLMessage(@PaintMsg));
 end;
 
@@ -57,13 +71,12 @@ begin
   end
   else
   begin
-    if TLMessage(TheMessage).Msg<>LM_GtkPAINT then
+    if TLMessage(TheMessage).Msg <> LM_GTKPAINT then
       Result := DeliverMessage(Target, TheMessage) = 0
-    else begin
+    else
       Result := DeliverPaintMessage(Target, TheMessage);
   end;
 end;
-end;
 
 function DeliverGtkPaintMessage(Target: Pointer; Widget: PGtkWidget;
   Area: PGDKRectangle; RepaintAll, IsAfterGtk: boolean): GBoolean;
@@ -73,9 +86,6 @@ function DeliverGtkPaintMessage(Target: Pointer; Widget: PGtkWidget;
 {$ENDIF}
 var
   MSG: TLMGtkPaint;
-  {$IFDEF DirectPaintMsg}
-  PaintMsg: TLMPaint;
-  {$ENDIF}
 begin
   //DebugLn(['DeliverGtkPaintMessage ',DbgSName(TObject(Target)),' Widget=',GetWidgetDebugReport(Widget),' RepaintAll=',RepaintAll,' AfterGtk=',IsAfterGtk,' Area=',dbgs(Area)]);
   {$IFDEF Gtk2}
@@ -83,16 +93,18 @@ begin
   // In case of TCustomControl, there is no gtk painting only the
   // child paintings. Let the TCustomControl paint the background.
   // ToDo: Eventually there must be a 'before paint message'.
-  if IsAfterGtk then begin
+  if IsAfterGtk then
+  begin
     if TObject(Target) is TCustomControl then exit;
-  end else begin
+  end else
+  begin
     if not (TObject(Target) is TCustomControl) then exit;
   end;
   {$ENDIF}
   
   if (not RepaintAll) and ((Area^.Width<1) or (Area^.Height<1)) then exit;
 
-  MSG.Msg := LM_GtkPAINT;
+  MSG.Msg := LM_GTKPAINT;
   MSG.Data := TLMGtkPaintData.Create;
   MSG.Data.Widget := Widget;
   MSG.Data.State := GtkPaint_LCLWidget;
@@ -100,9 +112,7 @@ begin
   Msg.Data.RepaintAll := RepaintAll;
 
   {$IFDEF DirectPaintMsg}
-  PaintMsg:= GtkPaintMessageToPaintMessage(Msg,true);
+  Result := DeliverPaintMessage(Target, Msg);
-  Result := DeliverMessage(Target,PaintMsg) = 0;
-  FinalizePaintMessage(PLMessage(@PaintMsg));
   {$ELSE}
   Result := DeliverPostMessage(Target, Msg);
   {$ENDIF}

lcl/interfaces/gtk/gtkglobals.pp

@@ -284,7 +284,7 @@ var
 
 // Internal Paint message:
 const
-  LM_GTKPaint         = LM_INTERFACEFIRST + 0;
+  LM_GTKPAINT         = LM_INTERFACEFIRST + 0;
   
   GtkPaint_LCLWidget = 1;
   GtkPaint_GtkWidget = 2;

lcl/interfaces/gtk/gtkmsgqueue.pp

@@ -36,7 +36,7 @@ type
     fMsg : PMsg;
   public
     property Msg: PMsg read fMsg write fMsg;
-    function IsPaintMessage : boolean;
+    function IsPaintMessage: Boolean;
     procedure DestroyMessage(ParFinalInternalOnly: TFinalPaintMessageFlag;
                              DisposeMessage: boolean);
     constructor Create;
@@ -72,12 +72,12 @@ implementation
 
 {---(TGtkMessageQueueItem)----------------------}
 
-function TGtkMessageQueueItem.IsPaintMessage : boolean;
+function TGtkMessageQueueItem.IsPaintMessage: Boolean;
 begin
-  Result := false;
+  if fMsg <> nil then
-  if fMsg <> nil then begin
+    Result := (Msg^.Message = LM_PAINT) or (Msg^.Message = LM_GTKPAINT)
-    Result := (Msg^.Message = LM_Paint) or (Msg^.Message = LM_GtkPaint);
+  else
-  end;
+    Result := False;
 end;
 
 constructor TGtkMessageQueueItem.Create;
@@ -90,7 +90,7 @@ procedure TGtkMessageQueueItem.DestroyMessage(
   ParFinalInternalOnly: TFinalPaintMessageFlag; DisposeMessage: boolean);
 begin
   if (ParFinalInternalOnly in [FPMF_All, FPMF_Internal])
-  and (fMsg^.message = LM_GtkPaint)
+  and (fMsg^.message = LM_GTKPAINT)
   then
     FinalizePaintTagMsg(fMsg);
   if DisposeMessage then

lcl/interfaces/gtk/gtkproc.inc

@@ -943,7 +943,7 @@ end;
   function GtkPaintMessageToPaintMessage(var GtkPaintMsg: TLMGtkPaint;
     FreeGtkPaintMsg: boolean): TLMPaint;
 
-  Converts a LM_GtkPaint message to a LM_PAINT message
+  Converts a LM_GTKPAINT message to a LM_PAINT message
  ------------------------------------------------------------------------------}
 function GtkPaintMessageToPaintMessage(var GtkPaintMsg: TLMGtkPaint;
   FreeGtkPaintMsg: boolean): TLMPaint;
@@ -972,10 +972,12 @@ var
   PS: PPaintStruct;
   DC: TGtkDeviceContext;
 begin
-  if (Msg^.Msg=LM_PAINT) or (Msg^.Msg=LM_INTERNALPAINT) then begin
+  if (Msg^.Msg = LM_PAINT) or (Msg^.Msg = LM_INTERNALPAINT) then
-    if Msg^.LParam <> 0 then begin
+  begin
+    if Msg^.LParam <> 0 then
+    begin
       PS := PPaintStruct(Msg^.LParam);
-       If Msg^.WParam<>0 then
+      if Msg^.WParam <> 0 then
         DC := TGtkDeviceContext(Msg^.WParam)
       else
         DC := TGtkDeviceContext(PS^.hdc);
@@ -983,26 +985,29 @@ begin
       Dispose(PS);
       Msg^.LParam:=0;
       Msg^.WParam:=0;
-    end else
+    end
-      if Msg^.WParam<>0 then begin
+    else
+    if Msg^.WParam<>0 then
+    begin
       ReleaseDC(0, Msg^.WParam);
       Msg^.WParam := 0;
     end;
   end else
-  if Msg^.Msg=LM_GtkPAINT then begin
+  if Msg^.Msg = LM_GTKPAINT then
     FreeThenNil(TLMGtkPaintData(Msg^.WParam));
 end;
-end;
 
 procedure FinalizePaintTagMsg(Msg: PMsg);
 var
   PS: PPaintStruct;
   DC: TGtkDeviceContext;
 begin
-  if (Msg^.Message=LM_PAINT) or (Msg^.Message=LM_INTERNALPAINT) then begin
+  if (Msg^.Message = LM_PAINT) or (Msg^.Message = LM_INTERNALPAINT) then
-    If Msg^.LParam <> 0 then begin
+  begin
+    if Msg^.LParam <> 0 then
+    begin
       PS := PPaintStruct(Msg^.LParam);
-       If Msg^.WParam<>0 then
+      if Msg^.WParam<>0 then
         DC := TGtkDeviceContext(Msg^.WParam)
       else
         DC := TGtkDeviceContext(PS^.hdc);
@@ -1011,15 +1016,15 @@ begin
       Msg^.LParam:=0;
       Msg^.WParam:=0;
     end else
-      if Msg^.WParam<>0 then begin
+    if Msg^.WParam<>0 then
+    begin
       ReleaseDC(0, Msg^.WParam);
       Msg^.WParam:=0;
     end;
   end else
-  if Msg^.Message=LM_GtkPAINT then begin
+  if Msg^.Message = LM_GTKPAINT then
     FreeThenNil(TObject(Msg^.WParam));
 end;
-end;
 
 procedure SetGCRasterOperation(TheGC: PGDKGC; Rop: Cardinal);
 begin
@@ -3591,7 +3596,7 @@ begin
   {$ENDIF}
   if (TLMessage(AMessage).Msg=LM_PAINT)
   or (TLMessage(AMessage).Msg=LM_INTERNALPAINT)
-  or (TLMessage(AMessage).Msg=LM_GtkPaint) then
+  or (TLMessage(AMessage).Msg=LM_GTKPAINT) then
     CurrentSentPaintMessageTarget:=TObject(Target);
   try
     if TObject(Target) is TControl

lcl/interfaces/gtk/gtkproc.pp

@@ -377,6 +377,7 @@ procedure SetLabelAlignment(LabelWidget: PGtkLabel;
   const NewAlignment: TAlignment);
 
 // paint messages
+function DoDeliverPaintMessage(const Target: TObject; var PaintMsg: TLMPaint): PtrInt;
 function GtkPaintMessageToPaintMessage(var GtkPaintMsg: TLMGtkPaint;
   FreeGtkPaintMsg: boolean): TLMPaint;
 procedure FinalizePaintMessage(Msg: PLMessage);
@@ -860,6 +861,9 @@ type
     function IsEqual(Event: PGdkEventKey): boolean;
   end;
   
+  TWinControlAccess = class(TWinControl)
+  end;
+
 { TLCLHandledKeyEvent }
 
 constructor TLCLHandledKeyEvent.Create(Event: PGdkEventKey);

lcl/interfaces/gtk/gtkwinapi.inc

@@ -7173,30 +7173,37 @@ function TGtkWidgetSet.PostMessage(Handle: HWND; Msg: Cardinal; wParam: WParam;
     if vlItem = nil then exit;
     OldMsg := vlItem.Msg;
     if OldMsg = nil then exit;
-    if (NewMsg^.Message=LM_PAINT) or (OldMsg^.Message=LM_PAINT) then begin
+    if (NewMsg^.Message = LM_PAINT) or (OldMsg^.Message = LM_PAINT) then
+    begin
       // LM_PAINT means: repaint all
       // convert NewMsg into a LM_PAINT if not already done
-      if NewMsg^.Message<>LM_PAINT then begin
+      if NewMsg^.Message <> LM_PAINT then
+      begin
         FinalizePaintTagMsg(NewMsg);
         NewMsg^.Message:=LM_PAINT;
       end;
-    end else if (NewMsg^.Message<>LM_GtkPAINT) then begin
+    end
-      RaiseGDBException('CombinePaintMessages A unknown paint message');
+    else
-    end else if (OldMsg^.Message<>LM_GtkPAINT) then begin
+    if (NewMsg^.Message <> LM_GTKPAINT) then
-      RaiseGDBException('CombinePaintMessages B unknown paint message');
+      RaiseGDBException('CombinePaintMessages A unknown paint message')
-    end else begin
+    else
+    if (OldMsg^.Message<>LM_GtkPAINT) then
+      RaiseGDBException('CombinePaintMessages B unknown paint message')
+    else
+    begin
       // combine the two LM_GtkPAINT messages
       NewData := TLMGtkPaintData(NewMsg^.WParam);
       OldData := TLMGtkPaintData(OldMsg^.WParam);
       NewData.RepaintAll := NewData.RepaintAll or OldData.RepaintAll;
-      if not NewData.RepaintAll then begin
+      if not NewData.RepaintAll then
+      begin
         NewData.Rect.Left := Min(NewData.Rect.Left, OldData.Rect.Left);
         NewData.Rect.Top := Min(NewData.Rect.Top, OldData.Rect.Top);
         NewData.Rect.Right := Max(NewData.Rect.Right, OldData.Rect.Right);
         NewData.Rect.Bottom := Max(NewData.Rect.Bottom, OldData.Rect.Bottom);
       end;
     end;
-    fMessageQueue.RemoveMessage(vlItem,FPMF_All,true);
+    fMessageQueue.RemoveMessage(vlItem, FPMF_All, True);
   end;
 
 var
@@ -7211,7 +7218,8 @@ begin
   AMessage^.LParam := LParam;
 //  Message^.Time :=
 
-  if (AMessage^.Message=LM_PAINT) or (AMessage^.Message=LM_GtkPAINT) then begin
+  if (AMessage^.Message = LM_PAINT) or (AMessage^.Message = LM_GTKPAINT) then
+  begin
     { Obsolete, because InvalidateRectangle now works.
 
     // paint messages are the most expensive messages in the LCL
@@ -7992,11 +8000,11 @@ var
     end;
     {$ENDIF}
     
-    if AMessage.Msg=LM_GtkPAINT
+    if AMessage.Msg = LM_GTKPAINT
     then begin
       OldGtkPaintMsg := TLMGtkPaint(AMessage);
       GtkPaintData := OldGtkPaintMsg.Data;
-      // convert LM_GtkPAINT to LM_PAINT
+      // convert LM_GTKPAINT to LM_PAINT
       AMessage := TLMessage(GtkPaintMessageToPaintMessage(
                                                 TLMGtkPaint(AMessage), False));
       {$IfNDef GTK2}
@@ -8005,7 +8013,8 @@ var
         PaintDC := TLMPaint(AMessage).DC;
         DCOrigin := TGtkDeviceContext(PaintDC).Offset;
         with GtkPaintData.Rect do
-          IntersectClipRect(PaintDC,Left-DCOrigin.X,Top-DCOrigin.Y,
+          IntersectClipRect(PaintDC,
+                            Left - DCOrigin.X, Top - DCOrigin.Y,
                             Right - DCOrigin.X, Bottom - DCOrigin.Y);
       end;
       {$EndIf}
@@ -8015,15 +8024,18 @@ var
 
   procedure DisposePaintMessage(TargetObject: TObject; var AMessage: TLMessage);
   begin
-    if OldMsg=LM_GtkPAINT then begin
+    if OldMsg = LM_GTKPAINT then
+    begin
       FinalizePaintMessage(@AMessage);
 
       //if (csDesigning in TComponent(TargetObject).ComponentState)
       //and (TargetObject is TWinControl) then
       //  SendPaintMessagesForInternalWidgets(TWinControl(TargetObject));
-    end else
+    end
+    else
     if ((AMessage.Msg = LM_PAINT) or (AMessage.Msg = LM_INTERNALPAINT))
-    and (AMessage.WParam<>0) then begin
+    and (AMessage.WParam <> 0) then
+    begin
       // free DC
       ReleaseDC(0, AMessage.WParam);
       AMessage.WParam := 0;
@@ -8047,19 +8059,20 @@ begin
 
   Target := GetLCLObject(Pointer(HandleWnd));
 
-  if Target<>nil then begin
+  if Target <> nil then
-    if (Msg=LM_PAINT) or (Msg=LM_GtkPaint) then begin
+  begin
+    if (Msg = LM_PAINT) or (Msg = LM_GTKPAINT) then
+    begin
       PreparePaintMessage(Target,AMessage);
-    end;
+      Result := DoDeliverPaintMessage(Target, TLMPaint(AMessage));
+    end
+    else
+      Result := DeliverMessage(Target, AMessage); // deliver it
 
-    // deliver it
+    if (Msg = LM_PAINT) or (Msg = LM_INTERNALPAINT) or (Msg = LM_GTKPAINT) then
-    Result := DeliverMessage(Target, AMessage);
-
-    if (Msg=LM_PAINT) or (Msg=LM_INTERNALPAINT) or (Msg=LM_GtkPaint) then begin
       DisposePaintMessage(Target, AMessage);
   end;
 end;
-end;
 
 {------------------------------------------------------------------------------
   function SetActiveWindow(Handle: HWND): HWND;