paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-05-22 17:02:35 +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 protected
procedure CreateHandle; override; procedure CreateHandle; override;
procedure CreateFont; override; procedure CreateFont; override;
function GetDefaultColor: TColor; override; function GetDefaultColor(const ADefaultColorType: TDefaultColorType): TColor; override;
public public
constructor Create; constructor Create;
destructor Destroy; override; destructor Destroy; override;
@ -846,11 +846,6 @@ type
chtOnKeyDown chtOnKeyDown
); );
TDefaultColorType = (
dctBrush,
dctFont
);
{* Note on TControl.Caption {* Note on TControl.Caption
* The VCL implementation relies on the virtual Get/SetTextBuf to * The VCL implementation relies on the virtual Get/SetTextBuf to
* exchange text between widgets and VCL. This means a lot of * exchange text between widgets and VCL. This means a lot of

7
lcl/graphics.pp
View File

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

2
lcl/include/brush.inc
View File

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

2
lcl/include/canvas.inc
View File

@ -650,7 +650,7 @@ begin
debugln('TCanvas.CheckHelper ignored for ',DbgSName(AHelper)); debugln('TCanvas.CheckHelper ignored for ',DbgSName(AHelper));
end; end;
function TCanvas.GetDefaultColor: TColor; function TCanvas.GetDefaultColor(const ADefaultColorType: TDefaultColorType): TColor;
begin begin
Result := clDefault; Result := clDefault;
end; 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); //DebugLn('TControlCanvas.CreateFont A ',ClassName,' Control=',Control.Name,':',Control.ClassName,' ',Font.Name,' ',Font.Height);
end; end;
function TControlCanvas.GetDefaultColor: TColor; function TControlCanvas.GetDefaultColor(const ADefaultColorType: TDefaultColorType): TColor;
begin begin
if Assigned(FControl) then if Assigned(FControl) then
Result := FControl.GetDefaultColor(dctBrush) Result := FControl.GetDefaultColor(ADefaultColorType)
else else
Result := inherited GetDefaultColor; Result := inherited GetDefaultColor(ADefaultColorType);
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------