paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

jvcllaz: Fix conversion of html string to TColor (issue #34981, modified patch by Michal Gawrycki).

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6811 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2019-01-31 21:24:43 +00:00
parent 412cb29f9a
commit d7f5b5f9c5
2 changed files with 16 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
components/jvcllaz/examples/JvHTControls/unit1.lfm
View File

@ -8,7 +8,7 @@ object Form1: TForm1
ClientWidth = 582
OnCreate = FormCreate
OnShow = FormShow
LCLVersion = '1.9.0.0'
LCLVersion = '2.1.0.0'
object PageControl1: TPageControl
Left = 0
Height = 422
@ -25,10 +25,10 @@ object Form1: TForm1
object JvHTLabel1: TJvHTLabel
Left = 8
Height = 106
Hint = 'HTLabel with:<br />'#13#10'<b>bold</b><br>'#13#10'<i>italic</i><br>'#13#10'<u>underline</u><br>'#13#10'<s>strikeout</s><br>'#13#10'<font color="clRed">c</font><font color="clblue">o</font><font color="clGreen">l</font><font color="clFuchsia">o</font><font color="clMaroon">r</font><br>'#13#10'<a href="http://www.freepascal.org/">Links</a> and <a href="custom">custom links</a>'
Hint = 'HTLabel with:<br />'#13#10'<b>bold</b><br>'#13#10'<i>italic</i><br>'#13#10'<u>underline</u><br>'#13#10'<s>strikeout</s><br>'#13#10'<font color="Red">c</font><font color="blue">o</font><font color="Green">l</font><font color="Fuchsia">o</font><font color="Maroon">r</font><br>'#13#10'<a href="http://www.freepascal.org/">Links</a> and <a href="custom">custom links</a>'
Top = 8
Width = 120
Caption = 'HTLabel with:<br>'#13#10'<b>bold</b><br>'#13#10'<i>italic</i><br>'#13#10'<u>underline</u><br>'#13#10'<s>strikeout</s><br>'#13#10'<font color="clRed">c</font><font color="clblue">o</font><font color="clGreen">l</font><font color="clFuchsia">o</font><font color="clMaroon">r</font><br>'#13#10'<a href="http://www.freepascal.org/">Links</a> and <a href="custom">custom links</a>'
Caption = 'HTLabel with:<br>'#13#10'<b>bold</b><br>'#13#10'<i>italic</i><br>'#13#10'<u>underline</u><br>'#13#10'<s>strikeout</s><br>'#13#10'<font color="Red">c</font><font color="blue">o</font><font color="Green">l</font><font color="Fuchsia">o</font><font color="Maroon">r</font><br>'#13#10'<a href="http://www.freepascal.org/">Links</a> and <a href="custom">custom links</a>'
ParentColor = False
ParentShowHint = False
ShowHint = True
@ -47,7 +47,7 @@ object Form1: TForm1
'<i>italic</i><br>'
'<u>underline</u><br>'
'<s>strikeout</s><br>'
'<font color="clRed">c</font><font color="clblue">o</font><font color="clGreen">l</font><font color="clFuchsia">o</font><font color="clMaroon">r</font><br>'
'<font color="Red">c</font><font color="blue">o</font><font color="Green">l</font><font color="Fuchsia">o</font><font color="Maroon">r</font><br>'
'<a href="http://www.freepascal.org/">Links</a> and <a href="custom">custom links</a>'
)
OnChange = Memo1Change

15
components/jvcllaz/run/JvCore/JvJVCLUtils.pas
View File

@ -754,7 +754,7 @@ function HTMLTextWidth(Canvas: TCanvas; Rect: TRect;
const State: TOwnerDrawState; const Text: string; SuperSubScriptRatio: Double; Scale: Integer = 100): Integer;
function HTMLTextHeight(Canvas: TCanvas; const Text: string; SuperSubScriptRatio: Double; Scale: Integer = 100): Integer;
function HTMLPrepareText(const Text: string): string;
function HTMLStringToColor(AText: String): TColor;
function HTMLStringToColor(AText: String; ADefColor: TColor = clBlack): TColor;
(*************
@ -830,11 +830,13 @@ IMAGE FORMATS:
The graphic class to be used must implement LoadFromStream and SaveToStream
methods in order to work properly.
}
********************)
type
TJvGetGraphicClassEvent = procedure(Sender: TObject; AStream: TMemoryStream;
var GraphicClass: TGraphicClass) of object;
(*********************** NOT CONVERTED
procedure RegisterGraphicSignature(const ASignature: string; AOffset: Integer;
AGraphicClass: TGraphicClass); overload;
procedure RegisterGraphicSignature(const ASignature: array of Byte; AOffset: Integer;
@ -7095,7 +7097,7 @@ begin
Result := StringReplace(Result, cHR, cHR + sLineBreak, [rfReplaceAll, rfIgnoreCase]); // fixed <HR><BR>
end;
function HTMLStringToColor(AText: String): TColor;
function HTMLStringToColor(AText: String; ADefColor: TColor = clBlack): TColor;
type
TRGBA = packed record
R, G, B, A: byte;
@ -7103,6 +7105,11 @@ type
var
c: Int32;
begin
if AText = '' then begin
Result := ADefColor;
exit;
end;
if AText[1] = '#' then AText[1] := '$';
if TryStrToInt(AText, c) then begin
TRgba(Result).R := TRgba(c).B;
@ -7110,7 +7117,9 @@ begin
TRgba(Result).B := TRgba(c).R;
TRgba(Result).A := 0;
end else begin
Result := StringToColor('cl'+AText);
if Lowercase(Copy(AText, 1,2)) <> 'cl' then
AText := 'cl' + AText;
Result := StringToColorDef(AText, ADefColor);
end;
end;