paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-06 04:26:17 +02:00
Code Issues Packages Projects Releases Wiki Activity

fpvectorial: Add 2-lines-text test to visual tests.

Browse Source
This commit is contained in:
wp_xyz 2023-01-18 00:18:46 +01:00
parent 020d5d64ad
commit b05560e6e5
3 changed files with 156 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
components/fpvectorial/tests/visualtest.lpi
View File

@ -1,18 +1,17 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<Version Value="12"/>
<PathDelim Value="\"/>
<General>
<Flags>
<CompatibilityMode Value="True"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="visualtest"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
</General>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
@ -20,9 +19,10 @@
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
<FormatVersion Value="2"/>
<Modes Count="1">
<Mode0 Name="default"/>
</Modes>
</RunParams>
<RequiredPackages Count="2">
<Item1>
@ -70,6 +70,7 @@
</CodeGeneration>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf3"/>
<UseExternalDbgSyms Value="True"/>
</Debugging>
<Options>

23
components/fpvectorial/tests/vtmain.lfm
View File

@ -9,7 +9,7 @@ object MainForm: TMainForm
OnCreate = FormCreate
OnDestroy = FormDestroy
ShowHint = True
LCLVersion = '1.7'
LCLVersion = '2.3.0.0'
object GbTree: TGroupBox
Left = 4
Height = 686
@ -31,7 +31,6 @@ object MainForm: TMainForm
Align = alClient
BorderSpacing.Bottom = 4
BorderSpacing.Around = 4
DefaultItemHeight = 18
HideSelection = False
ParentFont = False
ReadOnly = True
@ -153,7 +152,7 @@ object MainForm: TMainForm
Left = 4
Height = 128
Top = 130
Width = 118
Width = 116
AutoSize = True
BorderSpacing.Left = 4
BorderSpacing.Top = 6
@ -161,7 +160,7 @@ object MainForm: TMainForm
BorderSpacing.Bottom = 4
Caption = 'Origin at BOTTOM'
ClientHeight = 108
ClientWidth = 114
ClientWidth = 112
ParentFont = False
TabOrder = 0
object BottomLeftPaintbox: TPaintBox
@ -184,7 +183,7 @@ object MainForm: TMainForm
AnchorSideTop.Control = gbBottomLeft
AnchorSideBottom.Control = gbRenderTest
AnchorSideBottom.Side = asrBottom
Left = 130
Left = 128
Height = 128
Top = 130
Width = 114
@ -377,7 +376,7 @@ object MainForm: TMainForm
Left = 4
Height = 129
Top = 156
Width = 209
Width = 210
AutoSize = True
BorderSpacing.Left = 4
BorderSpacing.Top = 8
@ -385,7 +384,7 @@ object MainForm: TMainForm
BorderSpacing.Bottom = 8
Caption = 'Written with origin at BOTTOM'
ClientHeight = 109
ClientWidth = 205
ClientWidth = 206
ParentFont = False
TabOrder = 0
object BtnViewBottomLeft: TButton
@ -396,7 +395,7 @@ object MainForm: TMainForm
Left = 114
Height = 25
Top = 42
Width = 87
Width = 88
AutoSize = True
BorderSpacing.Left = 8
BorderSpacing.Right = 4
@ -508,17 +507,17 @@ object MainForm: TMainForm
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = CbFileFormat
AnchorSideTop.Side = asrBottom
Left = 221
Left = 222
Height = 129
Top = 156
Width = 212
Width = 213
AutoSize = True
BorderSpacing.Left = 8
BorderSpacing.Top = 8
BorderSpacing.Bottom = 8
Caption = 'Written with origin at TOP'
ClientHeight = 109
ClientWidth = 208
ClientWidth = 209
ParentFont = False
TabOrder = 3
object BtnViewTopLeft: TButton
@ -529,7 +528,7 @@ object MainForm: TMainForm
Left = 114
Height = 25
Top = 41
Width = 90
Width = 91
AutoSize = True
BorderSpacing.Left = 8
BorderSpacing.Right = 4

147
components/fpvectorial/tests/vtmain.pas
View File

@ -119,10 +119,14 @@ type
// Bezier
procedure Render_Bezier(Apage: TvVectorialPage; AIntParam: Integer);
// Text
// Text - single line
procedure Render_Text(APage: TvVectorialpage; AIntParam: Integer);
procedure Render_Text_Fonts(APage: TvVectorialPage; AIntParam: Integer);
procedure Render_Text_Colors(APage: TvVectorialPage; AIntParam: Integer);
// Text as paragraph: 2 lines
procedure Render_2Lines(APage: TvVectorialPage; AIntParam: Integer);
public
{ public declarations }
end;
@ -141,6 +145,7 @@ uses
const
IMG_FOLDER = 'images' + PathDelim;
REFIMG_FOLDER = IMG_FOLDER + 'ref' + PathDelim;
NOT_SAVED = '(not saved)';
@ -184,8 +189,8 @@ begin
try
png.Assign(bmp);
// renderParams := TRenderParams(Tree.Selected.Data);
ForceDirectory(IMG_FOLDER);
fn := IncludeTrailingPathDelimiter(IMG_FOLDER) + renderParams.RefFile;
ForceDirectory(REFIMG_FOLDER);
fn := REFIMG_FOLDER + renderParams.RefFile;
png.SaveToFile(fn);
finally
png.Free;
@ -706,7 +711,9 @@ begin
{ -----------------------------------------------}
node0 := Tree.Items.AddChild(nil, 'Text');
{ -----------------------------------------------}
node := Tree.Items.AddChild(node0, 'horizontal');
node1 := Tree.Items.AddChild(node0, 'single line');
node := Tree.Items.AddChild(node1, 'horizontal');
Tree.Items.AddChildObject(node, 'left aligned',
TRenderParams.Create(@Render_Text, 'text_left.png', $0000));
Tree.Items.AddChildObject(node, 'centered',
@ -714,7 +721,7 @@ begin
Tree.Items.AddChildObject(node, 'right aligned',
TRenderParams.Create(@Render_Text, 'text_right.png', $0002));
node := Tree.Items.AddChild(node0, 'rotated by 30 deg');
node := Tree.Items.AddChild(node1, 'rotated by 30 deg');
Tree.Items.AddChildObject(node, 'left aligned',
TRenderParams.Create(@Render_Text, 'text_left_30.png', $1000));
Tree.Items.AddChildObject(node, 'centered',
@ -722,7 +729,7 @@ begin
Tree.Items.AddChildObject(node, 'right aligned',
TRenderParams.Create(@Render_Text, 'text_right_30.png', $1002));
node := Tree.Items.AddChild(node0, 'vertical (90 deg, upward)');
node := Tree.Items.AddChild(node1, 'vertical (90 deg, upward)');
Tree.Items.AddChildObject(node, 'left aligned',
TRenderParams.Create(@Render_Text, 'text_left_90.png', $2000));
Tree.Items.AddChildObject(node, 'centered',
@ -730,7 +737,7 @@ begin
Tree.Items.AddChildObject(node, 'right aligned',
TRenderParams.Create(@Render_Text, 'text_right_90.png', $2002));
node := Tree.Items.AddChild(node0, 'vertical (-90 deg, downward)');
node := Tree.Items.AddChild(node1, 'vertical (-90 deg, downward)');
Tree.Items.AddChildObject(node, 'left aligned',
TRenderParams.Create(@Render_Text, 'text_left_m90.png', $3000));
Tree.Items.AddChildObject(node, 'centered',
@ -738,6 +745,42 @@ begin
Tree.Items.AddChildObject(node, 'right aligned',
TRenderParams.Create(@Render_Text, 'text_right_m90.png', $3002));
// ----
node1 := Tree.Items.AddChild(node0, 'two lines');
node := Tree.Items.AddChild(node1, 'horizontal');
Tree.Items.AddChildObject(node, 'left aligned',
TRenderParams.Create(@Render_2Lines, 'text2_left.png', $0000));
Tree.Items.AddChildObject(node, 'centered',
TRenderParams.Create(@Render_2Lines, 'text2_center.png', $0001));
Tree.Items.AddChildObject(node, 'right aligned',
TRenderParams.Create(@Render_2Lines, 'text2_right.png', $0002));
node := Tree.Items.AddChild(node1, 'rotated by 30 deg');
Tree.Items.AddChildObject(node, 'left aligned',
TRenderParams.Create(@Render_2Lines, 'text2_left_30.png', $1000));
Tree.Items.AddChildObject(node, 'centered',
TRenderParams.Create(@Render_2Lines, 'text2_center_30.png', $1001));
Tree.Items.AddChildObject(node, 'right aligned',
TRenderParams.Create(@Render_2Lines, 'text2_right_30.png', $1002));
node := Tree.Items.AddChild(node1, 'vertical (90 deg, upward)');
Tree.Items.AddChildObject(node, 'left aligned',
TRenderParams.Create(@Render_2Lines, 'text2_left_90.png', $2000));
Tree.Items.AddChildObject(node, 'centered',
TRenderParams.Create(@Render_2Lines, 'text2_center_90.png', $2001));
Tree.Items.AddChildObject(node, 'right aligned',
TRenderParams.Create(@Render_2Lines, 'text2_right_90.png', $2002));
node := Tree.Items.AddChild(node1, 'vertical (-90 deg, downward)');
Tree.Items.AddChildObject(node, 'left aligned',
TRenderParams.Create(@Render_2Lines, 'text2_left_m90.png', $3000));
Tree.Items.AddChildObject(node, 'centered',
TRenderParams.Create(@Render_2Lines, 'text2_center_m90.png', $3001));
Tree.Items.AddChildObject(node, 'right aligned',
TRenderParams.Create(@Render_2Lines, 'text2_right_m90.png', $3002));
// ----
node := Tree.Items.AddChild(node0, 'Fonts');
Tree.Items.AddChildObject(node, 'Times New Roman + Courier New',
TRenderParams.Create(@Render_Text_Fonts, 'text_fonts.png'));
@ -980,14 +1023,87 @@ begin
APage.AddEntity(txt);
end;
procedure TMainForm.Render_2Lines(APage: TvVectorialPage; AIntParam: Integer);
{ AIntParam and $000F = $0000 --> anchor at left
$0001 --> anchor at center
$0002 --> anchor at right
AIntParam and $F000 = $0000 --> horizontal
$1000 --> rotated 30deg
$2000 --> rotated 90deg
$3000 --> rotated -90deg }
const
XTEXT = 50;
YTEXT = 40; // we assume that y points up
L = 10;
var
para: TvParagraph;
txt: TvText;
p: TPath;
angle: double;
anchor: TvTextAnchor;
begin
case AIntParam and $000F of
$0000 : anchor := vtaStart;
$0001 : anchor := vtaMiddle;
$0002 : anchor := vtaEnd;
else raise Exception.Create('Text anchor not supported');
end;
case AIntParam and $F000 of
$0000 : angle := 0;
$1000 : angle := 30;
$2000 : angle := 90;
$3000 : angle := -90;
else raise Exception.Create('Text angle not supported.');
end;
// Draw "+" at the origin of the first line of the text
if APage.UseTopLeftCoordinates then begin
APage.StartPath (XTEXT - L, PAGE_SIZE - YTEXT);
APage.AddLineToPath(XTEXT + L, PAGE_SIZE - YTEXT);
APage.AddMoveToPath(XTEXT, PAGE_SIZE - YTEXT - L);
APage.AddLineToPath(XTEXT, PAGE_SIZE - YTEXT + L);
end else begin
APage.StartPath (XTEXT - L, YTEXT);
APage.AddLineToPath(XTEXT + L, YTEXT);
APage.AddMoveToPath(XTEXT, YTEXT - L);
APage.AddLineToPath(XTEXT, YTEXT + L);
end;
p := APage.EndPath;
p.Pen.Width := 1;
p.Pen.Color := colRed;
// Create paragraph
para := TvParagraph.Create(APage);
para.X := XTEXT;
if APage.UseTopLeftCoordinates then
para.Y := PAGE_SIZE - YTEXT
else
para.Y := YTEXT;
para.Font.Size := 16;
para.TextAnchor := anchor;
para.Font.Orientation := angle;
// Add text to the paragraph
txt := para.AddText('ABCDE');
txt := para.AddText('Fghij');
txt.Y := txt.Y + 1.5 * txt.Font.Size * APage.GetTopLeftCoords_Adjustment();
APage.AddEntity(para);
end;
procedure TMainForm.Render_Text_Fonts(APage: TvVectorialPage;
AIntParam: Integer);
var
txt: TvText;
yText: Integer;
begin
txt := TvText.Create(APage);
txt.X := 10;
txt.Y := 80;
yText := 80;
if APage.UseTopLeftCoordinates then
txt.Y := PAGE_SIZE - yText
else
txt.Y := yText;
txt.Font.Name := 'Times New Roman';
txt.Font.Size := 10;
txt.Value.Add('Times');
@ -995,7 +1111,11 @@ begin
txt := TvText.Create(APage);
txt.X := 10;
txt.Y := 60;
yText := 60;
if APage.UseTopLeftCoordinates then
txt.Y := PAGE_SIZE - yText
else
txt.Y := yText;
txt.Font.Name := 'Courier New';
txt.Font.Size := 12;
txt.Value.Add('Courier');
@ -1004,12 +1124,17 @@ end;
procedure TMainForm.Render_Text_Colors(APage: TvVectorialPage;
AIntParam: Integer);
const
YTEXT = 80;
var
txt: TvText;
begin
txt := TvText.Create(APage);
txt.X := 10;
txt.Y := 80;
if APage.UseTopLeftCoordinates then
txt.Y := PAGE_SIZE - YTEXT
else
txt.Y := YTEXT;
txt.Font.Name := 'Times New Roman';
txt.Font.Size := 14;
txt.Font.Color := colRed;
@ -1113,7 +1238,7 @@ begin
exit;
end;
fn := IncludeTrailingPathDelimiter(IMG_FOLDER) + renderParams.RefFile;
fn := IncludeTrailingPathDelimiter(REFIMG_FOLDER) + renderParams.RefFile;
if FileExists(fn) then begin
RefImage.Picture.LoadFromFile(fn);
RefImage.Hint := fn;