paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-05-22 11:42:32 +02:00
Code Issues Packages Projects Releases Wiki Activity

lcl: add DefaultColorType argument to TControlCanvas too

Browse Source 
git-svn-id: trunk@28307 -
This commit is contained in:
paul 2010-11-18 02:23:34 +00:00
parent 2fd8aba64b
commit a5f3523e6f
5 changed files with 12 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
lcl/controls.pp
View File

@ -256,7 +256,7 @@ type
protected
procedure CreateHandle; override;
procedure CreateFont; override;
function GetDefaultColor: TColor; override;
function GetDefaultColor(const ADefaultColorType: TDefaultColorType): TColor; override;
public
constructor Create;
destructor Destroy; override;
@ -846,11 +846,6 @@ type
chtOnKeyDown
);
TDefaultColorType = (
dctBrush,
dctFont
);
{* Note on TControl.Caption
* The VCL implementation relies on the virtual Get/SetTextBuf to
* exchange text between widgets and VCL. This means a lot of

7
lcl/graphics.pp
View File

@ -972,6 +972,11 @@ type
Height: Integer;
end;
TDefaultColorType = (
dctBrush,
dctFont
);
{ TCanvas }
TCanvas = class(TFPCustomCanvas)
@ -1040,7 +1045,7 @@ type
const SourceRect: TRect); override;
procedure DoDraw(x, y: integer; const Image: TFPCustomImage); override;
procedure CheckHelper(AHelper: TFPCanvasHelper); override;
function GetDefaultColor: TColor; virtual;
function GetDefaultColor(const ADefaultColorType: TDefaultColorType): TColor; virtual;
protected
function GetClipRect: TRect; override;
procedure SetClipRect(const ARect: TRect); override;

2
lcl/include/brush.inc
View File

@ -200,7 +200,7 @@ function TBrush.GetColor: TColor;
begin
Result := FColor;
if (Result = clDefault) and Assigned(Canvas) and (Canvas is TCanvas) then
Result := TCanvas(Canvas).GetDefaultColor;
Result := TCanvas(Canvas).GetDefaultColor(dctBrush);
end;
procedure TBrush.ReferenceNeeded;

2
lcl/include/canvas.inc
View File

@ -650,7 +650,7 @@ begin
debugln('TCanvas.CheckHelper ignored for ',DbgSName(AHelper));
end;
function TCanvas.GetDefaultColor: TColor;
function TCanvas.GetDefaultColor(const ADefaultColorType: TDefaultColorType): TColor;
begin
Result := clDefault;
end;

6
lcl/include/controlcanvas.inc
View File

@ -42,12 +42,12 @@ begin
//DebugLn('TControlCanvas.CreateFont A ',ClassName,' Control=',Control.Name,':',Control.ClassName,' ',Font.Name,' ',Font.Height);
end;
function TControlCanvas.GetDefaultColor: TColor;
function TControlCanvas.GetDefaultColor(const ADefaultColorType: TDefaultColorType): TColor;
begin
if Assigned(FControl) then
Result := FControl.GetDefaultColor(dctBrush)
Result := FControl.GetDefaultColor(ADefaultColorType)
else
Result := inherited GetDefaultColor;
Result := inherited GetDefaultColor(ADefaultColorType);
end;
{------------------------------------------------------------------------------