diff --git a/lcl/interfaces/gtk/gtkcallback.inc b/lcl/interfaces/gtk/gtkcallback.inc index 38a0c9d347..4504a45a33 100644 --- a/lcl/interfaces/gtk/gtkcallback.inc +++ b/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 - PaintMsg:= GtkPaintMessageToPaintMessage(TLMGtkPaint(TheMessage),true) + if TLMessage(TheMessage).Msg = LM_GTKPAINT then + PaintMsg := GtkPaintMessageToPaintMessage(TLMGtkPaint(TheMessage), True) else - PaintMsg:=TLMPaint(TheMessage); - Result := DeliverMessage(Target,PaintMsg) = 0; + PaintMsg := TLMPaint(TheMessage); + + Result := DoDeliverPaintMessage(TObject(Target), PaintMsg) = 0; + FinalizePaintMessage(PLMessage(@PaintMsg)); end; @@ -57,11 +71,10 @@ 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 - Result := DeliverPaintMessage(Target,TheMessage); - end; + else + Result := DeliverPaintMessage(Target, TheMessage); end; end; @@ -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,11 +112,9 @@ begin Msg.Data.RepaintAll := RepaintAll; {$IFDEF DirectPaintMsg} - PaintMsg:= GtkPaintMessageToPaintMessage(Msg,true); - Result := DeliverMessage(Target,PaintMsg) = 0; - FinalizePaintMessage(PLMessage(@PaintMsg)); + Result := DeliverPaintMessage(Target, Msg); {$ELSE} - Result := DeliverPostMessage(Target,Msg); + Result := DeliverPostMessage(Target, Msg); {$ENDIF} end; diff --git a/lcl/interfaces/gtk/gtkglobals.pp b/lcl/interfaces/gtk/gtkglobals.pp index f7424ee067..3edc03b806 100644 --- a/lcl/interfaces/gtk/gtkglobals.pp +++ b/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; diff --git a/lcl/interfaces/gtk/gtkmsgqueue.pp b/lcl/interfaces/gtk/gtkmsgqueue.pp index dbd2f4b0da..a8ae93b995 100644 --- a/lcl/interfaces/gtk/gtkmsgqueue.pp +++ b/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 begin - Result := (Msg^.Message = LM_Paint) or (Msg^.Message = LM_GtkPaint); - end; + if fMsg <> nil then + Result := (Msg^.Message = LM_PAINT) or (Msg^.Message = LM_GTKPAINT) + else + Result := False; end; constructor TGtkMessageQueueItem.Create; @@ -89,8 +89,8 @@ end; procedure TGtkMessageQueueItem.DestroyMessage( ParFinalInternalOnly: TFinalPaintMessageFlag; DisposeMessage: boolean); begin - if (ParFinalInternalOnly in [FPMF_All,FPMF_Internal]) - and (fMsg^.message = LM_GtkPaint) + if (ParFinalInternalOnly in [FPMF_All, FPMF_Internal]) + and (fMsg^.message = LM_GTKPAINT) then FinalizePaintTagMsg(fMsg); if DisposeMessage then @@ -204,7 +204,7 @@ procedure TGtkMessageQueue.RemoveMessage(ParItem: TGtkMessageQueueItem; begin if (ParItem.IsPaintMessage) then fPaintMessages.Remove(ParItem); - ParItem.DestroyMessage(ParFinalOnlyInternal,DisposeMessage); + ParItem.DestroyMessage(ParFinalOnlyInternal, DisposeMessage); Delete(ParItem); end; diff --git a/lcl/interfaces/gtk/gtkproc.inc b/lcl/interfaces/gtk/gtkproc.inc index a2efe7fc27..3fddd3d36f 100644 --- a/lcl/interfaces/gtk/gtkproc.inc +++ b/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; @@ -951,7 +951,7 @@ var PS : PPaintStruct; Widget: PGtkWidget; begin - Result.Msg:=LM_PAINT; + Result.Msg := LM_PAINT; New(PS); FillChar(PS^, SizeOf(TPaintStruct), 0); Widget := GtkPaintMsg.Data.Widget; @@ -969,56 +969,61 @@ end; procedure FinalizePaintMessage(Msg: PLMessage); var - PS : PPaintStruct; - DC : TGtkDeviceContext; + PS: PPaintStruct; + DC: TGtkDeviceContext; begin - if (Msg^.Msg=LM_PAINT) or (Msg^.Msg=LM_INTERNALPAINT) then begin - if Msg^.LParam <> 0 then begin - PS := PPaintStruct(Msg^.LParam); - If Msg^.WParam<>0 then - DC := TGtkDeviceContext(Msg^.WParam) - else - DC := TGtkDeviceContext(PS^.hdc); - EndPaint(THandle(PtrUInt(DC.Widget)), PS^); - Dispose(PS); - Msg^.LParam:=0; - Msg^.WParam:=0; - end else - if Msg^.WParam<>0 then begin - ReleaseDC(0,Msg^.WParam); - Msg^.WParam:=0; - end; + if (Msg^.Msg = LM_PAINT) or (Msg^.Msg = LM_INTERNALPAINT) then + begin + if Msg^.LParam <> 0 then + begin + PS := PPaintStruct(Msg^.LParam); + if Msg^.WParam <> 0 then + DC := TGtkDeviceContext(Msg^.WParam) + else + DC := TGtkDeviceContext(PS^.hdc); + EndPaint(THandle(PtrUInt(DC.Widget)), PS^); + Dispose(PS); + Msg^.LParam:=0; + Msg^.WParam:=0; + end + 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; + PS: PPaintStruct; + DC: TGtkDeviceContext; begin - if (Msg^.Message=LM_PAINT) or (Msg^.Message=LM_INTERNALPAINT) then begin - If Msg^.LParam <> 0 then begin - PS := PPaintStruct(Msg^.LParam); - If Msg^.WParam<>0 then - DC := TGtkDeviceContext(Msg^.WParam) - else - DC := TGtkDeviceContext(PS^.hdc); - EndPaint(THandle(PtrUInt(DC.Widget)), PS^); - Dispose(PS); - Msg^.LParam:=0; - Msg^.WParam:=0; + if (Msg^.Message = LM_PAINT) or (Msg^.Message = LM_INTERNALPAINT) then + begin + if Msg^.LParam <> 0 then + begin + PS := PPaintStruct(Msg^.LParam); + if Msg^.WParam<>0 then + DC := TGtkDeviceContext(Msg^.WParam) + else + DC := TGtkDeviceContext(PS^.hdc); + EndPaint(THandle(PtrUInt(DC.Widget)), PS^); + Dispose(PS); + Msg^.LParam:=0; + Msg^.WParam:=0; end else - if Msg^.WParam<>0 then begin - ReleaseDC(0,Msg^.WParam); - Msg^.WParam:=0; - end; + 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); @@ -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 diff --git a/lcl/interfaces/gtk/gtkproc.pp b/lcl/interfaces/gtk/gtkproc.pp index 2ec8a64fb5..98e310f031 100644 --- a/lcl/interfaces/gtk/gtkproc.pp +++ b/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); @@ -859,6 +860,9 @@ type constructor Create(Event: PGdkEventKey); function IsEqual(Event: PGdkEventKey): boolean; end; + + TWinControlAccess = class(TWinControl) + end; { TLCLHandledKeyEvent } diff --git a/lcl/interfaces/gtk/gtkwinapi.inc b/lcl/interfaces/gtk/gtkwinapi.inc index c4acb47818..acb95dbd28 100644 --- a/lcl/interfaces/gtk/gtkwinapi.inc +++ b/lcl/interfaces/gtk/gtkwinapi.inc @@ -7172,31 +7172,38 @@ function TGtkWidgetSet.PostMessage(Handle: HWND; Msg: Cardinal; wParam: WParam; vlItem := fMessageQueue.FindPaintMessage(NewMsg^.Hwnd); 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 OldMsg = nil then exit; + 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 - RaiseGDBException('CombinePaintMessages A unknown paint message'); - end else if (OldMsg^.Message<>LM_GtkPAINT) then begin - RaiseGDBException('CombinePaintMessages B unknown paint message'); - end else begin + end + else + if (NewMsg^.Message <> LM_GTKPAINT) then + RaiseGDBException('CombinePaintMessages A unknown paint message') + 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 - 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); + NewData := TLMGtkPaintData(NewMsg^.WParam); + OldData := TLMGtkPaintData(OldMsg^.WParam); + NewData.RepaintAll := NewData.RepaintAll or OldData.RepaintAll; + 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 @@ -7227,7 +7235,7 @@ begin // so that the widget repaints only once CombinePaintMessages(AMessage); - end ; + end; FMessageQueue.AddMessage(AMessage); end; @@ -7992,21 +8000,22 @@ 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 + OldGtkPaintMsg := TLMGtkPaint(AMessage); + GtkPaintData := OldGtkPaintMsg.Data; + // convert LM_GTKPAINT to LM_PAINT AMessage := TLMessage(GtkPaintMessageToPaintMessage( TLMGtkPaint(AMessage), False)); {$IfNDef GTK2} - if (GtkPaintData<>nil) and (not GtkPaintData.RepaintAll) + if (GtkPaintData <> nil) and (not GtkPaintData.RepaintAll) then begin - PaintDC:=TLMPaint(AMessage).DC; - DCOrigin:= TGtkDeviceContext(PaintDC).Offset; + PaintDC := TLMPaint(AMessage).DC; + DCOrigin := TGtkDeviceContext(PaintDC).Offset; with GtkPaintData.Rect do - IntersectClipRect(PaintDC,Left-DCOrigin.X,Top-DCOrigin.Y, - Right-DCOrigin.X,Bottom-DCOrigin.Y); + IntersectClipRect(PaintDC, + Left - DCOrigin.X, Top - DCOrigin.Y, + Right - DCOrigin.X, Bottom - DCOrigin.Y); end; {$EndIf} GtkPaintData.Free; @@ -8015,18 +8024,21 @@ 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 - if ((AMessage.Msg=LM_PAINT) or (AMessage.Msg=LM_INTERNALPAINT)) - and (AMessage.WParam<>0) then begin + end + else + if ((AMessage.Msg = LM_PAINT) or (AMessage.Msg = LM_INTERNALPAINT)) + and (AMessage.WParam <> 0) then + begin // free DC - ReleaseDC(0,AMessage.WParam); - AMessage.WParam:=0; + ReleaseDC(0, AMessage.WParam); + AMessage.WParam := 0; //if (csDesigning in TComponent(TargetObject).ComponentState) //and (TargetObject is TWinControl) then @@ -8038,7 +8050,7 @@ var AMessage: TLMessage; Target: TObject; begin - OldMsg:=Msg; + OldMsg := Msg; AMessage.Msg := Msg; AMessage.WParam := WParam; @@ -8047,17 +8059,18 @@ begin Target := GetLCLObject(Pointer(HandleWnd)); - if Target<>nil then begin - if (Msg=LM_PAINT) or (Msg=LM_GtkPaint) then begin + if Target <> nil then + 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 - Result := DeliverMessage(Target, AMessage); - - if (Msg=LM_PAINT) or (Msg=LM_INTERNALPAINT) or (Msg=LM_GtkPaint) then begin - DisposePaintMessage(Target,AMessage); - end; + if (Msg = LM_PAINT) or (Msg = LM_INTERNALPAINT) or (Msg = LM_GTKPAINT) then + DisposePaintMessage(Target, AMessage); end; end;