pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases 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
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 ClientWidth = 582
OnCreate = FormCreate OnCreate = FormCreate
OnShow = FormShow OnShow = FormShow
LCLVersion = '1.9.0.0' LCLVersion = '2.1.0.0'
object PageControl1: TPageControl object PageControl1: TPageControl
Left = 0 Left = 0
Height = 422 Height = 422
@@ -25,10 +25,10 @@ object Form1: TForm1
object JvHTLabel1: TJvHTLabel object JvHTLabel1: TJvHTLabel
Left = 8 Left = 8
Height = 106 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 Top = 8
Width = 120 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 ParentColor = False
ParentShowHint = False ParentShowHint = False
ShowHint = True ShowHint = True
@@ -47,7 +47,7 @@ object Form1: TForm1
'<i>italic</i><br>' '<i>italic</i><br>'
'<u>underline</u><br>' '<u>underline</u><br>'
'<s>strikeout</s><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>' '<a href="http://www.freepascal.org/">Links</a> and <a href="custom">custom links</a>'
) )
OnChange = Memo1Change 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; 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 HTMLTextHeight(Canvas: TCanvas; const Text: string; SuperSubScriptRatio: Double; Scale: Integer = 100): Integer;
function HTMLPrepareText(const Text: string): string; 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 The graphic class to be used must implement LoadFromStream and SaveToStream
methods in order to work properly. methods in order to work properly.
} }
********************)
type type
TJvGetGraphicClassEvent = procedure(Sender: TObject; AStream: TMemoryStream; TJvGetGraphicClassEvent = procedure(Sender: TObject; AStream: TMemoryStream;
var GraphicClass: TGraphicClass) of object; var GraphicClass: TGraphicClass) of object;
(*********************** NOT CONVERTED
procedure RegisterGraphicSignature(const ASignature: string; AOffset: Integer; procedure RegisterGraphicSignature(const ASignature: string; AOffset: Integer;
AGraphicClass: TGraphicClass); overload; AGraphicClass: TGraphicClass); overload;
procedure RegisterGraphicSignature(const ASignature: array of Byte; AOffset: Integer; 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> Result := StringReplace(Result, cHR, cHR + sLineBreak, [rfReplaceAll, rfIgnoreCase]); // fixed <HR><BR>
end; end;
function HTMLStringToColor(AText: String): TColor; function HTMLStringToColor(AText: String; ADefColor: TColor = clBlack): TColor;
type type
TRGBA = packed record TRGBA = packed record
R, G, B, A: byte; R, G, B, A: byte;
@@ -7103,6 +7105,11 @@ type
var var
c: Int32; c: Int32;
begin begin
if AText = '' then begin
Result := ADefColor;
exit;
end;
if AText[1] = '#' then AText[1] := '$'; if AText[1] = '#' then AText[1] := '$';
if TryStrToInt(AText, c) then begin if TryStrToInt(AText, c) then begin
TRgba(Result).R := TRgba(c).B; TRgba(Result).R := TRgba(c).B;
@@ -7110,7 +7117,9 @@ begin
TRgba(Result).B := TRgba(c).R; TRgba(Result).B := TRgba(c).R;
TRgba(Result).A := 0; TRgba(Result).A := 0;
end else begin end else begin
Result := StringToColor('cl'+AText); if Lowercase(Copy(AText, 1,2)) <> 'cl' then
AText := 'cl' + AText;
Result := StringToColorDef(AText, ADefColor);
end; end;
end; end;