fixed unselecting TCanvas objects

git-svn-id: trunk@6096 -

lcl/graphics.pp

@@ -112,8 +112,10 @@ type
 
   TCopymode = longint;
 
-  TCanvasStates = (csHandleValid, csFontValid, csPenvalid, csBrushValid,
+  TCanvasStates = (csHandleValid,
-                   csRegionValid);
+                   csFontValid, // true if Font properties correspond to
+                                // selected Font Handle in DC
+                   csPenvalid, csBrushValid, csRegionValid);
   TCanvasState = set of TCanvasStates;
   TCanvasOrientation = (csLefttoRight, coRighttoLeft);
 
@@ -1317,9 +1319,10 @@ type
     FOldBitmap: HBitmap;
     FOldPaletteValid: boolean;
     FOldPalette: HPALETTE;
-    procedure FreeDC;
+    procedure FreeDC; // called by TBitmap.FreeCanvasContext
   protected
     procedure CreateHandle; override;
+    procedure DeselectHandles; override;
   public
     constructor Create(ABitmap: TBitmap);
     destructor Destroy; override;
@@ -1778,6 +1781,9 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.157  2004/10/01 13:16:43  mattias
+  fixed unselecting TCanvas objects
+
   Revision 1.156  2004/09/29 15:18:26  mattias
   fixed TBitmap.Canvas.Frame3d
 

lcl/include/bitmapcanvas.inc

@@ -67,6 +67,23 @@ begin
   //  ' Handle=',HexStr(Cardinal(GetUpdatedHandle([csHandleValid])),8));
 end;
 
+procedure TBitmapCanvas.DeselectHandles;
+begin
+  if HandleAllocated then begin
+    if FOldBitmapValid then begin
+      SelectObject(FHandle, FOldBitmap);
+      FOldBitmap:=0;
+      FOldBitmapValid:=false;
+    end;
+    if FOldPaletteValid then begin
+      SelectPalette(FHandle, FOldPalette, True);
+      FOldPalette:=0;
+      FOldPaletteValid:=false;
+    end;
+  end;
+  inherited DeselectHandles;
+end;
+
 {------------------------------------------------------------------------------
   Method: TBitmapCanvas.Destroy
   Params:  None
@@ -94,16 +111,6 @@ begin
   if not HandleAllocated then exit;
   //DebugLn('TBitmapCanvas.FreeDC START Self=',HexStr(Cardinal(Self),8),' FBitmap=',HexStr(Cardinal(FBitmap),8));
   if FBitmap<>nil then begin
-    if FOldBitmapValid then begin
-      SelectObject(FHandle, FOldBitmap);
-      FOldBitmap:=0;
-      FOldBitmapValid:=false;
-    end;
-    if FOldPaletteValid then begin
-      SelectPalette(FHandle, FOldPalette, True);
-      FOldPalette:=0;
-      FOldPaletteValid:=false;
-    end;
     OldHandle := FHandle;
     Handle := 0;
     DeleteDC(OldHandle);
@@ -117,6 +124,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.13  2004/10/01 13:16:44  mattias
+  fixed unselecting TCanvas objects
+
   Revision 1.12  2004/05/11 12:16:47  mattias
   replaced writeln by debugln
 

lcl/include/brush.inc

@@ -124,7 +124,7 @@ end;
 
   Copies the source brush to itself
  ------------------------------------------------------------------------------}
-Procedure TBrush.Assign(Source : Tpersistent);
+Procedure TBrush.Assign(Source: TPersistent);
 begin
   if Source is TBrush
   then begin
@@ -214,7 +214,6 @@ procedure TBrush.FreeHandle;
 begin
   if FBrushData.Handle <> 0
   then begin
-    //TODO: what if a brush is currently selected
     if FBrushHandleCached then begin
       BrushResourceCache.FindItem(FBrushData.Handle).DecreaseRefCount;
       FBrushHandleCached:=false;
@@ -227,6 +226,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.11  2004/10/01 13:16:44  mattias
+  fixed unselecting TCanvas objects
+
   Revision 1.10  2004/08/11 22:05:07  mattias
   fixed brush handle cache size
 

lcl/include/canvas.inc

@@ -125,9 +125,10 @@ end;
 procedure TCanvas.CreateBrush;
 var OldHandle: HBRUSH;
 begin
-//DebugLn('[TCanvas.CreateBrush] ',Classname,'  Self=',HexStr(Cardinal(Pointer(Self)),8)
+//DebugLn('[TCanvas.CreateBrush] ',Classname,'  Self=',HexStr(Cardinal(Self),8)
 // ,'  Brush=',HexStr(Cardinal(Pointer(Brush)),8));
   OldHandle:=SelectObject(FHandle, Brush.Handle);
+  //debugln('TCanvas.CreateBrush ',ClassName,' Self=',HexStr(Cardinal(Self),8),' OldHandle=',HexStr(Cardinal(OldHandle),8),' NewHandle=',HexStr(Cardinal(Brush.Handle),8),' FSavedBrushHandle=',HexStr(Cardinal(FSavedBrushHandle),8));
   if (OldHandle<>Brush.Handle) and (FSavedBrushHandle=0) then
     FSavedBrushHandle:=OldHandle;
   Include(FState, csBrushValid);
@@ -608,7 +609,7 @@ procedure TCanvas.Frame3d(var ARect: TRect; const FrameWidth : integer;
   const Style : TGraphicsBevelCut);
 begin
   Changing;
-  RequiredState([csHandleValid]);
+  RequiredState([csHandleValid,csBrushValid,csPenValid]);
   LCLIntf.Frame3d(FHandle, ARect, FrameWidth, Style);
   Changed;
 end;
@@ -1090,7 +1091,7 @@ end;
 procedure TCanvas.SetHandle(NewHandle: HDC);
 begin
   if FHandle<>NewHandle then begin
-    //DebugLn('[TCanvas.SetHandle] Old=',HexStr(FHandle,8),' New=',HexStr(NewHandle,8));
+    //DebugLn('[TCanvas.SetHandle] Self=',HexStr(Cardinal(Self),8),' Old=',HexStr(FHandle,8),' New=',HexStr(NewHandle,8));
     if FHandle <> 0 then
     begin
       DeselectHandles;
@@ -1103,7 +1104,7 @@ begin
       Include(FState, csHandleValid);
       FHandle := NewHandle;
     end;
-    //DebugLn('[TCanvas.SetHandle] END Handle=',HexStr(FHandle,8));
+    //DebugLn('[TCanvas.SetHandle] END Self=',HexStr(Cardinal(Self),8),' Handle=',HexStr(FHandle,8));
   end;
 end;
 
@@ -1116,8 +1117,8 @@ end;
  ------------------------------------------------------------------------------}
 procedure TCanvas.DeselectHandles;
 begin
-  if (FHandle<>0)
+  //debugln('TCanvas.DeselectHandles ',ClassName,' Self=',HexStr(Cardinal(Self),8),' Handle=',HexStr(Cardinal(FHandle),8),' FSavedBrushHandle=',HexStr(Cardinal(FSavedBrushHandle),8));
-  and (FState * [csPenValid, csBrushValid, csFontValid] <> []) then begin
+  if (FHandle<>0) then begin
     // select default sub handles in the device context without deleting owns
     if FSavedBrushHandle<>0 then begin
       SelectObject(FHandle,FSavedBrushHandle);
@@ -1264,6 +1265,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.83  2004/10/01 13:16:44  mattias
+  fixed unselecting TCanvas objects
+
   Revision 1.82  2004/09/29 15:18:27  mattias
   fixed TBitmap.Canvas.Frame3d
 

lcl/interfaces/gtk/gtkobject.inc

@@ -6256,8 +6256,11 @@ end;
  ------------------------------------------------------------------------------}
 function TGtkWidgetSet.CreateDefaultBrush: PGdiObject;
 begin
-//write('  TGtkWidgetSet.CreateDefaultBrush ->');
+//debugln('  TGtkWidgetSet.CreateDefaultBrush ->');
   Result := NewGDIObject(gdiBrush);
+  {$IFDEF DebugGDIBrush}
+  debugln('TGtkWidgetSet.CreateDefaultBrush Created: ',HexStr(Cardinal(Result),8));
+  {$ENDIF}
   Result^.GDIBrushFill := GDK_SOLID;
   Result^.GDIBrushColor.ColorRef := 0;
   Result^.GDIBrushColor.Colormap := gdk_colormap_get_system;
@@ -6941,6 +6944,9 @@ end;
  { =============================================================================
 
   $Log$
+  Revision 1.605  2004/10/01 13:16:44  mattias
+  fixed unselecting TCanvas objects
+
   Revision 1.604  2004/09/25 15:05:38  mattias
   implemented Rename Identifier
 

lcl/interfaces/gtk/gtkwinapi.inc

@@ -1031,7 +1031,9 @@ begin
   //write('CreateBrushIndirect->');
   GObject := NewGDIObject(gdiBrush);
   try
-    //DebugLn('[TGtkWidgetSet.CreateBrushIndirect] ',HexStr(Cardinal(GObject),8));
+    {$IFDEF DebugGDIBrush}
+    DebugLn('[TGtkWidgetSet.CreateBrushIndirect] ',HexStr(Cardinal(GObject),8));
+    {$ENDIF}
     GObject^.IsNullBrush := False;
     with LogBrush do
     begin
@@ -2097,7 +2099,6 @@ end;
   Params:  none
   Returns: Nothing
 
-
  ------------------------------------------------------------------------------}
 function TGtkWidgetSet.DeleteObject(GDIObject: HGDIOBJ): Boolean;
 
@@ -2137,6 +2138,10 @@ begin
           {$IFDEF DebugGDKTraps}
           BeginGDKErrorTrap;
           {$ENDIF}
+          {$IFDEF DebugGDIBrush}
+          debugln('TGtkWidgetSet.DeleteObject gdiBrush: ',HexStr(Cardinal(GdiObject),8));
+          //if Cardinal(GdiObject)=$404826F4 then RaiseGDBException('');
+          {$ENDIF}
           if (GDIBrushPixmap <> nil)
           then gdk_bitmap_unref(GDIBrushPixmap);
           {$IFDEF DebugGDKTraps}
@@ -8690,6 +8695,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.369  2004/10/01 13:16:44  mattias
+  fixed unselecting TCanvas objects
+
   Revision 1.368  2004/09/29 15:18:27  mattias
   fixed TBitmap.Canvas.Frame3d
 

tools/install/build_fpc_rpm.sh

@@ -50,8 +50,10 @@ TmpDir=/tmp/fpc_patchdir
 if [ "$WithTempDir" = "yes" ]; then
   rm -rf $TmpDir
   mkdir $TmpDir
-  rsync -aq --exclude="*.ppu" --exclude="*.o" --exclude="*.ppw" --exclude="CVS" \
+  rsync -aq --exclude="*.ppu" --exclude="*.o" --exclude="*.ppw" \
-    --exclude="cvslog" $FPCSourceDir $TmpDir
+    --exclude=".#*" --exclude="*~" --exclude="*.bak" \
+    --exclude="CVS" --exclude="cvslog" --exclude="*.orig" --exclude="*.rej" \
+    $FPCSourceDir $TmpDir
 else
   TmpDir=$FPCSourceDir
 fi