From d7f5b5f9c5fb2650cca8b9bf2c294e8361802e48 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Thu, 31 Jan 2019 21:24:43 +0000 Subject: [PATCH] jvcllaz: Fix conversion of html string to TColor (issue #34981, modified patch by Michal Gawrycki). git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6811 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../jvcllaz/examples/JvHTControls/unit1.lfm | 8 ++++---- components/jvcllaz/run/JvCore/JvJVCLUtils.pas | 15 ++++++++++++--- 2 files changed, 16 insertions(+), 7 deletions(-) diff --git a/components/jvcllaz/examples/JvHTControls/unit1.lfm b/components/jvcllaz/examples/JvHTControls/unit1.lfm index 802126e83..d4f39c874 100644 --- a/components/jvcllaz/examples/JvHTControls/unit1.lfm +++ b/components/jvcllaz/examples/JvHTControls/unit1.lfm @@ -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:
'#13#10'bold
'#13#10'italic
'#13#10'underline
'#13#10'strikeout
'#13#10'color
'#13#10'Links and custom links' + Hint = 'HTLabel with:
'#13#10'bold
'#13#10'italic
'#13#10'underline
'#13#10'strikeout
'#13#10'color
'#13#10'Links and custom links' Top = 8 Width = 120 - Caption = 'HTLabel with:
'#13#10'bold
'#13#10'italic
'#13#10'underline
'#13#10'strikeout
'#13#10'color
'#13#10'Links and custom links' + Caption = 'HTLabel with:
'#13#10'bold
'#13#10'italic
'#13#10'underline
'#13#10'strikeout
'#13#10'color
'#13#10'Links and custom links' ParentColor = False ParentShowHint = False ShowHint = True @@ -47,7 +47,7 @@ object Form1: TForm1 'italic
' 'underline
' 'strikeout
' - 'color
' + 'color
' 'Links and custom links' ) OnChange = Memo1Change diff --git a/components/jvcllaz/run/JvCore/JvJVCLUtils.pas b/components/jvcllaz/run/JvCore/JvJVCLUtils.pas index aba1b97bb..959691cc7 100644 --- a/components/jvcllaz/run/JvCore/JvJVCLUtils.pas +++ b/components/jvcllaz/run/JvCore/JvJVCLUtils.pas @@ -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

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;