diff --git a/lcl/graphics.pp b/lcl/graphics.pp index 290afe3be9..c27f7b02ae 100644 --- a/lcl/graphics.pp +++ b/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; diff --git a/lcl/include/brush.inc b/lcl/include/brush.inc index da9a7e065d..10348a1750 100644 --- a/lcl/include/brush.inc +++ b/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 - FreeHandle; + if Style <> Value then + 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 - then begin - FreeHandle; + if FBitmap <> Value then + begin + 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,12 +116,12 @@ 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); + SetColor(TBrush(Source).Color, TFPCanvasHelper(Source).FPColor); Style := TBrush(Source).Style; end else @@ -136,13 +137,11 @@ end; ------------------------------------------------------------------------------} procedure TBrush.SetHandle(const Value: HBRUSH); begin - if FHandle <> Value - then begin - FreeHandle; - FHandle := Value; - //TODO: query new parameters - Changed; - end; + if FReference.Handle = Value then Exit; + + FreeReference; + FReference._lclHandle := Value; + Changed; end; {------------------------------------------------------------------------------ @@ -153,49 +152,8 @@ end; Creates a brush if needed ------------------------------------------------------------------------------} function TBrush.GetHandle: HBRUSH; -var - LogBrush: TLogBrush; - CachedBrush: TBlockResourceCacheDescriptor; begin - if FHandle = 0 - then begin - FillChar(LogBrush,SizeOf(LogBrush),0); - with LogBrush do - begin - if FBitmap <> nil - then begin - lbStyle := BS_PATTERN; - lbHatch := FBitmap.Handle; - end else - begin - lbHatch := 0; - case Style of - bsSolid: lbStyle := BS_SOLID; - bsClear: lbStyle := BS_HOLLOW; - else - lbStyle := BS_HATCHED; - lbHatch := Ord(Style) - Ord(bsHorizontal); - end; - end; - lbColor := ColorRef(FColor); - end; - CachedBrush := BrushResourceCache.FindDescriptor(@LogBrush); - if CachedBrush <> nil then - begin - CachedBrush.Item.IncreaseRefCount; - FHandle := CachedBrush.Item.Handle; - end else - begin - if LogBrush.lbStyle <> BS_PATTERN then - FHandle := CreateBrushIndirect(LogBrush) - else - FHandle := CreatePatternBrush(LogBrush.lbHatch); - BrushResourceCache.AddResource(FHandle,@LogBrush); - end; - FBrushHandleCached := True; - end; - - Result := FHandle; + Result := Reference.Handle; end; {------------------------------------------------------------------------------ @@ -203,19 +161,71 @@ end; Params: none Returns: Nothing - Frees a brushhandle if needed + Frees a brush handle if needed ------------------------------------------------------------------------------} -procedure TBrush.FreeHandle; + +procedure TBrush.FreeReference; begin - if FHandle <> 0 - then begin - if FBrushHandleCached then begin - BrushResourceCache.FindItem(FHandle).DecreaseRefCount; - FBrushHandleCached:=false; + 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 FReference.Allocated then Exit; + + FillChar(LogBrush, SizeOf(LogBrush), 0); + with LogBrush do + begin + if FBitmap <> nil then + begin + lbStyle := BS_PATTERN; + lbHatch := FBitmap.Handle; end else - DeleteObject(FHandle); - FHandle := 0; + begin + lbHatch := 0; + case Style of + bsSolid: lbStyle := BS_SOLID; + bsClear: lbStyle := BS_HOLLOW; + else + lbStyle := BS_HATCHED; + lbHatch := Ord(Style) - Ord(bsHorizontal); + end; + end; + lbColor := ColorRef(FColor); end; + + CachedBrush := BrushResourceCache.FindDescriptor(@LogBrush); + if CachedBrush <> nil then + begin + CachedBrush.Item.IncreaseRefCount; + FReference._lclHandle := CachedBrush.Item.Handle; + end else + begin + if LogBrush.lbStyle <> BS_PATTERN then + FReference._lclHandle := CreateBrushIndirect(LogBrush) + else + FReference._lclHandle := CreatePatternBrush(LogBrush.lbHatch); + BrushResourceCache.AddResource(FReference.Handle, @LogBrush); + end; + FBrushHandleCached := True; end; procedure TBrush.DoChange(var Msg); @@ -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 - FreeHandle; + if From is TBrush then + begin + FreeReference; inherited DoCopyProps(From); //TODO: query new parameters Changed; @@ -248,15 +259,15 @@ end; procedure TBrush.SetColor(const NewColor: TColor; const NewFPColor: TFPColor); begin - if (NewColor=Color) and (NewFPColor=FPColor) then exit; - FreeHandle; - FColor:=NewColor; + if (NewColor = Color) and (NewFPColor = FPColor) then Exit; + FreeReference; + FColor := NewColor; inherited SetFPColor(NewFPColor); Changed; end; procedure TBrush.SetFPColor(const AValue: TFPColor); begin - if FPColor=AValue then exit; - SetColor(FPColorToTColor(AValue),AValue); + if FPColor <> AValue then + SetColor(FPColorToTColor(AValue), AValue); end; diff --git a/lcl/include/pen.inc b/lcl/include/pen.inc index 705503b16c..f422e7cda8 100644 --- a/lcl/include/pen.inc +++ b/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); + SetColor(TPen(Source).Color, TFPCanvasHelper(Source).FPColor); Style := TPen(Source).Style; - Mode := TPEn(Source).Mode; + Mode := TPen(Source).Mode; end else inherited Assign(Source); diff --git a/lcl/widgetset/wsreferences.pp b/lcl/widgetset/wsreferences.pp index 5fbd0ebc6f..be2c0054de 100644 --- a/lcl/widgetset/wsreferences.pp +++ b/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;