pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

jvcllaz: Support all html entities, and improved painting of subscripts in HTML output (e.g. for TJvHTLabel)

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8274 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2022-05-06 22:34:52 +00:00
parent 3c11c8c7d0
commit 466086165b
3 changed files with 120 additions and 65 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
components/jvcllaz/examples/JvHTControls/JvHTCtrlsDemo.lpi
View File

@ -68,6 +68,7 @@
</SearchPaths>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf2Set"/>
<UseExternalDbgSyms Value="True"/>
</Debugging>
<Options>

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

@ -1,17 +1,17 @@
object MainForm: TMainForm
Left = 369
Height = 468
Height = 483
Top = 219
Width = 575
Caption = 'JvHTControls'
ClientHeight = 468
ClientHeight = 483
ClientWidth = 575
OnCreate = FormCreate
OnShow = FormShow
LCLVersion = '2.1.0.0'
LCLVersion = '2.3.0.0'
object PageControl1: TPageControl
Left = 0
Height = 422
Height = 437
Top = 0
Width = 575
ActivePage = TabSheet1
@ -20,15 +20,16 @@ object MainForm: TMainForm
TabOrder = 0
object TabSheet1: TTabSheet
Caption = 'TJvHTLabel'
ClientHeight = 394
ClientHeight = 409
ClientWidth = 567
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="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>'
Height = 256
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><br>'#13#10'<sub>Sub</sub>script and <sup>super</sup>script<br>'#13#10'HTML entities: &alpha; &beta; &gamma;'
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="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>'
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><br>'#13#10'<sub>Sub</sub>script and <sup>super</sup>script<br>'#13#10'HTML entities: &alpha; &beta; &gamma;'#13#10
Color = clDefault
ParentColor = False
ParentShowHint = False
ShowHint = True
@ -38,7 +39,7 @@ object MainForm: TMainForm
Left = 0
Height = 123
Hint = '<b>HTML</b><br>'#13#10'<i>Enter HTML content</i>'
Top = 271
Top = 286
Width = 567
Align = alBottom
Lines.Strings = (
@ -48,7 +49,10 @@ object MainForm: TMainForm
'<u>underline</u><br>'
'<s>strikeout</s><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><br>'
'<sub>Sub</sub>script and <sup>super</sup>script<br>'
'HTML entities: &alpha; &beta; &gamma;'
''
)
OnChange = Memo1Change
ParentFont = False
@ -62,7 +66,7 @@ object MainForm: TMainForm
Cursor = crVSplit
Left = 0
Height = 5
Top = 266
Top = 281
Width = 567
Align = alBottom
ResizeAnchor = akBottom
@ -70,15 +74,14 @@ object MainForm: TMainForm
end
object TabSheet2: TTabSheet
Caption = 'TJvHTListBox'
ClientHeight = 394
ClientWidth = 574
ClientHeight = 409
ClientWidth = 567
object JvHTListBox1: TJvHTListBox
Left = 0
Height = 394
Height = 409
Hint = '<b>TJvHTListBox</b><br>'#13#10'<i>ListBox with HT items</i>'
Top = 0
Width = 152
HideSel = False
OnHyperLinkClick = JvHTListBox1HyperLinkClick
Align = alLeft
ColorHighlight = clHighlight
@ -104,7 +107,7 @@ object MainForm: TMainForm
end
object Splitter2: TSplitter
Left = 152
Height = 394
Height = 409
Top = 0
Width = 5
end
@ -115,7 +118,7 @@ object MainForm: TMainForm
Height = 90
Hint = '<b>New item content</b><br><i>Enter new item contnent</i>'
Top = 8
Width = 409
Width = 402
Anchors = [akTop, akLeft, akRight]
Lines.Strings = (
'new item...'
@ -147,10 +150,6 @@ object MainForm: TMainForm
Hint = '<b>TJvHTComboBox</b><br>'#13#10'<i>ComboBox with HT items</i>'
Top = 160
Width = 152
HideSel = False
ColorHighlight = clHighlight
ColorHighlightText = clHighlightText
ColorDisabledText = clGrayText
Items.Strings = (
'<b>Lazarus</b><br><a href="http://www.lazarus-ide.org/">Home page</a> or <a hred="http://forum.lazarus.freepascal.org/">Forum</a>'
'<b>Free Pascal</b><br><a href="http://www.freepascal.org/">Home page</a>'
@ -185,23 +184,24 @@ object MainForm: TMainForm
end
object TabSheet3: TTabSheet
Caption = 'TJvDBHTLabel'
ClientHeight = 394
ClientWidth = 574
ClientHeight = 409
ClientWidth = 567
object JvDBHTLabel1: TJvDBHTLabel
Left = 8
Height = 16
Height = 76
Top = 8
Width = 297
Width = 82
DataSource = DataSource1
Mask = 'Numeric field: <b><field="Num"></b><br>Field 1: <b><font color="clRed"><field="fld1"></font></b><br><i>Field 2:</i> <b><font color="clGreen"><field="fld2"></font></b><br>And some link: <a href="url"><field="Fld1"></a><br><a href="qwe">#<field="num"></a> - <b><field="fld1"> <field="fld2"></b>'
Color = clDefault
ParentColor = False
OnHyperLinkClick = JvDBHTLabel1HyperLinkClick
end
object DBGrid1: TDBGrid
Left = 0
Height = 130
Top = 264
Width = 574
Top = 279
Width = 567
Align = alBottom
Color = clWindow
Columns = <>
@ -212,16 +212,16 @@ object MainForm: TMainForm
Cursor = crVSplit
Left = 0
Height = 5
Top = 259
Width = 574
Top = 274
Width = 567
Align = alBottom
ResizeAnchor = akBottom
end
object Memo3: TMemo
Left = 0
Height = 99
Top = 160
Width = 574
Top = 175
Width = 567
Align = alBottom
Lines.Strings = (
'Numeric field: <b><field="Num"></b><br>Field 1: <b><font color="clRed"><field="fld1"></font></b><br><i>Field 2:</i> <b><font color="clGreen"><field="fld2"></font></b><br>And some link: <a href="url"><field="Fld1"></a><br><a href="qwe">#<field="num"></a> - <b><field="fld1"> <field="fld2"></b>'
@ -234,7 +234,7 @@ object MainForm: TMainForm
object ButtonPanel1: TButtonPanel
Left = 6
Height = 34
Top = 428
Top = 443
Width = 563
OKButton.Name = 'OKButton'
OKButton.DefaultCaption = True
@ -266,12 +266,12 @@ object MainForm: TMainForm
DataType = ftString
Size = 20
end>
left = 384
top = 112
Left = 384
Top = 112
end
object DataSource1: TDataSource
DataSet = MemDataset1
left = 464
top = 112
Left = 464
Top = 112
end
end

112
components/jvcllaz/run/JvCore/jvjvclutils.pas
View File

@ -871,7 +871,7 @@ function Scale96ToForm(ASize: Integer): Integer;
implementation
uses
sysutils, LCLIntf, GraphType, GraphUtil, FPImage, IntfGraphics, Math,
sysutils, LCLIntf, GraphType, GraphUtil, FPImage, IntfGraphics, Math, htmldefs, StrUtils,
{$IFDEF MSWINDOWS}
CommCtrl,
{$ENDIF}
@ -7125,6 +7125,7 @@ end;
const
cBR = '<BR>';
cBR2 = '<BR/>';
cBR3 = '<BR />';
cHR = '<HR>';
cTagBegin = '<';
cTagEnd = '>';
@ -7138,34 +7139,83 @@ const
cCOLOR = 'COLOR';
cBGCOLOR = 'BGCOLOR';
// moved from JvHTControls and renamed
function HTMLPrepareText(const Text: string): string;
type
THtmlCode = record
Html: string;
Text: UTF8String;
end;
const
Conversions: array [0..6] of THtmlCode = (
(Html: '&amp;'; Text: '&'),
(Html: '&quot;'; Text: '"'),
(Html: '&reg;'; Text: #$C2#$AE),
(Html: '&copy;'; Text: #$C2#$A9),
(Html: '&trade;'; Text: #$E2#$84#$A2),
(Html: '&euro;'; Text: #$E2#$82#$AC),
(Html: '&nbsp;'; Text: ' ')
);
// moved from JvHTControls and refactored to support all html entities
function HTMLPrepareText(const Text: String): String;
var
I: Integer;
i, j, len, p: Integer;
sEntity: String;
wEntity: WideString;
wChar: WideChar;
procedure AddCurrentChar;
begin
Result[j] := Text[i];
inc(j);
inc(i);
end;
begin
Result := Text;
for I := Low(Conversions) to High(Conversions) do
Result := StringReplace(Result, Conversions[I].Html, Utf8ToAnsi(Conversions[I].Text), [rfReplaceAll, rfIgnoreCase]);
Result := StringReplace(Result, #13, '', [rfReplaceAll]); // only <BR> can be new line
Result := StringReplace(Result, #10, '', [rfReplaceAll]); // only <BR> can be new line
Result := StringReplace(Result, cBR, sLineBreak, [rfReplaceAll, rfIgnoreCase]);
Result := StringReplace(Result, cBR2, sLineBreak, [rfReplaceAll, rfIgnoreCase]); // Fixes <BR/>, but not <BR />!
Result := StringReplace(Result, cHR, cHR + sLineBreak, [rfReplaceAll, rfIgnoreCase]); // fixed <HR><BR>
Result := '';
if Text = '' then
exit;
len := Length(Text);
SetLength(Result, len*4);
j := 1;
i := 1;
while i <= len do begin
if (Text[i] in [#10, #13]) then // only <br> is allowed for new line here
inc(i)
else
if Text[i] = '<' then
begin
if SameText(Copy(Text, i, Length(cBR)), cBR) then // Fixes <br>
begin
Move(LineEnding, Result[j], Length(LineEnding));
inc(j, Length(LineEnding));
inc(i, Length(cBR));
end else
if SameText(Copy(Text, i, Length(cBR2)), cBR2) then // Fixes <br/>
begin
Move(LineEnding, Result[j], Length(LineEnding));
inc(j, Length(LineEnding));
inc(i, Length(cBR2));
end else
if SameText(Copy(Text, i, Length(cBR3)), cBR3) then // Fixes <br />
begin
Move(LineEnding, Result[j], Length(LineEnding));
inc(j, Length(LineEnding));
inc(i, Length(cBR3));
end else
if SameText(Copy(Text, i, Length(cHR)), cHR) then // Fixes <hr>
begin
Move(cHR + LineEnding, Result[j], Length(cHR + LineEnding));
inc(j, Length(cHR + LineEnding));
inc(i, Length(cHR));
end else
AddCurrentChar;
end else
if Text[i] = '&' then
begin
p := PosEx(';', Text, i);
if p > 0 then
begin
sEntity := Copy(Text, i+1, p-i-1);
wEntity := WideString(sEntity);
if ResolveHTMLEntityReference(wEntity, wChar) then
begin
sEntity := UTF8Encode(wChar);
Move(sEntity[1], Result[j], Length(sEntity));
inc(j, Length(sEntity));
i := p+1;
end else
AddCurrentChar;
end else
AddCurrentChar;
end else
AddCurrentChar;
end;
SetLength(Result, j-1);
end;
function HTMLStringToColor(AText: String; ADefColor: TColor = clBlack): TColor;
@ -7351,8 +7401,12 @@ var
Width := Canvas.TextWidth(M);
Height := CanvasMaxTextHeight(Canvas);
if ScriptPosition = spSubscript then
R.Top := R.Top + lineHeight - Height - 1;
case ScriptPosition of
spSubscript:
R.Top := R.Top + lineHeight - abs(Canvas.Font.Height);
spSuperScript:
R.Top := R.Top + (Canvas.Font.Size - abs(Canvas.Font.Height));
end;
if IsLink and not MouseOnLink then
if (MouseY >= R.Top) and (MouseY <= R.Top + Height) and