paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-06-01 09:53:20 +02:00
Code Issues Packages Projects Releases Wiki Activity

lcl: if TControlCanvas.Brush.Color = clDefault then use default control color

Browse Source 
git-svn-id: trunk@28145 -
This commit is contained in:
paul 2010-11-08 04:43:56 +00:00
parent d3bb952456
commit bda1a2e021
5 changed files with 25 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
lcl/controls.pp
View File

@ -256,6 +256,7 @@ type
protected
procedure CreateHandle; override;
procedure CreateFont; override;
function GetDefaultColor: TColor; override;
public
constructor Create;
destructor Destroy; override;

2
lcl/graphics.pp
View File

@ -665,6 +665,7 @@ type
procedure FreeReference;
function GetHandle: HBRUSH;
function GetReference: TWSBrushReference;
function GetColor: TColor;
procedure ReferenceNeeded;
procedure SetHandle(const Value: HBRUSH);
procedure DoChange(var Msg); message LM_CHANGED;
@ -1039,6 +1040,7 @@ type
const SourceRect: TRect); override;
procedure DoDraw(x, y: integer; const Image: TFPCustomImage); override;
procedure CheckHelper(AHelper: TFPCanvasHelper); override;
function GetDefaultColor: TColor; virtual;
protected
function GetClipRect: TRect; override;
procedure SetClipRect(const ARect: TRect); override;

11
lcl/include/brush.inc
View File

@ -39,7 +39,7 @@ 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));
@ -196,6 +196,13 @@ begin
Result := FReference;
end;
function TBrush.GetColor: TColor;
begin
Result := FColor;
if (Result = clDefault) and Assigned(Canvas) and (Canvas is TCanvas) then
Result := TCanvas(Canvas).GetDefaultColor;
end;
procedure TBrush.ReferenceNeeded;
var
LogBrush: TLogBrush;
@ -221,7 +228,7 @@ begin
lbHatch := Ord(Style) - Ord(bsHorizontal);
end;
end;
lbColor := ColorRef(FColor);
lbColor := ColorRef(GetColor);
end;
BrushResourceCache.Lock;

5
lcl/include/canvas.inc
View File

@ -650,6 +650,11 @@ begin
debugln('TCanvas.CheckHelper ignored for ',DbgSName(AHelper));
end;
function TCanvas.GetDefaultColor: TColor;
begin
Result := clDefault;
end;
{------------------------------------------------------------------------------
Method: TCanvas.Arc
Params: ALeft, ATop, ARight, ABottom, angle1, angle2

8
lcl/include/controlcanvas.inc
View File

@ -42,6 +42,14 @@ begin
//DebugLn('TControlCanvas.CreateFont A ',ClassName,' Control=',Control.Name,':',Control.ClassName,' ',Font.Name,' ',Font.Height);
end;
function TControlCanvas.GetDefaultColor: TColor;
begin
if Assigned(FControl) then
Result := TWSControlClass(FControl.WidgetSetClass).GetDefaultColor(FControl)
else
Result := inherited GetDefaultColor;
end;
{------------------------------------------------------------------------------
Method: TControlCanvas.Create
Params: none