try: gdi memory leak fix for pen

git-svn-id: trunk@4875 -

lcl/graphics.pp

@@ -281,13 +281,16 @@ type
 
   TGraphicsObject = class(TPersistent)
   private
+    FOnChanging: TNotifyEvent;
     FOnChange: TNotifyEvent;
     Procedure DoChange(var msg); message LM_CHANGED;
   protected
+    procedure Changing; dynamic;
     procedure Changed; dynamic;
     Procedure Lock;
     Procedure UnLock;
   public
+    property OnChanging: TNotifyEvent read FOnChanging write FOnChanging;
     property OnChange: TNotifyEvent read FOnChange write FOnChange;
   end;
 
@@ -665,6 +668,8 @@ type
     FLockCount: Integer;
     procedure BrushChanged(ABrush: TObject);
     procedure FontChanged(AFont: TObject);
+    procedure PenChanging(APen: TObject);
+    procedure PenChanged(APen: TObject);
     procedure RegionChanged(ARegion: TObject);
     procedure DeselectHandles;
     function GetCanvasClipRect: TRect;
@@ -672,7 +677,6 @@ type
     function GetHandle : HDC;
     Function GetPenPos: TPoint;
     Function GetPixel(X,Y : Integer) : TColor;
-    procedure PenChanged(APen: TObject);
     Procedure SetAutoReDraw(Value : Boolean);
     Procedure SetColor(c: TColor);
     Procedure SetBrush(value : TBrush);
@@ -1253,6 +1257,9 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.100  2003/12/02 12:25:17  micha
+  try: gdi memory leak fix for pen
+
   Revision 1.99  2003/11/26 21:30:19  mattias
   reduced unit circles, fixed fpImage streaming
 

lcl/include/canvas.inc

@@ -910,6 +910,23 @@ begin
   end;
 end;
 
+{------------------------------------------------------------------------------
+  Method:   TCanvas.PenChanging
+  Params:   APen: The changing pen
+  Returns:  Nothing
+
+  Notify proc for a pen change
+ ------------------------------------------------------------------------------}
+procedure TCanvas.PenChanging(APen: TObject);
+begin
+  if [csPenValid, csHandleValid] * FState = [csPenValid, csHandleValid] then
+  begin
+    Exclude(FState, csPenValid);
+    SelectObject(FHandle, FSavedPenHandle);
+    FSavedPenHandle := 0;
+  end;
+end;
+
 {------------------------------------------------------------------------------
   Method:   TCanvas.PenChanged
   Params:   APen: The changed pen
@@ -955,6 +972,7 @@ begin
   FFont.OnChange := @FontChanged;
   FSavedFontHandle := 0;
   FPen := TPen.Create;
+  FPen.OnChanging := @PenChanging;
   FPen.OnChange := @PenChanged;
   FSavedPenHandle := 0;
   FBrush := TBrush.Create;
@@ -1236,6 +1254,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.56  2003/12/02 12:25:17  micha
+  try: gdi memory leak fix for pen
+
   Revision 1.55  2003/11/22 17:22:15  mattias
   moved TBevelCut to controls.pp
 

lcl/include/graphicsobject.inc

@@ -21,6 +21,12 @@ begin
   Changed;
 end;
 
+procedure TGraphicsObject.Changing;
+begin
+  Assert(False, Format('Trace:[TgraphicsObject.Changed] %s', [ClassName]));
+  if Assigned(FOnChanging) then FOnChanging(Self);
+end;
+
 procedure TGraphicsObject.Changed;
 begin
   Assert(False, Format('Trace:[TgraphicsObject.Changed] %s', [ClassName]));
@@ -40,6 +46,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.4  2003/12/02 12:25:17  micha
+  try: gdi memory leak fix for pen
+
   Revision 1.3  2002/09/30 14:01:06  lazarus
   MG: undid the TBinaryObjectWriter Buffersize
 

lcl/include/pen.inc

@@ -191,7 +191,8 @@ procedure TPen.FreeHandle;
 begin
   if FPenData.Handle <> 0
   then begin
-    //TODO: what if a pen is currently selected
+    // Changing triggers deselecting the current handle
+    Changing;
     DeleteObject(FPenData.Handle);
     FPenData.Handle := 0;
   end;
@@ -200,6 +201,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.6  2003/12/02 12:25:17  micha
+  try: gdi memory leak fix for pen
+
   Revision 1.5  2002/08/18 04:57:01  mattias
   fixed csDashDot