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

jvcllaz: TJvMarkupLabel|Viewer support sub- and superscripts.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8277 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2022-05-07 15:47:09 +00:00
parent e017e82ce5
commit 4ff3aaab44
4 changed files with 88 additions and 8 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
components/jvcllaz/examples/JvMarkup/main.lfm
View File

@ -457,8 +457,7 @@ object MainForm: TMainForm
'<br><font size="6">small text</font> and <font size="20">large</font> text'
'<br>A different font face: <font face="Times" size="14">Times</font>'
'<br>HTML entities: &amp; &trade; &radic;&alpha; &beta; &gamma; &delta; 90&deg;'
'<br>Subscripts and superscripts are not supported:'
'10 cm<sup>3</sup> H<sub>2</sub>O '
'<br>Subscripts and superscripts: 10 cm<sup>3</sup> H<sub>2</sub>O '
)
VisibleSpecialChars = [vscSpace, vscTabAtLast]
SelectedColor.BackPriority = 50

4
components/jvcllaz/run/JvJans/jvmarkupcommon.pas
View File

@ -35,6 +35,8 @@ uses
Controls, Graphics, SysUtils, Classes;
type
TJvHTMLTextPos = (tpNormal, tpSubScript, tpSuperScript);
TJvHTMLElement = class(TObject)
private
FFontSize: Integer;
@ -49,6 +51,7 @@ type
FSolText: string;
FEolText: string;
FBreakLine: Boolean;
FPosition: TJvHTMLTextPos;
procedure SetFontName(const Value: string);
procedure SetFontSize(const Value: Integer);
procedure SetFontStyle(const Value: TFontStyles);
@ -75,6 +78,7 @@ type
property Width: Integer read FWidth write SetWidth;
property Ascent: Integer read FAscent write SetAscent;
property BreakLine: Boolean read FBreakLine write SetBreakLine;
property Position: TJvHtmlTextPos read FPosition write FPosition;
end;
TJvHTMLElementStack = class(TList)

41
components/jvcllaz/run/JvJans/jvmarkuplabel.pas
View File

@ -215,6 +215,7 @@ var
lName: string;
lSize: Integer;
lBreakLine: Boolean;
lPosition: TJvHtmlTextPos;
AColor, lColor: TColor;
Element: TJvHTMLElement;
@ -283,6 +284,7 @@ var
Element.FontSize := lSize;
Element.FontStyle := lStyle;
Element.FontColor := lColor;
Element.Position := lPosition;
Element.BreakLine := lBreakLine;
lBreakLine := False;
FElementStack.Push(Element);
@ -350,7 +352,16 @@ var
PushTag
else
if ATag = '/font' then
PopTag;
PopTag
else
if ATag = 'sub' then
lPosition := tpSubscript
else
if ATag = 'sup' then
lPosition := tpSuperscript
else if (ATag = '/sub') or (ATag = '/sup') then
lPosition := tpNormal
else
if HaveParams then
begin
repeat
@ -393,6 +404,7 @@ begin
lSize := Font.Size;
lColor := Font.Color;
lBreakLine := False;
lPosition := tpNormal;
repeat
P := Pos('<', S);
if P = 0 then
@ -447,15 +459,40 @@ var
var
SS: string;
WW: Integer;
yy: Integer;
oldFontHeight: Integer;
fd: TFontData;
begin
SetFont(EE);
if EE.SolText <> '' then
begin
oldFontHeight := Canvas.Font.Height;
SS := TrimLeft(EE.SolText);
case EE.Position of
tpNormal:
yy := Y + BaseLine - EE.Ascent;
tpSubscript:
begin
fd := GetFontData(Canvas.Font.Reference.Handle);
Canvas.Font.Height := fd.Height * 7 div 10;
yy := Y + MaxHeight - abs(fd.Height);
end;
tpSuperscript:
begin
fd := GetFontData(Canvas.Font.Reference.Handle);
Canvas.Font.Height := fd.Height * 7 div 10;
yy := Y;
end;
end;
WW := Canvas.TextWidth(SS);
if not Test then
Canvas.TextOut(X, Y + BaseLine - EE.Ascent, SS);
Canvas.TextOut(X, yy, SS);
X := X + WW;
if EE.Position <> tpNormal then
Canvas.Font.Height := oldFontHeight;
end;
end;

48
components/jvcllaz/run/JvJans/jvmarkupviewer.pas
View File

@ -222,6 +222,7 @@ var
FName: string;
FSize: Integer;
LBreakLine: Boolean;
LPosition: TJvHtmlTextpos;
AColor, FColor: TColor;
Element: TJvHTMLElement;
@ -282,6 +283,7 @@ var
Element.FontSize := FSize;
Element.FontStyle := FStyle;
Element.FontColor := FColor;
Element.Position := LPosition;
Element.BreakLine := LBreakLine;
LBreakLine := False;
FElementStack.Push(Element);
@ -349,7 +351,17 @@ var
PushTag
else
if LTag = '/font' then
PopTag;
PopTag
else
if LTag = 'sub' then
LPosition := tpSubscript
else
if LTag = 'sup' then
LPosition := tpSuperscript
else
if (LTag = '/sub') or (LTag = '/sup') then
LPosition := tpNormal
else
if HavePar then
begin
repeat
@ -391,6 +403,7 @@ begin
FName := Font.Name;
FSize := Font.Size;
FColor := Font.Color;
LPosition := tpNormal;
LBreakLine := False;
repeat
p := Pos('<', s);
@ -433,14 +446,20 @@ var
PendingBreak: Boolean;
procedure SetFont(AElem: TJvHTMLElement);
var
fd: TFontData;
begin
with FBmp.Canvas do
begin
if SameText(AElem.FontName, 'default') then
Font.Name := Screen.MenuFont.Name else
Font.Name := Screen.MenuFont.Name
else
Font.Name := AElem.FontName;
if AElem.FontSize = 0 then
Font.Size := 10 else
begin
fd := GetFontData(Font.Reference.Handle);
Font.Height := fd.Height;
end else
Font.Size := AElem.FontSize;
Font.Style := AElem.FontStyle;
Font.Color := AElem.FontColor;
@ -451,14 +470,35 @@ var
var
SS: string;
w: Integer;
yy: Integer;
oldFontSize: Integer;
begin
SetFont(ee);
if ee.SolText <> '' then
begin
oldFontSize := FBmp.Canvas.Font.Size;
SS := ee.SolText;
case ee.Position of
tpNormal:
begin
yy := Y + Baseline - ee.Ascent - FrameTop;
end;
tpSubscript:
begin
FBmp.Canvas.Font.Height := FBmp.Canvas.Font.Height * 7 div 10;
yy := Y + MaxHeight - abs(FBmp.Canvas.Font.Height) - FrameTop;
end;
tpSuperscript:
begin
yy := Y - FrameTop;
FBmp.Canvas.Font.Height := FBmp.Canvas.Font.Height * 7 div 10;
end;
end;
w := FBmp.Canvas.TextWidth(SS);
FBmp.Canvas.TextOut(X, Y + BaseLine - ee.Ascent - FrameTop, SS);
FBmp.Canvas.TextOut(X, yy, SS);
X := X + w;
if ee.Position <> tpNormal then
FBmp.Canvas.Font.Size := oldFontSize;
end;
end;