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

TAChart: Allow 3-digit HTML color codes.

Browse Source 
git-svn-id: trunk@55440 -
This commit is contained in:
wp 2017-07-04 17:19:29 +00:00
parent 7f3ef18859
commit 947adc1ddb
1 changed files with 27 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
components/tachart/tahtml.pas
View File

@ -39,8 +39,8 @@ type
public
constructor Create(ADrawer: IChartDrawer);
destructor Destroy; override;
function TextExtent(AText: String): TPoint;
procedure TextOut(AX, AY: Integer; AText: String);
function TextExtent(const AText: String): TPoint;
procedure TextOut(AX, AY: Integer; const AText: String);
end;
@ -489,7 +489,11 @@ begin
end;
function HTMLToFPColor(AText: String): TFPColor;
var
i: Integer;
len: Integer;
begin
Result := colBlack;
case AText of
'AQUA' : Result := colAqua;
'BLACK' : Result := colBlack;
@ -510,13 +514,26 @@ begin
'TEAL' : Result := colTeal;
'WHITE' : Result := colWhite;
'YELLOW' : Result := colYellow;
else if (pos('#', AText) = 1) and (Length(AText) = 7) then begin
else if (pos('#', AText) = 1) then begin
len := Length(AText);
if not (len in [7, 4]) then
exit;
Delete(AText, 1, 1);
dec(len);
for i:=1 to len do
if not (AText[i] in ['0'..'9', 'A'..'F', 'a'..'f']) then
exit;
if len = 6 then begin
Result.Red := StrToInt('$' + copy(AText, 1, 2)) shl 8;
Result.Green := StrToInt('$' + copy(AText, 3, 2)) shl 8;
Result.Blue := StrToInt('$' + copy(AText, 5, 2)) shl 8;
end else
Result := colBlack;
if len = 3 then begin
Result.Red := StrToInt('$' + AText[1]);
Result.Green := StrToInt('$' + AText[2]);
Result.Blue := StrToInt('$' + AText[3]);
end;
end;
end;
end;
@ -750,7 +767,7 @@ begin
FFontStack.Add(fnt);
end;
function THTMLAnalyzer.TextExtent(AText: String): TPoint;
function THTMLAnalyzer.TextExtent(const AText: String): TPoint;
var
parser: THTMLParser;
begin
@ -768,7 +785,7 @@ begin
end;
end;
procedure THTMLAnalyzer.TextOut(AX, AY: Integer; AText: String);
procedure THTMLAnalyzer.TextOut(AX, AY: Integer; const AText: String);
var
parser: THTMLParser;
begin