brush handle/reference rework

git-svn-id: trunk@13289 -

lcl/graphics.pp

@@ -418,7 +418,6 @@ type
     property OnChange: TNotifyEvent read FOnChange write FOnChange;
   end;
 
-
   { TFontHandleCacheDescriptor }
 
   TFontHandleCacheDescriptor = class(TResourceCacheDescriptor)
@@ -427,7 +426,6 @@ type
     LongFontName: string;
   end;
 
-
   { TFontHandleCache }
 
   TFontHandleCache = class(TResourceCache)
@@ -443,7 +441,6 @@ type
                  const LongFontName: string): TFontHandleCacheDescriptor;
   end;
 
-
   { TFont }
 
   TFont = class(TFPCustomFont)
@@ -516,16 +513,8 @@ type
     property Style: TFontStyles read GetStyle write SetStyle;
   end;
 
-
   { TPen }
 
-  TPenData = record
-    Reference: TWSPenReference;
-    Color: TColor;
-    Width: Integer;
-    Style: TPenStyle;
-  end;
-
   TPenHandleCache = class(TBlockResourceCache)
   protected
     procedure RemoveItem(Item: TResourceCacheItem); override;
@@ -566,16 +555,8 @@ type
     property Width default 1;
   end;
 
-
   { TBrush }
 
-  TBrushData = record
-    Handle: HBrush;
-    Color: TColor;
-    Bitmap: TBitmap;
-    Style: TBrushStyle;
-  end;
-
   TBrushHandleCache = class(TBlockResourceCache)
   protected
     procedure RemoveItem(Item: TResourceCacheItem); override;
@@ -585,11 +566,15 @@ type
 
   TBrush = class(TFPCustomBrush)
   private
-    FHandle: HBrush;
     FBrushHandleCached: boolean;
     FColor: TColor;
     FBitmap: TBitmap;
-    procedure FreeHandle;
+    FReference: TWSBrushReference;
+    procedure FreeReference;
+    function GetHandle: HBRUSH;
+    function GetReference: TWSBrushReference;
+    procedure ReferenceNeeded;
+    procedure SetHandle(const Value: HBRUSH);
     procedure DoChange(var Msg); message LM_CHANGED;
   protected
     procedure DoAllocateResources; override;
@@ -597,17 +582,16 @@ type
     procedure DoCopyProps(From: TFPCanvasHelper); override;
     procedure SetColor(const NewColor: TColor; const NewFPColor: TFPColor); virtual;
     procedure SetFPColor(const AValue: TFPColor); override;
-    function GetHandle: HBRUSH;
     procedure SetBitmap(Value: TBitmap);
     procedure SetColor(Value: TColor);
-    procedure SetHandle(const Value: HBRUSH);
+    procedure SetStyle(Value: TBrushStyle); override;
-    Procedure SetStyle(Value: TBrushStyle); override;
   public
     procedure Assign(Source: TPersistent); override;
     constructor Create; override;
     destructor Destroy; override;
     property Bitmap: TBitmap read FBitmap write SetBitmap;
-    property Handle: HBRUSH read GetHandle write SetHandle;
+    property Handle: HBRUSH read GetHandle write SetHandle; deprecated;
+    property Reference: TWSBrushReference read GetReference;
   published
     property Color: TColor read FColor write SetColor default clWhite;
     property Style default bsSolid;

lcl/include/brush.inc

@@ -40,9 +40,10 @@ end;
 
   Sets the style of a brush
  ------------------------------------------------------------------------------}
-Procedure TBrush.SetColor(Value : TColor);
+procedure TBrush.SetColor(Value : TColor);
 begin
-  if FColor <> Value then SetColor(Value,TColorToFPColor(Value));
+  if FColor <> Value then
+    SetColor(Value, TColorToFPColor(Value));
 end;
 
 {------------------------------------------------------------------------------
@@ -52,10 +53,11 @@ end;
 
   Sets the style of a brush
  ------------------------------------------------------------------------------}
-Procedure TBrush.SetStyle(Value : TBrushStyle);
+procedure TBrush.SetStyle(Value : TBrushStyle);
 begin
-  if Style <> Value then begin
+  if Style <> Value then
-    FreeHandle;
+  begin
+    FreeReference;
     inherited SetStyle(Value);
     Changed;
   end;
@@ -68,11 +70,11 @@ end;
 
   Sets the style of a brush
  ------------------------------------------------------------------------------}
-Procedure TBrush.SetBitmap(Value : TBitmap);
+procedure TBrush.SetBitmap(Value : TBitmap);
 begin
-  if FBitmap <> Value
+  if FBitmap <> Value then
-  then begin
+  begin
-    FreeHandle;
+    FreeReference;
     FBitmap := Value;
     Changed;
   end;
@@ -89,9 +91,8 @@ constructor TBrush.Create;
 begin
   inherited Create;
   FBitmap := nil;
-  FHandle := 0;
   FColor := clWhite;
-  DelayAllocate:=true;
+  DelayAllocate := True;
   inherited SetStyle(bsSolid);
 end;
 
@@ -104,7 +105,7 @@ end;
  ------------------------------------------------------------------------------}
 destructor TBrush.Destroy;
 begin
-  FreeHandle;
+  FreeReference;
   inherited Destroy;
 end;
 
@@ -115,10 +116,10 @@ end;
 
   Copies the source brush to itself
  ------------------------------------------------------------------------------}
-Procedure TBrush.Assign(Source: TPersistent);
+procedure TBrush.Assign(Source: TPersistent);
+begin
+  if Source is TBrush then
   begin
-  if Source is TBrush
-  then begin
     Bitmap := TBrush(Source).Bitmap;
     SetColor(TBrush(Source).Color, TFPCanvasHelper(Source).FPColor);
     Style := TBrush(Source).Style;
@@ -136,14 +137,12 @@ end;
  ------------------------------------------------------------------------------}
 procedure TBrush.SetHandle(const Value: HBRUSH);
 begin
-  if FHandle <> Value
+  if FReference.Handle = Value then Exit;
-  then begin
+
-    FreeHandle;
+  FreeReference;
-    FHandle := Value;
+  FReference._lclHandle := Value;
-    //TODO: query new parameters
   Changed;
 end;
-end;
 
 {------------------------------------------------------------------------------
   Function: TBrush.GetHandle
@@ -153,17 +152,50 @@ end;
   Creates a brush if needed
  ------------------------------------------------------------------------------}
 function TBrush.GetHandle: HBRUSH;
+begin
+  Result := Reference.Handle;
+end;
+
+{------------------------------------------------------------------------------
+  Method:  TBrush.FreeHandle
+  Params:  none
+  Returns: Nothing
+
+  Frees a brush handle if needed
+ ------------------------------------------------------------------------------}
+
+procedure TBrush.FreeReference;
+begin
+  if not FReference.Allocated then Exit;
+
+  Changing;
+  if FBrushHandleCached then
+  begin
+    BrushResourceCache.FindItem(FReference.Handle).DecreaseRefCount;
+    FBrushHandleCached := False;
+  end else
+    DeleteObject(FReference.Handle);
+  FReference._lclHandle := 0;
+end;
+
+function TBrush.GetReference: TWSBrushReference;
+begin
+  ReferenceNeeded;
+  Result := FReference;
+end;
+
+procedure TBrush.ReferenceNeeded;
 var
   LogBrush: TLogBrush;
   CachedBrush: TBlockResourceCacheDescriptor;
 begin
-  if FHandle = 0
+  if FReference.Allocated then Exit;
-  then begin
+
   FillChar(LogBrush, SizeOf(LogBrush), 0);
   with LogBrush do
   begin
-      if FBitmap <> nil
+    if FBitmap <> nil then
-      then begin
+    begin
       lbStyle := BS_PATTERN;
       lbHatch := FBitmap.Handle;
     end else
@@ -179,45 +211,23 @@ begin
     end;
     lbColor := ColorRef(FColor);
   end;
+
   CachedBrush := BrushResourceCache.FindDescriptor(@LogBrush);
   if CachedBrush <> nil then
   begin
     CachedBrush.Item.IncreaseRefCount;
-      FHandle := CachedBrush.Item.Handle;
+    FReference._lclHandle := CachedBrush.Item.Handle;
   end else
   begin
     if LogBrush.lbStyle <> BS_PATTERN then
-        FHandle := CreateBrushIndirect(LogBrush)
+      FReference._lclHandle := CreateBrushIndirect(LogBrush)
     else
-        FHandle := CreatePatternBrush(LogBrush.lbHatch);
+      FReference._lclHandle := CreatePatternBrush(LogBrush.lbHatch);
-      BrushResourceCache.AddResource(FHandle,@LogBrush);
+    BrushResourceCache.AddResource(FReference.Handle, @LogBrush);
   end;
   FBrushHandleCached := True;
 end;
 
-  Result := FHandle;
-end;
-
-{------------------------------------------------------------------------------
-  Method:  TBrush.FreeHandle
-  Params:  none
-  Returns: Nothing
-
-  Frees a brushhandle if needed
- ------------------------------------------------------------------------------}
-procedure TBrush.FreeHandle;
-begin
-  if FHandle <> 0
-  then begin
-    if FBrushHandleCached then begin
-      BrushResourceCache.FindItem(FHandle).DecreaseRefCount;
-      FBrushHandleCached:=false;
-    end else
-      DeleteObject(FHandle);
-    FHandle := 0;
-  end;
-end;
-
 procedure TBrush.DoChange(var Msg);
 begin
   Changed;
@@ -226,19 +236,20 @@ end;
 procedure TBrush.DoAllocateResources;
 begin
   inherited DoAllocateResources;
-  GetHandle;
+  GetReference;
 end;
 
 procedure TBrush.DoDeAllocateResources;
 begin
-  FreeHandle;
+  FreeReference;
   inherited DoDeAllocateResources;
 end;
 
 procedure TBrush.DoCopyProps(From: TFPCanvasHelper);
 begin
-  if From is TBrush then begin
+  if From is TBrush then
-    FreeHandle;
+  begin
+    FreeReference;
     inherited DoCopyProps(From);
     //TODO: query new parameters
     Changed;
@@ -248,8 +259,8 @@ end;
 
 procedure TBrush.SetColor(const NewColor: TColor; const NewFPColor: TFPColor);
 begin
-  if (NewColor=Color) and (NewFPColor=FPColor) then exit;
+  if (NewColor = Color) and (NewFPColor = FPColor) then Exit;
-  FreeHandle;
+  FreeReference;
   FColor := NewColor;
   inherited SetFPColor(NewFPColor);
   Changed;
@@ -257,6 +268,6 @@ end;
 
 procedure TBrush.SetFPColor(const AValue: TFPColor);
 begin
-  if FPColor=AValue then exit;
+  if FPColor <> AValue then
     SetColor(FPColorToTColor(AValue), AValue);
 end;

lcl/include/pen.inc

@@ -136,14 +136,14 @@ end;
 
   Copies the source pen to itself
  ------------------------------------------------------------------------------}
-Procedure TPen.Assign(Source : Tpersistent);
+procedure TPen.Assign(Source : Tpersistent);
+begin
+  if Source is TPen then
   begin
-  if Source is TPen
-  then begin
     Width := TPen(Source).Width;
     SetColor(TPen(Source).Color, TFPCanvasHelper(Source).FPColor);
     Style := TPen(Source).Style;
-    Mode := TPEn(Source).Mode;
+    Mode := TPen(Source).Mode;
   end
   else
     inherited Assign(Source);

lcl/widgetset/wsreferences.pp

@@ -82,6 +82,7 @@ type
   end;
 
   TWSBrushReference = object(TWSGDIObjReference)
+    property _lclHandle: THandle write FRef.Handle;
     property Handle: THandle read FRef.Handle;
   end;