clean up for TBitmapImage sharing

git-svn-id: trunk@5252 -

lcl/graphics.pp

@@ -744,7 +744,7 @@ type
   private
     FAutoReDraw : Boolean;
     FState: TCanvasState;
-    FFont : TFont;
+    FFont: TFont;
     FSavedFontHandle: HFont;
     FPen: TPen;
     FSavedPenHandle: HPen;
@@ -752,9 +752,9 @@ type
     FSavedBrushHandle: HBrush;
     FRegion: TRegion;
     FSavedRegionHandle: HRGN;
-    FPenPos : TPoint;
+    FPenPos: TPoint;
-    FCopyMode : TCopyMode;
+    FCopyMode: TCopyMode;
-    FHandle : HDC;
+    FHandle: HDC;
     FOnChange: TNotifyEvent;
     FOnChanging: TNotifyEvent;
     FTextStyle: TTextStyle;
@@ -775,7 +775,6 @@ 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);
@@ -789,6 +788,7 @@ type
     procedure RequiredState(ReqState: TCanvasState);
     procedure Changed; virtual;
     procedure Changing; virtual;
+    procedure SetHandle(NewHandle: HDC); virtual;
   public
     constructor Create;
     destructor Destroy; override;
@@ -1222,16 +1222,15 @@ const
 type
   TBitmapCanvas = class(TCanvas)
   private
-    FBitmap : TBitmap;
+    FBitmap: TBitmap;
-    FOldBitmap : HBitmap;
+    FOldBitmap: HBitmap;
-    FOldPalette : HPALETTE;
+    FOldPalette: HPALETTE;
     procedure FreeDC;
   protected
     procedure CreateHandle; override;
   public
     constructor Create(ABitmap : TBitmap);
     destructor Destroy; override;
-    // TODO: replace this by property BitmapHandle;
   end;
 
 
@@ -1599,6 +1598,9 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.125  2004/03/02 22:37:36  mattias
+  clean up for TBitmapImage sharing
+
   Revision 1.124  2004/03/01 18:02:00  mattias
   fixed IsFileExtensionSupported
 

lcl/include/bitmapcanvas.inc

@@ -41,29 +41,25 @@ procedure TBitMapCanvas.CreateHandle;
 var
   DC: HDC;
 begin
-  if FBitmap <> nil then
+  FreeDC;
-  begin
+  if FBitmap = nil then exit;
-    FBitmap.HandleNeeded;
+  FBitmap.HandleNeeded;
-    FreeDC;
+  FBitmap.PaletteNeeded;
-    FBitmap.PaletteNeeded;
+  DC := CreateCompatibleDC(0);
-    DC := CreateCompatibleDC(0);
 
-    Assert(False, Format('trace:[TBitmapCanvas.CreateHandle] Got Handle 0x%x', [FBitmap.Handle]));
+  if not FBitmap.HandleAllocated then
+    FOldBitmap := 0
+  else
+    FOldBitmap := SelectObject(DC, FBitmap.Handle);
 
-    if not FBitmap.HandleAllocated then
+  if FBitmap.FPalette = 0 then
-      FOldBitmap := 0
+    FOldPalette := 0
-    else
+  else begin
-      FOldBitmap := SelectObject(DC, FBitmap.Handle);
+    FOldPalette := SelectPalette(DC, FBitmap.FPalette, True);
-
+    RealizePalette(DC);
-    if FBitmap.FPalette = 0 then
-      FOldPalette := 0
-    else begin
-      FOldPalette := SelectPalette(DC, FBitmap.FPalette, True);
-      RealizePalette(DC);
-    end;
-
-    Handle := DC;
   end;
+
+  Handle := DC;
 end;
 
 {------------------------------------------------------------------------------
@@ -79,7 +75,6 @@ begin
   inherited Destroy;
 end;
 
-
 {------------------------------------------------------------------------------
   Method:  TControlCanvas.FreeDC
   Params:  None
@@ -91,8 +86,8 @@ procedure TBitmapCanvas.FreeDC;
 var
   OldHandle: HBITMAP;
 begin
-  if FHandle <> 0 then
+  if not HandleAllocated then exit;
-  begin
+  if FBitmap<>nil then begin
     if FOldBitmap <> 0 then begin
       SelectObject(FHandle, FOldBitmap);
       FOldBitmap:=0;
@@ -104,6 +99,8 @@ begin
     OldHandle := FHandle;
     Handle := 0;
     DeleteDC(OldHandle);
+  end else begin
+    Handle:=0;
   end;
 end;
 
@@ -112,6 +109,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.9  2004/03/02 22:37:36  mattias
+  clean up for TBitmapImage sharing
+
   Revision 1.8  2004/02/05 16:28:38  mattias
   fixed unsharing TBitmap
 

lcl/include/bitmapimage.inc

@@ -22,14 +22,10 @@ begin
   FSaveStreamType:=bnNone;
   if FDIBHandle <> 0 then
   begin
-    //TODO:write this function
-    //DeselectBitmap(FDIBHandle);
     DeleteObject(FDIBHandle);
     FDIBHandle := 0;
   end;
   FreeHandle;
-  //TODO Write CloseHandle
-  //if FDIB.dshSection <> 0 then CloseHandle(FDIB.dshSection);
   inherited Destroy;
 end;
 
@@ -54,21 +50,15 @@ end;
 
 procedure TBitmapImage.FreeHandle;
 begin
-  if (FHandle <> 0) and (FHandle <> FDIBHandle) then
-  begin
-    //TODO: Once written, remove comment below
-    //DeselectBitmap(FHandle);
-    DeleteObject(FHandle);
-  end;
   if FMaskHandle <> 0 then
   begin
-    //TODO: Once written, remove comment below
-    //DeselectBitmap(FMaskHandle);
     DeleteObject(FMaskHandle);
     FMaskHandle := 0;
   end;
-  //TODO: Once written, remove comment below
+  if (FHandle <> 0) and (FHandle <> FDIBHandle) then
-  //InternalDeletePalette(FPalette);
+  begin
+    DeleteObject(FHandle);
+  end;
   FHandle := 0;
   FPalette := 0;
 end;

lcl/include/imglist.inc

@@ -469,6 +469,7 @@ end;
 procedure TCustomImageList.GetBitmap(Index: Integer; Image: TBitmap);
 begin
   if (FCount = 0) or (Image = nil) then Exit; 
+  //writeln('TCustomImageList.GetBitmap Index=',Index,' Image=',HexStr(Cardinal(Image),8),' Bitmap=',HexStr(Cardinal(FImageList.Items[Index]),8));
   Image.Assign(TBitMap(FImageList.Items[Index]));
 end;
 
@@ -1165,6 +1166,9 @@ end;
 {
 
   $Log$
+  Revision 1.29  2004/03/02 22:37:36  mattias
+  clean up for TBitmapImage sharing
+
   Revision 1.28  2004/03/01 23:45:33  marc
   * Patch from olivier GUILBAUD and Colin Western
   * fixed addcopy