MG: fixed many bugs (mem leaks, canvas)

git-svn-id: trunk@231 -

designer/controlselection.pp

@@ -25,7 +25,7 @@ unit ControlSelection;
 interface
 
 uses
-  Classes, Controls, LCLLinux, Forms, Graphics;
+  Classes, LCLLinux, Controls, Forms, Graphics;
 
 type
   TGrabberMoveEvent = procedure(Sender: TObject; dx, dy: Integer) of object;
@@ -101,6 +101,7 @@ type
     FOldHeight: integer;
 
     FCustomForm: TCustomForm;
+    FCanvas: TCanvas;
     FGrabbers: array[TGrabIndex] of TGrabber;
     FGrabberSize: integer;
     FGrabberColor: TColor;
@@ -260,6 +261,7 @@ begin
     FGrabbers[g].Cursor:=GRAB_CURSOR[g];
   end;
   FCustomForm:=nil;
+  FCanvas:=TCanvas.Create;
   FActiveGrabber:=nil;
   FUpdateLock:=0;
   FChangedDuringLock:=false;
@@ -273,6 +275,7 @@ begin
   Clear;
   FControls.Free;
   for g:=Low(TGrabIndex) to High(TGrabIndex) do FGrabbers[g].Free;
+  FCanvas.Free;
   inherited Destroy;
 end;
 
@@ -430,11 +433,13 @@ end;
 function TControlSelection.Add(AControl: TControl):integer;
 var NewSelectedControl:TSelectedControl;
 begin
+  BeginUpdate;
   NewSelectedControl:=TSelectedControl.Create(AControl);
   if GetParentForm(AControl)<>FCustomForm then Clear;
   Result:=FControls.Add(NewSelectedControl);
   if Count=1 then SetCustomForm;
   AdjustSize;
+  EndUpdate;
   DoChange;  
 end;
 
@@ -576,7 +581,8 @@ procedure TControlSelection.DrawGrabbers(DC: HDC);
 var OldBrushColor:TColor;
   g:TGrabIndex;
   FormOrigin, DCOrigin, Diff: TPoint;
-  OldFormHandle: HDC;
+  SaveIndex: integer;
+//  OldFormHandle: HDC;
 begin
   if (Count=0) or (FCustomForm=nil)
   or (Items[0].Control is TCustomForm) then exit;
@@ -590,9 +596,10 @@ writeln('[DrawGrabbers] Form=',FormOrigin.X,',',FormOrigin.Y
    ,' Grabber1=',FGrabbers[0].Left,',',FGrabbers[0].Top
    ,' Selection=',FLeft,',',FTop);
 }
-  OldFormHandle:=FCustomForm.Canvas.Handle;
+//  OldFormHandle:=FCustomForm.Canvas.Handle;
-  FCustomForm.Canvas.Handle:=DC;
+  SaveIndex:=SaveDC(DC);
-  with FCustomForm.Canvas do begin
+  FCanvas.Handle:=DC;
+  with FCanvas do begin
     OldBrushColor:=Brush.Color;
     Brush.Color:=FGrabberColor;
     for g:=Low(TGrabIndex) to High(TGrabIndex) do
@@ -604,7 +611,9 @@ writeln('[DrawGrabbers] Form=',FormOrigin.X,',',FormOrigin.Y
       ));
     Brush.Color:=OldbrushColor;
   end;
-  FCustomForm.Canvas.Handle:=OldFormHandle;
+  FCanvas.Handle:=0;
+  RestoreDC(DC,SaveIndex);
+//  FCustomForm.Canvas.Handle:=OldFormHandle;
 end;
 
 procedure TControlSelection.DrawMarker(AControl:TControl; DC:HDC);
@@ -612,7 +621,7 @@ var OldBrushColor:TColor;
   ALeft,ATop:integer;
   AControlOrigin,DCOrigin:TPoint;
   SaveIndex:HDC;
-  OldFormHandle:HDC;
+//  OldFormHandle:HDC;
 begin
   if (Count<2) or (FCustomForm=nil) or (AControl is TCustomForm)
   or (not IsSelected(AControl)) then exit;
@@ -625,8 +634,8 @@ begin
   ALeft:=AControlOrigin.X-DCOrigin.X;
   ATop:=AControlOrigin.Y-DCOrigin.Y;
   SaveIndex := SaveDC(DC);
-  OldFormHandle:=FCustomForm.Canvas.Handle;
+//  OldFormHandle:=FCustomForm.Canvas.Handle;
-  FCustomForm.Canvas.Handle:=DC;
+  FCanvas.Handle:=DC;
 {
 writeln('DrawMarker A ',FCustomForm.Name
     ,' Control=',AControl.Name,',',AControlOrigin.X,',',AControlOrigin.Y
@@ -634,7 +643,7 @@ writeln('DrawMarker A ',FCustomForm.Name
     ,' DC=',Hexstr(FCustomForm.Canvas.Handle,8),' ',HexStr(Cardinal(Pointer(FCustomForm)),8)
     );
 }
-  with FCustomForm.Canvas do begin
+  with FCanvas do begin
     OldBrushColor:=Brush.Color;
     Brush.Color:=FMarkerColor;
     FillRect(Rect(ALeft,ATop,ALeft+MarkerSize,ATop+MarkerSize));
@@ -647,13 +656,14 @@ writeln('DrawMarker A ',FCustomForm.Name
                  ,ALeft+AControl.Width,ATop+AControl.Height));
     Brush.Color:=OldbrushColor;
   end;
-  FCustomForm.Canvas.Handle:=OldFormHandle;
+  FCanvas.Handle:=0;
+//  FCustomForm.Canvas.Handle:=OldFormHandle;
   RestoreDC(DC, SaveIndex);
 end;
 
 procedure TControlSelection.DrawRubberband(DC: HDC);
-var OldFormHandle: HDC;
+var FormOrigin, DCOrigin, Diff: TPoint;
-  FormOrigin, DCOrigin, Diff: TPoint;
+  SaveIndex: HDC;
 
   procedure DrawInvertFrameRect(x1,y1,x2,y2:integer);
   var i:integer;
@@ -661,19 +671,19 @@ var OldFormHandle: HDC;
     procedure InvertPixel(x,y:integer);
     //var c:TColor;
     begin
-      //c:=FCustomForm.Canvas.Pixels[x,y];
+      //c:=FCanvas.Pixels[x,y];
       //c:=c xor $ffffff;
-      //FCustomForm.Canvas.Pixels[x,y]:=c;
+      //FCanvas.Pixels[x,y]:=c;
-      FCustomForm.Canvas.MoveTo(Diff.X+x,Diff.Y+y);
+      FCanvas.MoveTo(Diff.X+x,Diff.Y+y);
-      FCustomForm.Canvas.LineTo(Diff.X+x+1,Diff.Y+y);
+      FCanvas.LineTo(Diff.X+x+1,Diff.Y+y);
     end;
 
   var OldPenColor: TColor;
   begin
-    if FCustomForm=nil then exit;
+    if FCanvas=nil then exit;
     if x1>x2 then begin i:=x1; x1:=x2; x2:=i; end;
     if y1>y2 then begin i:=y1; y1:=y2; y2:=i; end;
-    with FCustomForm.Canvas do begin
+    with FCanvas do begin
       OldPenColor:=Brush.Color;
       Pen.Color:=clBlack;
       i:=x1+1;
@@ -699,11 +709,14 @@ begin
   FormOrigin:=FCustomForm.ClientOrigin;
   Diff.X:=FormOrigin.X-DCOrigin.X;
   Diff.Y:=FormOrigin.Y-DCOrigin.Y;
-  OldFormHandle:=FCustomForm.Canvas.Handle;
+//  OldFormHandle:=FCustomForm.Canvas.Handle;
-  FCustomForm.Canvas.Handle:=DC;
+  SaveIndex:=SaveDC(DC);
+  FCanvas.Handle:=DC;
   with FRubberBandBounds do
     DrawInvertFrameRect(Left,Top,Right,Bottom);
-  FCustomForm.Canvas.Handle:=OldFormHandle;
+  FCanvas.Handle:=0;
+  RestoreDC(DC,SaveIndex);
+//  FCustomForm.Canvas.Handle:=OldFormHandle;
 end;
 
 procedure TControlSelection.SelectWithRubberBand(ACustomForm:TCustomForm; 

designer/designer.pp

@@ -53,6 +53,7 @@ type
     FOnPropertiesChanged: TNotifyEvent;
     FOnAddComponent: TOnAddComponent;
     FHasSized: boolean;
+    FGridColor: TColor;
 
     function GetIsControl: Boolean;
     procedure SetIsControl(Value: Boolean);
@@ -127,6 +128,7 @@ begin
   FCustomForm := CustomForm;
   ControlSelection:=AControlSelection;
   FHasSized:=false;
+  FGridColor:=clGray;
 end;
 
 destructor TDesigner.Destroy;
@@ -169,7 +171,9 @@ end;
 function TDesigner.PaintControl(Sender: TControl; Message: TLMPaint):boolean;
 begin
   Result:=true;
+//writeln('***  LM_PAINT A ',Sender.Name,':',Sender.ClassName,' DC=',HexStr(Message.DC,8));
   Sender.Dispatch(Message);
+//writeln('***  LM_PAINT B ',Sender.Name,':',Sender.ClassName,' DC=',HexStr(Message.DC,8));
   if (ControlSelection.IsSelected(Sender)) then begin
     // writeln('***  LM_PAINT ',Sender.Name,':',Sender.ClassName,' DC=',HexStr(Message.DC,8));
     ControlSelection.DrawMarker(Sender,Message.DC);
@@ -349,7 +353,9 @@ Begin
       // selection mode
       if not FHasSized then begin
         ControlSelection.BeginUpdate;
-        if not (ssShift in Shift) then
+        if (not (ssShift in Shift)) 
+        or ((ControlSelection.Count=1) 
+         and (ControlSelection[0].Control is TCustomForm)) then
           ControlSelection.Clear;
         if RubberBandWasActive then begin
           ControlSelection.SelectWithRubberBand(SenderParentForm,ssShift in Shift);
@@ -617,7 +623,7 @@ var
   x,y : integer;
 begin
   with FCustomForm.Canvas do begin
-    Pen.Color := clGray;
+    Pen.Color := FGridColor;
     x := 0;
     while x <= FCustomForm.Width do begin
       y := 0;

designer/jitforms.pp

@@ -124,10 +124,8 @@ begin
 end;
 
 destructor TJITForms.Destroy;
-var a:integer;
 begin
-  for a:=0 to FForms.Count-1 do
+  while FForms.Count>0 do DestroyJITForm(FForms.Count-1);
-    DestroyJITForm(a);
   FForms.Free;
   inherited Destroy;
 end;
@@ -161,6 +159,7 @@ begin
   OldClass:=Items[Index].ClassType;
   Items[Index].Free;
   FreevmtCopy(OldClass);
+  FForms.Delete(Index);
 end;
 
 function TJITForms.FindFormByClassName(AClassName:shortstring):integer;
@@ -197,22 +196,18 @@ var
 begin
   Result:=-1;
   // create new class and an instance
-writeln('[TJITForms.DoCreateJITForm] Creating new JIT class '''+NewClassName+''' ...');
+//writeln('[TJITForms.DoCreateJITForm] Creating new JIT class '''+NewClassName+''' ...');
   Pointer(FCurReadClass):=CreatevmtCopy(TJITForm,'TJITForm');
-writeln('[TJITForms.DoCreateJITForm] Creating an instance of JIT class '''+NewClassName+''' ...');
+//writeln('[TJITForms.DoCreateJITForm] Creating an instance of JIT class '''+NewClassName+''' ...');
   Instance:=TComponent(FCurReadClass.NewInstance);
-writeln('[TJITForms.DoCreateJITForm] Initializing new instance ...');
+//writeln('[TJITForms.DoCreateJITForm] Initializing new instance ...');
   TComponent(FCurReadForm):=Instance;
   try
     Instance.Create(nil);
-    Writeln('----------------------------------');
-    Writeln('New form name is '+NewFormName);
-    Writeln('----------------------------------');
-    Writeln('----------------------------------');
     if NewFormName<>'' then
       Instance.Name:=NewFormName;
     DoRenameClass(FCurReadClass,NewClassName);
-writeln('[TJITForms.DoCreateJITForm] Initialization was successful!');
+//writeln('[TJITForms.DoCreateJITForm] Initialization was successful!');
   except
     TComponent(FCurReadForm):=nil;
     writeln('[TJITForms.DoCreateJITForm] Error while creating instance');

ide/customformeditor.pp

@@ -24,7 +24,8 @@ unit CustomFormEditor;
 interface
 
 uses
-  classes, abstractformeditor, controls,propedits,Typinfo,ObjectInspector,forms,IDEComp;
+  Classes, AbstractFormeditor, Controls, PropEdits, TypInfo, ObjectInspector ,
+  Forms, IDEComp, JITForms;
 
 Const OrdinalTypes = [tkInteger,tkChar,tkENumeration,tkbool];
 
@@ -94,6 +95,7 @@ TCustomFormEditor
     FComponentInterfaceList : TList; //used to track and find controls
     FSelectedComponents : TComponentSelectionList;
     FObj_Inspector : TObjectInspector;
+    JITFormList : TJITForms;
   protected
     Procedure RemoveFromComponentInterfaceList(Value :TIComponentInterface);
     procedure SetSelectedComponents(TheSelectedComponents : TComponentSelectionList);
@@ -123,10 +125,7 @@ TCustomFormEditor
 implementation
 
 uses
-  SysUtils, JITForms;
+  SysUtils;
-
-var
-  JITFormList : TJITForms;
 
 {TComponentInterface}
 

ide/main.pp

@@ -634,6 +634,7 @@ begin
     Project:=nil;
   end;
   TheControlSelection.Free;
+  FormEditor1.Free;
   MacroList.Free;
   EnvironmentOptions.Free;
   EnvironmentOptions:=nil;
@@ -2889,6 +2890,9 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.76  2001/03/20 16:59:14  lazarus
+  MG: fixed many bugs (mem leaks, canvas)
+
   Revision 1.75  2001/03/19 14:00:46  lazarus
   MG: fixed many unreleased DC and GDIObj bugs
 

ide/splash.pp

@@ -329,7 +329,9 @@ end;
 destructor TSplashForm.Destroy;
 begin
   FBitmap.Free;
+  FBitmap:=nil;
   FTimer.Free;
+  FTimer:=nil;
   inherited Destroy;
 end;
 
@@ -353,7 +355,8 @@ procedure TSplashForm.Paint;
 begin
   inherited Paint;
   if FBitmap <>nil 
-  then Canvas.Copyrect(Bounds(0, 0, Width, Height), FBitmap.Canvas, Rect(0,0, Width, Height));
+  then Canvas.Copyrect(Bounds(0, 0, Width, Height)
+     ,FBitmap.Canvas, Rect(0,0, Width, Height));
 end;
 
 procedure TSplashForm.StartTimer;
@@ -366,6 +369,9 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.4  2001/03/20 16:59:15  lazarus
+  MG: fixed many bugs (mem leaks, canvas)
+
   Revision 1.3  2001/03/19 14:00:47  lazarus
   MG: fixed many unreleased DC and GDIObj bugs
 

lcl/graphics.pp

@@ -413,8 +413,11 @@ type
     FAutoReDraw : Boolean;
     FState: TCanvasState;
     FFont : TFont;
+    FSavedFontHandle: HFont;
     FPen: TPen;
+    FSavedPenHandle: HPen;
     FBrush: TBrush;
+    FSavedBrushHandle: HBrush;
     FPenPos : TPoint;
     FCopyMode : TCopyMode;
     FHandle : HDC;
@@ -425,6 +428,7 @@ type
     procedure CreateBrush;
     procedure CreateFont;
     Procedure CreatePen;
+    procedure DeselectHandles;
     function GetCanvasClipRect: TRect;
     Function GetColor: TColor;
     function GetHandle : HDC;
@@ -435,6 +439,7 @@ type
     Procedure SetColor(c: TColor);
     Procedure SetBrush(value : TBrush);
     Procedure SetFont(value : TFont);
+    procedure SetHandle(NewHandle: HDC);
     Procedure SetPen(value : TPen);
     Procedure SetPenPos(Value : TPoint);
     Procedure SetPixel(X,Y : Integer; Value : TColor);
@@ -464,7 +469,7 @@ type
     property OnChange : TNotifyEvent read FOnChange write FOnChange;
     property OnChanging: TNotifyEvent read FOnChanging write FOnChanging;
     property Pixels[X, Y: Integer]: TCOlor read GetPixel write SetPixel;
-    property Handle: HDC read GetHandle write FHandle;
+    property Handle: HDC read GetHandle write SetHandle;
   published
     property AutoRedraw : Boolean read FAutoReDraw write SetAutoReDraw;
     property Brush: TBrush read FBrush write SetBrush;
@@ -645,6 +650,9 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.8  2001/03/20 16:59:15  lazarus
+  MG: fixed many bugs (mem leaks, canvas)
+
   Revision 1.7  2001/03/19 14:00:50  lazarus
   MG: fixed many unreleased DC and GDIObj bugs
 

lcl/include/canvas.inc

@@ -99,8 +99,11 @@ end;
 procedure TCanvas.CreateBrush;
 var OldHandle: HBRUSH;
 begin
+//writeln('[TCanvas.CreateBrush] ',Classname,'  Self=',HexStr(Cardinal(Pointer(Self)),8)
+// ,'  Brush=',HexStr(Cardinal(Pointer(Brush)),8));
   OldHandle:=SelectObject(FHandle, Brush.Handle);
-  if OldHandle<>Brush.Handle then LCLLinux.DeleteObject(OldHandle);
+  if OldHandle<>Brush.Handle then FSavedBrushHandle:=OldHandle;
+  Include(FState, csBrushValid);
 //  SetBkColor(FHandle, not ColorToRGB(Brush.Color));
 //  SetBkMode(FHandle, TRANSPARENT);
 end;
@@ -115,7 +118,8 @@ procedure TCanvas.CreatePen;
 var OldHandle: HPEN;
 begin
   OldHandle:=SelectObject(FHandle, Pen.Handle);
-  if OldHandle<>Pen.Handle then LCLLinux.DeleteObject(OldHandle);
+  if OldHandle<>Pen.Handle then FSavedPenHandle:=OldHandle;
+  Include(FState, csPenValid);
 //  SetROP2(FHandle, PenModes[Pen.Mode]);
 end;
 
@@ -129,7 +133,8 @@ procedure TCanvas.CreateFont;
 var OldHandle: HPEN;
 begin
   OldHandle:=SelectObject(FHandle, Font.Handle);
-  if OldHandle<>Font.Handle then LCLLinux.DeleteObject(OldHandle);
+  if OldHandle<>Font.Handle then FSavedFontHandle:=OldHandle;
+  Include(FState, csFontValid);
   SetTextColor(FHandle, ColorToRGB(Font.Color));
 end;
 
@@ -280,7 +285,7 @@ end;
 Procedure TCanvas.MoveTo(X1, Y1 : Integer);
 begin
   RequiredState([csHandleValid]);
-  if LCLLinux.MoveToEx(Handle, X1, Y1, nil) then FPenPos:= Point(X1, Y1);
+  if LCLLinux.MoveToEx(FHandle, X1, Y1, nil) then FPenPos:= Point(X1, Y1);
 End;
 
 {------------------------------------------------------------------------------
@@ -292,7 +297,7 @@ End;
 procedure TCanvas.LineTo(X1, Y1 : Integer);
 begin
   RequiredState([csHandleValid, csPenValid]);
-  if LCLLinux.LineTo(Handle, X1, Y1) then FPenPos:= Point(X1, Y1);
+  if LCLLinux.LineTo(FHandle, X1, Y1) then FPenPos:= Point(X1, Y1);
 end;
 
 
@@ -394,10 +399,13 @@ begin
   inherited Create;
   FFont := TFont.Create;
   FFont.OnChange := @FontChanged;
+  FSavedFontHandle := 0;
   FPen := TPen.Create;
   FPen.OnChange := @PenChanged;
+  FSavedPenHandle := 0;
   FBrush := TBrush.Create;
   FBrush.OnChange := @BrushChanged;
+  FSavedBrushHandle := 0;
   FCopyMode := cmSrcCopy;
   FPenPos := Point(0, 0);
 end;
@@ -411,6 +419,7 @@ end;
  ------------------------------------------------------------------------------}
 destructor TCanvas.Destroy;
 begin
+//writeln('[TCanvas.Destroy] ',ClassName,'  Self=',HexStr(Cardinal(Pointer(Self)),8));
   Handle := 0;
   FFont.Free;
   FPen.Free;
@@ -431,6 +440,62 @@ begin
   Result := FHandle;
 end;
 
+{------------------------------------------------------------------------------
+  Method:  TCanvas.SetHandle
+  Params:  NewHandle - the new device context
+  Returns: nothing
+
+  Deselect sub handles and sets the Handle
+ ------------------------------------------------------------------------------}
+procedure TCanvas.SetHandle(NewHandle: HDC);
+begin
+  if FHandle<>NewHandle then begin
+//writeln('[TCanvas.SetHandle] Old=',HexStr(FHandle,8),' New=',HexStr(NewHandle,8));
+    if FHandle <> 0 then
+    begin
+      DeselectHandles;
+      FPenPos := GetPenPos;
+      FHandle := 0;
+      Exclude(FState, csHandleValid);
+    end;
+    if NewHandle <> 0 then
+    begin
+      Include(FState, csHandleValid);
+      FHandle := NewHandle;
+      SetPenPos(FPenPos);
+    end;
+//writeln('[TCanvas.SetHandle] END Handle=',HexStr(FHandle,8));
+  end;
+end;
+
+{------------------------------------------------------------------------------
+  Method:  TCanvas.DeselectHandles
+  Params:  none
+  Returns: nothing
+
+  Deselect all subhandles in the current device context
+ ------------------------------------------------------------------------------}
+procedure TCanvas.DeselectHandles;
+begin
+  if (FHandle<>0) 
+  and (FState - [csPenValid, csBrushValid, csFontValid] <> FState) then begin
+    // select default sub handles in the device context without deleting owns
+    if FSavedBrushHandle<>0 then begin
+      SelectObject(FHandle,FSavedBrushHandle);
+      FSavedBrushHandle:=0;
+    end;
+    if FSavedPenHandle<>0 then begin
+      SelectObject(FHandle,FSavedPenHandle);
+      FSavedPenHandle:=0;
+    end;
+    if FSavedFontHandle<>0 then begin
+      SelectObject(FHandle,FSavedFontHandle);
+      FSavedFontHandle:=0;
+    end;
+    FState := FState - [csPenValid, csBrushValid, csFontValid];
+  end;
+end;
+
 {------------------------------------------------------------------------------
   Method:  TCanvas.CreateHandle
   Params:  None
@@ -462,6 +527,7 @@ begin
       CreateHandle;
       if FHandle = 0
       then raise EInvalidOperation.Create('Canvas does not allow drawing');
+      Include(FState, csHandleValid);
     end;
     if csFontValid in Needed then CreateFont;
     if csPenValid in Needed then
@@ -471,7 +537,6 @@ begin
       then Include(Needed, csBrushValid);
     end;
     if csBrushValid in Needed then CreateBrush;
-    FState := FState + Needed;
   end;
 end;
 
@@ -526,6 +591,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.5  2001/03/20 16:59:15  lazarus
+  MG: fixed many bugs (mem leaks, canvas)
+
   Revision 1.4  2001/03/19 14:00:50  lazarus
   MG: fixed many unreleased DC and GDIObj bugs
 

lcl/include/customform.inc

@@ -66,9 +66,15 @@ end;
  ------------------------------------------------------------------------------}
 destructor TCustomForm.Destroy;
 begin
+//writeln('[TCustomForm.Destroy] A ',Name,':',ClassName);
   Assert(False, Format('Trace: [TCustomForm.Destroy] %s', [ClassName]));
   FMenu.Free;
+  FMenu:=nil;
+  FCanvas.Free;
+  FCanvas:=nil;
+//writeln('[TCustomForm.Destroy] B ',Name,':',ClassName);
   inherited Destroy;
+//writeln('[TCustomForm.Destroy] END ',Name,':',ClassName);
 end;
 
 {------------------------------------------------------------------------------
@@ -164,7 +170,7 @@ end;
   Params:   Msg: When the form is Activated
   Returns:  nothing
 
-  Paint event handler.
+  Activate event handler.
  ------------------------------------------------------------------------------}
 Procedure TCustomForm.WMActivate(var Message : TLMActivate);
 Begin
@@ -182,6 +188,7 @@ end;
  ------------------------------------------------------------------------------}
 procedure TCustomForm.WMPaint(var Message: TLMPaint);
 begin
+//writeln('[TCustomForm.WMPaint] ',Name,':',ClassName);
   Assert(False, Format('Trace: [TCustomForm.LMPaint] %s', [ClassName]));
   
   Include(FControlState, csCustomPaint);
@@ -191,6 +198,7 @@ begin
   finally
     Exclude(FControlState, csCustomPaint);
   end;
+//writeln('[TCustomForm.WMPaint] END ',Name,':',ClassName);
 end;                          
 
 
@@ -199,7 +207,7 @@ end;
   Params:   Msg: The Size message
   Returns:  nothing
 
-  Paint event handler.
+  Resize event handler.
  ------------------------------------------------------------------------------}
 procedure TCustomForm.WMSize(var Message: TLMSize);
 Begin
@@ -285,8 +293,10 @@ end;
 Function TCustomForm.GetClientRect :TRect;
 Begin
   SetRect(Result,0,0,0,0);
-AdjustWindowRectEx(Result,GetWindowLong(Handle,GWL_STYLE),Menu <> nil,GetWIndowLong(Handle,GWL_EXSTYLE));
+  AdjustWindowRectEx(Result,GetWindowLong(Handle,GWL_STYLE),Menu <> nil
-SetRect(Result,0,0, Width - Result.Right + Result.Left, Height - Result.Bottom + Result.Top);
+      ,GetWIndowLong(Handle,GWL_EXSTYLE));
+  SetRect(Result,0,0, Width - Result.Right + Result.Left
+      , Height - Result.Bottom + Result.Top);
 end;
 
 
@@ -314,16 +324,15 @@ begin
 //  FCanvas.Lock;
   try
     FCanvas.Handle := DC;
+//writeln('[TCustomForm.PaintWindow] ',ClassName,' DC=',HexStr(DC,8),'  ',HexStr(FCanvas.Handle,8));
     try
       if FDesigner <> nil then FDesigner.PaintGrid else Paint;
     finally
       FCanvas.Handle := 0;
     end;
-
   finally
 //    FCanvas.Unlock;
   end;
-
 end;
 
 
@@ -470,7 +479,6 @@ riteln('[TCustomForm.WndPRoc] 1');
                     Integer(itemWidth), Integer(itemHeight));
                 finally
                   Handle := 0;
-writeln('[TCustomForm.WndPRoc] 2');
                   RestoreDC(DC, SaveIndex);
                 end;
               finally
@@ -573,13 +581,11 @@ begin
     begin
       Include(FFormState, fsCreating);
       try
-       // *** New
         if not InitResourceComponent(Self, TForm) then begin
           writeln('[TCustomForm.Create] Resource '''+ClassName+''' not found');
           Writeln('This is for information purposes only.   This is not critical at this time.');
 
         end;
-        // ***
       finally
         Exclude(FFormState, fsCreating);
       end;
@@ -623,7 +629,6 @@ fCompStyle:= csForm;
 //  FPrintScale := poProportional;
 //  FloatingDockSiteClass := TWinControlClass(ClassType);
   Screen.AddForm(Self);
-
 End;
 
 {------------------------------------------------------------------------------}
@@ -854,6 +859,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.16  2001/03/20 16:59:15  lazarus
+  MG: fixed many bugs (mem leaks, canvas)
+
   Revision 1.15  2001/03/19 14:41:56  lazarus
   MG: fixed many unreleased DC and GDIObj bugs
 

lcl/include/form.inc

@@ -4,7 +4,6 @@
 destructor TForm.destroy;
 begin
   Assert(False, 'Trace:Destroying signals for TForm');
-  FCanvas.Free;
   inherited Destroy;
 end;
 

lcl/include/wincontrol.inc

@@ -489,7 +489,7 @@ var
   DC: HDC;
   PS: TPaintStruct; //defined in LCLLinux.pp
 begin
-
+//writeln('[TWinControl.PaintHandler] ',Name,':',ClassName,'  DC=',HexStr(Message.DC,8));
   Assert(False, Format('Trace:> [TWinControl.PaintHandler] %s --> Msg.DC: 0x%x', [ClassName, Message.DC]));
   DC := Message.DC;
   if DC = 0 then DC := BeginPaint(Handle, PS);
@@ -515,15 +515,16 @@ begin
     if Message.DC = 0 then EndPaint(Handle, PS);
   end;
   Assert(False, Format('Trace:< [TWinControl.PaintHandler] %s', [ClassName]));
+//writeln('[TWinControl.PaintHandler] END  ',Name,':',ClassName,'  DC=',HexStr(Message.DC,8));
 end;
 
-
 procedure TWinControl.PaintControls(DC: HDC; First: TControl);
 var
   I, Count, SaveIndex: Integer;
   FrameBrush: HBRUSH;
   TempControl : TCOntrol;
 begin
+//writeln('[TWinControl.PaintControls] ',Name,':',ClassName,'  DC=',HexStr(DC,8));
   if FControls <> nil then
   begin
     I := 0;
@@ -571,12 +572,14 @@ begin
           DeleteObject(FrameBrush);
           }
         end;
+//writeln('[TWinControl.PaintControls] END ',Name,':',ClassName,'  DC=',HexStr(DC,8));
 end;
 
 procedure TWinControl.PaintWindow(DC: HDC);
 var
   Message: TLMessage;
 begin
+//writeln('[TWinControl.PaintWindow] ',Name,':',Classname,'  DC=',HexStr(DC,8));
   Message.Msg := LM_PAINT;
   Message.WParam := DC;
   Message.LParam := 0;
@@ -1241,7 +1244,7 @@ var
   n: Integer;
   Control: TControl;
 begin
-//writeln('[TWinControl.Destroy] 1  ',Name,':',ClassName);
+//writeln('[TWinControl.Destroy] A  ',Name,':',ClassName);
   DestroyHandle; 
 
   n := ControlCount;
@@ -1938,6 +1941,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.25  2001/03/20 16:59:15  lazarus
+  MG: fixed many bugs (mem leaks, canvas)
+
   Revision 1.24  2001/03/19 14:38:39  lazarus
   MG: fixed many unreleased DC and GDIObj bugs
 

lcl/interfaces/gtk/gtkwinapi.inc

@@ -265,7 +265,8 @@ end;
 
 
  ------------------------------------------------------------------------------}
-function TgtkObject.CreateBitmap(Width, Height: Integer; Planes, BitCount: Longint; BitmapBits: Pointer): HBITMAP;
+function TgtkObject.CreateBitmap(Width, Height: Integer;
+  Planes, BitCount: Longint; BitmapBits: Pointer): HBITMAP;
 var
   GdiObject: PGdiObject;
   RawImage: PGDIRawImage;
@@ -279,6 +280,7 @@ begin
     Exit;
   end;
   
+//write('TgtkObject.CreateBitmap->');
   GdiObject := NewGDIObject(gdiBitmap);
   
   // if the bitcount is the system depth create a Pixmap
@@ -331,6 +333,8 @@ begin
   Assert(False, Format('Trace:> [TgtkObject.CreateBrushIndirect]  Style: %d, Color: %8x', [LogBrush.lbStyle, LogBrush.lbColor]));
 
   sError := '';
+
+//write('CreateBrushIndirect->');
   GObject := NewGDIObject(gdiBrush);
 
   with LogBrush do
@@ -625,6 +629,7 @@ begin
     CharSetCoding := '*';
   end;
 
+//write('CreateFontIndirect->');
   GDIObject := NewGDIObject(gdiFont);
   LoadFont;
   if GdiObject^.GDIFontObject = nil
@@ -675,8 +680,7 @@ begin
 
   if GdiObject^.GDIFontObject = nil
   then begin
-writeln('[TgtkObject.CreateFontIndirect] ',HexStr(Cardinal(GdiObject),8)
+//writeln('[TgtkObject.CreateFontIndirect] ',HexStr(Cardinal(GdiObject),8),'  ',FGDIObjects.Count);
-,'  ',FGDIObjects.Count);
     FGDIObjects.Remove(GdiObject);
     Dispose(GdiObject);
     Result := 0;
@@ -703,6 +707,7 @@ var
   GObject: PGdiObject;
 begin
   Assert(False, 'trace:[TgtkObject.CreatePenIndirect]');
+//write('CreatePenIndirect->');
   GObject := NewGDIObject(gdiPen);
 
   with LogPen do
@@ -736,6 +741,7 @@ var
   GDKColor: TGDKCOlor;
   P: Pointer;
 begin
+//write('TgtkObject.CreatePixmapIndirect->');
   GdiObject := NewGDIObject(gdiBitmap); 
   if TransColor >= 0 
   then begin
@@ -1366,6 +1372,7 @@ begin
   then begin
     if Values.Font <> nil
     then begin
+//write('GetDC->');
       GdiObject:=NewGDIObject(gdiFont);
       GdiObject^.GDIFontObject := Values.Font;
       gdk_font_ref(Values.Font);
@@ -2077,7 +2084,7 @@ var
   Widget: PGTKWidget;
   Sender : TObject;
 begin
-Writeln('GetWindowRect');
+//Writeln('GetWindowRect');
   result := 0; //default
   if Handle <> 0 then
   begin
@@ -2096,7 +2103,7 @@ Writeln('GetWindowRect');
           sender := TObject(Gtk_Object_Get_Data(pGTKObject(widget),'Sender'));
           if (sender is TControl) then
                begin
-                 writeln('****************SENDCER IS TCONTROL********************');
+                 writeln('****************SENDER IS TCONTROL********************');
                  X := TControl(sender).Left;
                  Y := TControl(sender).Top;
                  W := TControl(sender).Width;
@@ -2570,11 +2577,10 @@ begin
 
     // TODO copy bitmap also 
       
+    Result := CopyDCData(pDC, pSavedDC);
     pDC^.SavedContext := pSavedDC^.SavedContext;
     pSavedDC^.SavedContext := nil;
 
-    Result := CopyDCData(pSavedDC, pDC);
-
     //prevent deleting of copied objects;
     if pSavedDC^.CurrentBitmap = pDC^.CurrentBitmap 
     then pSavedDC^.CurrentBitmap := nil;  
@@ -3387,6 +3393,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.27  2001/03/20 16:59:15  lazarus
+  MG: fixed many bugs (mem leaks, canvas)
+
   Revision 1.26  2001/03/19 18:51:57  lazarus
   MG: added dynhasharray and renamed tsynautocompletion