added virtual TCanvas.FreeHandle and extended TControlCanvas to work without control from Darek

git-svn-id: trunk@9428 -

components/popupnotifier/demo/unit1.lrs

@@ -1,5 +1,3 @@
-{ This is an automatically generated lazarus resource file }
-
 LazarusResources.Add('TForm1','FORMDATA',[
   'TPF0'#6'TForm1'#5'Form1'#13'ActiveControl'#7#7'Button1'#7'Caption'#6#5'Form1'
   +#12'ClientHeight'#3#214#0#11'ClientWidth'#3#214#0#13'PixelsPerInch'#2'V'#18

lcl/controls.pp

@@ -246,7 +246,7 @@ type
   public
     constructor Create;
     destructor Destroy; override;
-    procedure FreeHandle;
+    procedure FreeHandle;override;
     property Control: TControl read FControl write SetControl;
   end;
   

lcl/graphics.pp

@@ -923,6 +923,7 @@ type
     procedure SetHandle(NewHandle: HDC); virtual;
     procedure SetInternalPenPos(const Value: TPoint); virtual;
     Procedure SetPixel(X,Y: Integer; Value: TColor); virtual;
+    procedure FreeHandle;virtual;
   public
     constructor Create;
     destructor Destroy; override;
@@ -1879,4 +1880,4 @@ finalization
   FreeAndNil(PicFileFormats);
 
 
-end.
+end.

lcl/include/canvas.inc

@@ -1367,7 +1367,7 @@ end;
  ------------------------------------------------------------------------------}
 procedure TCanvas.DeselectHandles;
 begin
-  //debugln('TCanvas.DeselectHandles ',ClassName,' Self=',DbgS(Self),' Handle=',DbgS(FHandle),8),' FSavedBrushHandle=',DbgS(Cardinal(FSavedBrushHandle));
+  //debugln('TCanvas.DeselectHandles ',ClassName,' Self=',DbgS(Self),' Handle=',DbgS(FHandle),' FSavedBrushHandle=',DbgS(Cardinal(FSavedBrushHandle)));
   if (FHandle<>0) then begin
     // select default sub handles in the device context without deleting owns
     if FSavedBrushHandle<>0 then begin
@@ -1395,7 +1395,12 @@ end;
  ------------------------------------------------------------------------------}
 procedure TCanvas.CreateHandle;
 begin
-// Plain canvas does nothing
+  // Plain canvas does nothing
+end;
+
+procedure TCanvas.FreeHandle;
+begin
+  Handle:=0;
 end;
 
 {------------------------------------------------------------------------------

lcl/include/controlcanvas.inc

@@ -79,9 +79,9 @@ end;
  ------------------------------------------------------------------------------}
 procedure TControlCanvas.CreateHandle;
 begin
-//DebugLn('[TControlCanvas.CreateHandle] ',FControl<>nil,' DC=',DbgS(FDeviceContext,8),' WinHandle=',DbgS(FWindowHandle,8));
-  if FControl = nil
-  then inherited CreateHandle
+  //DebugLn('[TControlCanvas.CreateHandle] ',FControl<>nil,' DC=',DbgS(FDeviceContext,8),' WinHandle=',DbgS(FWindowHandle,8));
+  if FControl = nil then
+    inherited CreateHandle
   else begin
     if FDeviceContext = 0 then
     begin
@@ -102,9 +102,9 @@ end;
  ------------------------------------------------------------------------------}
 procedure TControlCanvas.FreeHandle;
 begin
+  inherited;
   if FDeviceContext <> 0 then
   begin
-    Handle := 0;
     ReleaseDC(FWindowHandle, FDeviceContext);
     FDeviceContext := 0;
   end;

lcl/include/scrollingwincontrol.inc

@@ -124,7 +124,7 @@ procedure TScrollingWinControl.DestroyWnd;
 begin
   inherited DestroyWnd;
   if Canvas<>nil then
-    Canvas.Handle:=0;
+    Canvas.FreeHandle;
 end;
 
 Function TScrollingWinControl.StoreScrollBars : Boolean;

lcl/interfaces/gtk/gtkproc.inc

@@ -3908,17 +3908,14 @@ function GetWidgetInfo(const AWidget: Pointer;
 var
   MainWidget: PGtkObject;
 begin
-  if AWidget <> nil
-  then begin
+  if AWidget <> nil then begin
     MainWidget := GetMainWidget(AWidget);
-    if MainWidget = nil then MainWidget := AWidget;
     Result := gtk_object_get_data(MainWidget, 'widgetinfo');
-    if (Result = nil) and ACreate
-    then begin
+    if (Result = nil) and ACreate then begin
       Result := CreateWidgetInfo(MainWidget);
       // use the main widget as default
       Result^.CoreWidget := PGtkWidget(MainWidget);
-    end;  
+    end;
   end
   else Result := nil;
 end;