LCL: added warning when painting outside of paint message

git-svn-id: trunk@25700 -

lcl/controls.pp

@@ -258,6 +258,7 @@ type
     constructor Create;
     destructor Destroy; override;
     procedure FreeHandle;override;
+    function ControlIsPainting: boolean;
     property Control: TControl read FControl write SetControl;
   end;
 
@@ -822,7 +823,8 @@ type
     cfBaseBoundsValid,
     cfPreferredSizeValid,
     cfPreferredMinSizeValid,
-    cfOnChangeBoundsNeeded
+    cfOnChangeBoundsNeeded,
+    cfProcessingWMPaint
     );
   TControlFlags = set of TControlFlag;
 
@@ -1305,6 +1307,7 @@ type
     function IsVisible: Boolean; virtual;// checks parents too
     function IsControlVisible: Boolean; virtual;// does not check parents
     function FormIsUpdating: boolean; virtual;
+    function IsProcessingPaintMsg: boolean;
     procedure Hide;
     procedure Refresh;
     procedure Repaint; virtual;

lcl/include/control.inc

@@ -628,6 +628,11 @@ begin
   Result := Assigned(Parent) and Parent.FormIsUpdating;
 end;
 
+function TControl.IsProcessingPaintMsg: boolean;
+begin
+  Result:=cfProcessingWMPaint in FControlFlags;
+end;
+
 {------------------------------------------------------------------------------
        TControl.LMCaptureChanged
 ------------------------------------------------------------------------------}
@@ -1612,7 +1617,16 @@ begin
         end;
     end;
   end;
-  Dispatch(TheMessage);
+
+  if TheMessage.Msg=LM_PAINT then begin
+    Include(FControlFlags,cfProcessingWMPaint);
+    try
+      Dispatch(TheMessage);
+    finally
+      Exclude(FControlFlags,cfProcessingWMPaint);
+    end;
+  end else
+    Dispatch(TheMessage);
 end;
 
 {------------------------------------------------------------------------------

lcl/include/controlcanvas.inc

@@ -83,6 +83,8 @@ begin
   if FControl = nil then
     inherited CreateHandle
   else begin
+    if ControlIsPainting then
+      debugln(['TControlCanvas.CreateHandle WARNING: accessing the canvas of '+DbgSName(FControl)+' is not supported outside of paint message']);
     if FDeviceContext = 0 then
     begin
       // store the handle locally since  we need it to check (and dont
@@ -109,3 +111,8 @@ begin
     FDeviceContext := 0;
   end;
 end;
+
+function TControlCanvas.ControlIsPainting: boolean;
+begin
+  Result:=(FControl<>nil) and FControl.IsProcessingPaintMsg;
+end;