mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-06-09 18:18:20 +02:00
fpvectorial: Add visual test project.
git-svn-id: trunk@52893 -
This commit is contained in:
wp
parent
f0ee118264
commit
c60a2bf1d2
5
.gitattributes
vendored
5
.gitattributes
vendored
@ -1553,6 +1553,11 @@ components/fpvectorial/svgvectorialreader.pas svneol=native#text/plain
|
|||||||
components/fpvectorial/svgvectorialreader_rsvg.pas svneol=native#text/pascal
|
components/fpvectorial/svgvectorialreader_rsvg.pas svneol=native#text/pascal
|
||||||
components/fpvectorial/svgvectorialwriter.pas svneol=native#text/plain
|
components/fpvectorial/svgvectorialwriter.pas svneol=native#text/plain
|
||||||
components/fpvectorial/svgzvectorialreader.pas svneol=native#text/pascal
|
components/fpvectorial/svgzvectorialreader.pas svneol=native#text/pascal
|
||||||
|
components/fpvectorial/tests/visualtest.lpi svneol=native#text/plain
|
||||||
|
components/fpvectorial/tests/visualtest.lpr svneol=native#text/plain
|
||||||
|
components/fpvectorial/tests/vtmain.lfm svneol=native#text/plain
|
||||||
|
components/fpvectorial/tests/vtmain.pas svneol=native#text/plain
|
||||||
|
components/fpvectorial/tests/vtprimitives.pas svneol=native#text/plain
|
||||||
components/fpvectorial/tools/laszip/laszip.lpi svneol=native#text/plain
|
components/fpvectorial/tools/laszip/laszip.lpi svneol=native#text/plain
|
||||||
components/fpvectorial/tools/laszip/laszip.pas svneol=native#text/plain
|
components/fpvectorial/tools/laszip/laszip.pas svneol=native#text/plain
|
||||||
components/fpvectorial/wmfvectorialreader.pas svneol=native#text/plain
|
components/fpvectorial/wmfvectorialreader.pas svneol=native#text/plain
|
||||||
|
|||||||
95
components/fpvectorial/tests/visualtest.lpi
Normal file
95
components/fpvectorial/tests/visualtest.lpi
Normal file
@ -0,0 +1,95 @@
|
|||||||
|
<?xml version="1.0" encoding="UTF-8"?>
|
||||||
|
<CONFIG>
|
||||||
|
<ProjectOptions>
|
||||||
|
<Version Value="9"/>
|
||||||
|
<PathDelim Value="\"/>
|
||||||
|
<General>
|
||||||
|
<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>
|
||||||
|
<PublishOptions>
|
||||||
|
<Version Value="2"/>
|
||||||
|
</PublishOptions>
|
||||||
|
<RunParams>
|
||||||
|
<local>
|
||||||
|
<FormatVersion Value="1"/>
|
||||||
|
</local>
|
||||||
|
</RunParams>
|
||||||
|
<RequiredPackages Count="2">
|
||||||
|
<Item1>
|
||||||
|
<PackageName Value="fpvectorialpkg"/>
|
||||||
|
</Item1>
|
||||||
|
<Item2>
|
||||||
|
<PackageName Value="LCL"/>
|
||||||
|
</Item2>
|
||||||
|
</RequiredPackages>
|
||||||
|
<Units Count="3">
|
||||||
|
<Unit0>
|
||||||
|
<Filename Value="visualtest.lpr"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
</Unit0>
|
||||||
|
<Unit1>
|
||||||
|
<Filename Value="vtmain.pas"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<ComponentName Value="MainForm"/>
|
||||||
|
<HasResources Value="True"/>
|
||||||
|
<ResourceBaseClass Value="Form"/>
|
||||||
|
</Unit1>
|
||||||
|
<Unit2>
|
||||||
|
<Filename Value="vtprimitives.pas"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
</Unit2>
|
||||||
|
</Units>
|
||||||
|
</ProjectOptions>
|
||||||
|
<CompilerOptions>
|
||||||
|
<Version Value="11"/>
|
||||||
|
<PathDelim Value="\"/>
|
||||||
|
<Target>
|
||||||
|
<Filename Value="visualtest"/>
|
||||||
|
</Target>
|
||||||
|
<SearchPaths>
|
||||||
|
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||||
|
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||||
|
</SearchPaths>
|
||||||
|
<CodeGeneration>
|
||||||
|
<Checks>
|
||||||
|
<IOChecks Value="True"/>
|
||||||
|
<RangeChecks Value="True"/>
|
||||||
|
<OverflowChecks Value="True"/>
|
||||||
|
<StackChecks Value="True"/>
|
||||||
|
</Checks>
|
||||||
|
</CodeGeneration>
|
||||||
|
<Linking>
|
||||||
|
<Debugging>
|
||||||
|
<UseExternalDbgSyms Value="True"/>
|
||||||
|
</Debugging>
|
||||||
|
<Options>
|
||||||
|
<Win32>
|
||||||
|
<GraphicApplication Value="True"/>
|
||||||
|
</Win32>
|
||||||
|
</Options>
|
||||||
|
</Linking>
|
||||||
|
</CompilerOptions>
|
||||||
|
<Debugging>
|
||||||
|
<Exceptions Count="3">
|
||||||
|
<Item1>
|
||||||
|
<Name Value="EAbort"/>
|
||||||
|
</Item1>
|
||||||
|
<Item2>
|
||||||
|
<Name Value="ECodetoolError"/>
|
||||||
|
</Item2>
|
||||||
|
<Item3>
|
||||||
|
<Name Value="EFOpenError"/>
|
||||||
|
</Item3>
|
||||||
|
</Exceptions>
|
||||||
|
</Debugging>
|
||||||
|
</CONFIG>
|
||||||
20
components/fpvectorial/tests/visualtest.lpr
Normal file
20
components/fpvectorial/tests/visualtest.lpr
Normal file
@ -0,0 +1,20 @@
|
|||||||
|
program visualtest;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
uses
|
||||||
|
{$IFDEF UNIX}{$IFDEF UseCThreads}
|
||||||
|
cthreads,
|
||||||
|
{$ENDIF}{$ENDIF}
|
||||||
|
Interfaces, // this includes the LCL widgetset
|
||||||
|
Forms,vtmain, fpvectorialpkg;
|
||||||
|
|
||||||
|
{$R *.res}
|
||||||
|
|
||||||
|
begin
|
||||||
|
RequireDerivedFormResource := True;
|
||||||
|
Application.Initialize;
|
||||||
|
Application.CreateForm(TMainForm, MainForm);
|
||||||
|
Application.Run;
|
||||||
|
end.
|
||||||
|
|
||||||
512
components/fpvectorial/tests/vtmain.lfm
Normal file
512
components/fpvectorial/tests/vtmain.lfm
Normal file
@ -0,0 +1,512 @@
|
|||||||
|
object MainForm: TMainForm
|
||||||
|
Left = 335
|
||||||
|
Height = 578
|
||||||
|
Top = 155
|
||||||
|
Width = 852
|
||||||
|
Caption = 'Visual fpvectorial test'
|
||||||
|
ClientHeight = 578
|
||||||
|
ClientWidth = 852
|
||||||
|
OnCreate = FormCreate
|
||||||
|
OnDestroy = FormDestroy
|
||||||
|
ShowHint = True
|
||||||
|
LCLVersion = '1.7'
|
||||||
|
object GbTree: TGroupBox
|
||||||
|
Left = 4
|
||||||
|
Height = 570
|
||||||
|
Top = 4
|
||||||
|
Width = 304
|
||||||
|
Align = alClient
|
||||||
|
BorderSpacing.Around = 4
|
||||||
|
Caption = 'Test shapes and objects'
|
||||||
|
ClientHeight = 550
|
||||||
|
ClientWidth = 300
|
||||||
|
Font.Style = [fsBold]
|
||||||
|
ParentFont = False
|
||||||
|
TabOrder = 0
|
||||||
|
object Tree: TTreeView
|
||||||
|
Left = 4
|
||||||
|
Height = 538
|
||||||
|
Top = 4
|
||||||
|
Width = 292
|
||||||
|
Align = alClient
|
||||||
|
BorderSpacing.Bottom = 4
|
||||||
|
BorderSpacing.Around = 4
|
||||||
|
DefaultItemHeight = 18
|
||||||
|
HideSelection = False
|
||||||
|
ParentFont = False
|
||||||
|
ReadOnly = True
|
||||||
|
TabOrder = 0
|
||||||
|
OnCustomDrawItem = TreeCustomDrawItem
|
||||||
|
OnSelectionChanged = TreeSelectionChanged
|
||||||
|
Options = [tvoAutoItemHeight, tvoKeepCollapsedNodes, tvoReadOnly, tvoShowButtons, tvoShowLines, tvoShowRoot, tvoToolTips, tvoThemedDraw]
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object ScrollBox1: TScrollBox
|
||||||
|
Left = 312
|
||||||
|
Height = 578
|
||||||
|
Top = 0
|
||||||
|
Width = 540
|
||||||
|
HorzScrollBar.Increment = 29
|
||||||
|
HorzScrollBar.Page = 291
|
||||||
|
HorzScrollBar.Smooth = True
|
||||||
|
HorzScrollBar.Tracking = True
|
||||||
|
VertScrollBar.Increment = 57
|
||||||
|
VertScrollBar.Page = 578
|
||||||
|
VertScrollBar.Smooth = True
|
||||||
|
VertScrollBar.Tracking = True
|
||||||
|
Align = alRight
|
||||||
|
BorderStyle = bsNone
|
||||||
|
ClientHeight = 578
|
||||||
|
ClientWidth = 523
|
||||||
|
TabOrder = 1
|
||||||
|
object AllTestsPanel: TPanel
|
||||||
|
Left = 4
|
||||||
|
Height = 599
|
||||||
|
Top = 4
|
||||||
|
Width = 511
|
||||||
|
Align = alTop
|
||||||
|
AutoSize = True
|
||||||
|
BorderSpacing.Right = 4
|
||||||
|
BorderSpacing.Around = 4
|
||||||
|
BevelOuter = bvNone
|
||||||
|
ClientHeight = 599
|
||||||
|
ClientWidth = 511
|
||||||
|
TabOrder = 0
|
||||||
|
object gbRenderTest: TGroupBox
|
||||||
|
AnchorSideBottom.Control = gbReferenceImageTest
|
||||||
|
AnchorSideBottom.Side = asrBottom
|
||||||
|
Left = 0
|
||||||
|
Height = 261
|
||||||
|
Top = 0
|
||||||
|
Width = 248
|
||||||
|
Anchors = [akTop, akLeft, akRight, akBottom]
|
||||||
|
BorderSpacing.Right = 31
|
||||||
|
Caption = 'Render test'
|
||||||
|
ClientHeight = 241
|
||||||
|
ClientWidth = 244
|
||||||
|
Font.Style = [fsBold]
|
||||||
|
ParentFont = False
|
||||||
|
TabOrder = 0
|
||||||
|
object Label6: TLabel
|
||||||
|
Left = 8
|
||||||
|
Height = 30
|
||||||
|
Top = 2
|
||||||
|
Width = 232
|
||||||
|
Align = alTop
|
||||||
|
BorderSpacing.Left = 8
|
||||||
|
BorderSpacing.Top = 2
|
||||||
|
BorderSpacing.Right = 4
|
||||||
|
Caption = 'The selected shape is rendered in two coordinate systems:'
|
||||||
|
ParentColor = False
|
||||||
|
ParentFont = False
|
||||||
|
WordWrap = True
|
||||||
|
end
|
||||||
|
object Label8: TLabel
|
||||||
|
Left = 16
|
||||||
|
Height = 15
|
||||||
|
Top = 36
|
||||||
|
Width = 224
|
||||||
|
Align = alTop
|
||||||
|
BorderSpacing.Left = 16
|
||||||
|
BorderSpacing.Top = 4
|
||||||
|
BorderSpacing.Right = 4
|
||||||
|
Caption = 'origin at bottom/left corner (fpv default)'
|
||||||
|
ParentColor = False
|
||||||
|
ParentFont = False
|
||||||
|
WordWrap = True
|
||||||
|
end
|
||||||
|
object Label7: TLabel
|
||||||
|
Left = 16
|
||||||
|
Height = 15
|
||||||
|
Top = 55
|
||||||
|
Width = 224
|
||||||
|
Align = alTop
|
||||||
|
BorderSpacing.Left = 16
|
||||||
|
BorderSpacing.Top = 4
|
||||||
|
BorderSpacing.Right = 4
|
||||||
|
Caption = 'origin at top/left corner'
|
||||||
|
ParentColor = False
|
||||||
|
ParentFont = False
|
||||||
|
WordWrap = True
|
||||||
|
end
|
||||||
|
object LblBothImagesMustMatch: TLabel
|
||||||
|
Left = 8
|
||||||
|
Height = 15
|
||||||
|
Top = 74
|
||||||
|
Width = 232
|
||||||
|
Align = alTop
|
||||||
|
BorderSpacing.Left = 8
|
||||||
|
BorderSpacing.Top = 4
|
||||||
|
BorderSpacing.Right = 4
|
||||||
|
Caption = 'Both images must match.'
|
||||||
|
Font.Style = [fsBold]
|
||||||
|
ParentColor = False
|
||||||
|
ParentFont = False
|
||||||
|
WordWrap = True
|
||||||
|
end
|
||||||
|
object gbBottomLeft: TGroupBox
|
||||||
|
AnchorSideLeft.Control = gbRenderTest
|
||||||
|
AnchorSideTop.Side = asrBottom
|
||||||
|
AnchorSideBottom.Control = gbRenderTest
|
||||||
|
AnchorSideBottom.Side = asrBottom
|
||||||
|
Left = 4
|
||||||
|
Height = 129
|
||||||
|
Top = 108
|
||||||
|
Width = 112
|
||||||
|
Anchors = [akLeft, akBottom]
|
||||||
|
AutoSize = True
|
||||||
|
BorderSpacing.Left = 4
|
||||||
|
BorderSpacing.Right = 4
|
||||||
|
BorderSpacing.Bottom = 4
|
||||||
|
Caption = 'Origin at bottom'
|
||||||
|
ClientHeight = 109
|
||||||
|
ClientWidth = 108
|
||||||
|
ParentFont = False
|
||||||
|
TabOrder = 0
|
||||||
|
object BottomLeftPaintbox: TPaintBox
|
||||||
|
AnchorSideTop.Control = gbBottomLeft
|
||||||
|
Left = 4
|
||||||
|
Height = 100
|
||||||
|
Top = 3
|
||||||
|
Width = 100
|
||||||
|
BorderSpacing.Left = 4
|
||||||
|
BorderSpacing.Top = 3
|
||||||
|
BorderSpacing.Right = 4
|
||||||
|
BorderSpacing.Bottom = 6
|
||||||
|
OnPaint = PaintBoxPaint
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object gbTopLeft: TGroupBox
|
||||||
|
AnchorSideLeft.Control = gbBottomLeft
|
||||||
|
AnchorSideLeft.Side = asrBottom
|
||||||
|
AnchorSideTop.Side = asrBottom
|
||||||
|
AnchorSideBottom.Control = gbRenderTest
|
||||||
|
AnchorSideBottom.Side = asrBottom
|
||||||
|
Left = 124
|
||||||
|
Height = 129
|
||||||
|
Top = 108
|
||||||
|
Width = 112
|
||||||
|
Anchors = [akLeft, akBottom]
|
||||||
|
AutoSize = True
|
||||||
|
BorderSpacing.Left = 8
|
||||||
|
BorderSpacing.Right = 8
|
||||||
|
BorderSpacing.Bottom = 4
|
||||||
|
Caption = 'Origin at top'
|
||||||
|
ClientHeight = 109
|
||||||
|
ClientWidth = 108
|
||||||
|
ParentFont = False
|
||||||
|
TabOrder = 1
|
||||||
|
object TopLeftPaintbox: TPaintBox
|
||||||
|
AnchorSideTop.Control = gbTopLeft
|
||||||
|
Left = 4
|
||||||
|
Height = 100
|
||||||
|
Top = 3
|
||||||
|
Width = 100
|
||||||
|
BorderSpacing.Left = 4
|
||||||
|
BorderSpacing.Top = 3
|
||||||
|
BorderSpacing.Right = 4
|
||||||
|
BorderSpacing.Bottom = 6
|
||||||
|
OnPaint = PaintBoxPaint
|
||||||
|
end
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object gbReferenceImageTest: TGroupBox
|
||||||
|
AnchorSideRight.Control = AllTestsPanel
|
||||||
|
AnchorSideRight.Side = asrBottom
|
||||||
|
Left = 266
|
||||||
|
Height = 261
|
||||||
|
Top = 0
|
||||||
|
Width = 245
|
||||||
|
Anchors = [akTop, akRight]
|
||||||
|
Caption = 'Reference image test'
|
||||||
|
ClientHeight = 241
|
||||||
|
ClientWidth = 241
|
||||||
|
Font.Style = [fsBold]
|
||||||
|
ParentFont = False
|
||||||
|
TabOrder = 1
|
||||||
|
object Label10: TLabel
|
||||||
|
Left = 8
|
||||||
|
Height = 30
|
||||||
|
Top = 2
|
||||||
|
Width = 225
|
||||||
|
Align = alTop
|
||||||
|
BorderSpacing.Left = 8
|
||||||
|
BorderSpacing.Top = 2
|
||||||
|
BorderSpacing.Right = 8
|
||||||
|
Caption = 'Save the bottom-origin image of the "Render test" to a bitmap file for reference.'
|
||||||
|
ParentColor = False
|
||||||
|
ParentFont = False
|
||||||
|
WordWrap = True
|
||||||
|
end
|
||||||
|
object Label11: TLabel
|
||||||
|
Left = 8
|
||||||
|
Height = 30
|
||||||
|
Top = 36
|
||||||
|
Width = 225
|
||||||
|
Align = alTop
|
||||||
|
BorderSpacing.Left = 8
|
||||||
|
BorderSpacing.Top = 4
|
||||||
|
BorderSpacing.Right = 8
|
||||||
|
Caption = 'This reference image is loaded for each test shape/object.'
|
||||||
|
ParentColor = False
|
||||||
|
ParentFont = False
|
||||||
|
WordWrap = True
|
||||||
|
end
|
||||||
|
object LblRefImgMustMatch: TLabel
|
||||||
|
Left = 8
|
||||||
|
Height = 30
|
||||||
|
Top = 70
|
||||||
|
Width = 225
|
||||||
|
Align = alTop
|
||||||
|
BorderSpacing.Left = 8
|
||||||
|
BorderSpacing.Top = 4
|
||||||
|
BorderSpacing.Right = 8
|
||||||
|
Caption = 'The reference image must match the "Render test" images.'
|
||||||
|
Font.Style = [fsBold]
|
||||||
|
ParentColor = False
|
||||||
|
ParentFont = False
|
||||||
|
WordWrap = True
|
||||||
|
end
|
||||||
|
object BtnSaveAsRef: TButton
|
||||||
|
AnchorSideLeft.Control = GroupBox1
|
||||||
|
AnchorSideLeft.Side = asrBottom
|
||||||
|
AnchorSideTop.Control = GroupBox1
|
||||||
|
AnchorSideTop.Side = asrCenter
|
||||||
|
AnchorSideBottom.Side = asrBottom
|
||||||
|
Left = 132
|
||||||
|
Height = 25
|
||||||
|
Top = 160
|
||||||
|
Width = 75
|
||||||
|
BorderSpacing.Left = 16
|
||||||
|
BorderSpacing.Bottom = 10
|
||||||
|
Caption = 'Save as ref'
|
||||||
|
OnClick = BtnSaveAsRefClick
|
||||||
|
ParentFont = False
|
||||||
|
TabOrder = 0
|
||||||
|
end
|
||||||
|
object GroupBox1: TGroupBox
|
||||||
|
AnchorSideLeft.Control = gbReferenceImageTest
|
||||||
|
AnchorSideTop.Control = LblRefImgMustMatch
|
||||||
|
AnchorSideTop.Side = asrBottom
|
||||||
|
AnchorSideBottom.Control = gbReferenceImageTest
|
||||||
|
AnchorSideBottom.Side = asrBottom
|
||||||
|
Left = 4
|
||||||
|
Height = 129
|
||||||
|
Top = 108
|
||||||
|
Width = 112
|
||||||
|
AutoSize = True
|
||||||
|
BorderSpacing.Left = 4
|
||||||
|
BorderSpacing.Top = 8
|
||||||
|
BorderSpacing.Bottom = 4
|
||||||
|
Caption = 'Reference image'
|
||||||
|
ClientHeight = 109
|
||||||
|
ClientWidth = 108
|
||||||
|
ParentFont = False
|
||||||
|
TabOrder = 1
|
||||||
|
object RefImage: TImage
|
||||||
|
AnchorSideTop.Control = GroupBox1
|
||||||
|
Left = 4
|
||||||
|
Height = 100
|
||||||
|
Top = 3
|
||||||
|
Width = 100
|
||||||
|
BorderSpacing.Left = 4
|
||||||
|
BorderSpacing.Top = 3
|
||||||
|
BorderSpacing.Right = 4
|
||||||
|
BorderSpacing.Bottom = 6
|
||||||
|
end
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object gbReadWriteTest: TGroupBox
|
||||||
|
AnchorSideLeft.Control = gbRenderTest
|
||||||
|
AnchorSideTop.Control = gbReferenceImageTest
|
||||||
|
AnchorSideTop.Side = asrBottom
|
||||||
|
AnchorSideRight.Control = AllTestsPanel
|
||||||
|
AnchorSideRight.Side = asrBottom
|
||||||
|
Left = 0
|
||||||
|
Height = 314
|
||||||
|
Top = 285
|
||||||
|
Width = 511
|
||||||
|
Anchors = [akTop, akLeft, akRight]
|
||||||
|
BorderSpacing.Top = 24
|
||||||
|
Caption = 'Read/write test'
|
||||||
|
ClientHeight = 294
|
||||||
|
ClientWidth = 507
|
||||||
|
Font.Style = [fsBold]
|
||||||
|
ParentFont = False
|
||||||
|
TabOrder = 2
|
||||||
|
object Label13: TLabel
|
||||||
|
Left = 8
|
||||||
|
Height = 15
|
||||||
|
Top = 2
|
||||||
|
Width = 491
|
||||||
|
Align = alTop
|
||||||
|
BorderSpacing.Left = 8
|
||||||
|
BorderSpacing.Top = 2
|
||||||
|
BorderSpacing.Right = 8
|
||||||
|
Caption = 'This test is for reading and writing of the selected shape to/from an svg or wmf file.'
|
||||||
|
ParentColor = False
|
||||||
|
ParentFont = False
|
||||||
|
WordWrap = True
|
||||||
|
end
|
||||||
|
object LblRefImgMustMatch1: TLabel
|
||||||
|
Left = 8
|
||||||
|
Height = 45
|
||||||
|
Top = 57
|
||||||
|
Width = 491
|
||||||
|
Align = alTop
|
||||||
|
BorderSpacing.Left = 8
|
||||||
|
BorderSpacing.Top = 4
|
||||||
|
BorderSpacing.Right = 8
|
||||||
|
Caption = 'If it does not click "View..." to open the image in an external viewer of the operating system. If the image is displayed correctly by the viewer there is a bug in the file reader, otherwise in the writer.'
|
||||||
|
ParentColor = False
|
||||||
|
ParentFont = False
|
||||||
|
WordWrap = True
|
||||||
|
end
|
||||||
|
object gbWMF: TGroupBox
|
||||||
|
AnchorSideLeft.Control = gbSVG
|
||||||
|
AnchorSideLeft.Side = asrBottom
|
||||||
|
AnchorSideTop.Control = LblRefImgMustMatch1
|
||||||
|
AnchorSideTop.Side = asrBottom
|
||||||
|
Left = 143
|
||||||
|
Height = 157
|
||||||
|
Top = 110
|
||||||
|
Width = 130
|
||||||
|
AutoSize = True
|
||||||
|
BorderSpacing.Left = 9
|
||||||
|
BorderSpacing.Top = 8
|
||||||
|
BorderSpacing.Bottom = 8
|
||||||
|
Caption = 'wmf'
|
||||||
|
ClientHeight = 137
|
||||||
|
ClientWidth = 126
|
||||||
|
ParentFont = False
|
||||||
|
TabOrder = 0
|
||||||
|
object BtnSaveAsWMF: TButton
|
||||||
|
AnchorSideLeft.Control = gbWMF
|
||||||
|
Left = 8
|
||||||
|
Height = 25
|
||||||
|
Top = 0
|
||||||
|
Width = 50
|
||||||
|
AutoSize = True
|
||||||
|
BorderSpacing.Left = 8
|
||||||
|
BorderSpacing.Bottom = 6
|
||||||
|
Caption = 'Save'
|
||||||
|
OnClick = BtnSaveToFileClick
|
||||||
|
TabOrder = 0
|
||||||
|
end
|
||||||
|
object BtnViewWMF: TButton
|
||||||
|
AnchorSideLeft.Control = BtnSaveAsWMF
|
||||||
|
AnchorSideLeft.Side = asrBottom
|
||||||
|
Left = 62
|
||||||
|
Height = 25
|
||||||
|
Top = 0
|
||||||
|
Width = 60
|
||||||
|
AutoSize = True
|
||||||
|
BorderSpacing.Left = 4
|
||||||
|
BorderSpacing.Right = 4
|
||||||
|
BorderSpacing.Bottom = 6
|
||||||
|
Caption = 'View...'
|
||||||
|
OnClick = BtnViewImageClick
|
||||||
|
TabOrder = 1
|
||||||
|
end
|
||||||
|
object WMFPaintBox: TPaintBox
|
||||||
|
AnchorSideLeft.Control = BtnSaveAsWMF
|
||||||
|
AnchorSideTop.Control = BtnSaveAsWMF
|
||||||
|
AnchorSideTop.Side = asrBottom
|
||||||
|
Left = 8
|
||||||
|
Height = 100
|
||||||
|
Top = 31
|
||||||
|
Width = 100
|
||||||
|
BorderSpacing.Bottom = 6
|
||||||
|
OnPaint = PaintBoxPaint
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object gbSVG: TGroupBox
|
||||||
|
AnchorSideLeft.Control = gbReadWriteTest
|
||||||
|
AnchorSideTop.Control = LblRefImgMustMatch1
|
||||||
|
AnchorSideTop.Side = asrBottom
|
||||||
|
Left = 4
|
||||||
|
Height = 157
|
||||||
|
Top = 110
|
||||||
|
Width = 130
|
||||||
|
AutoSize = True
|
||||||
|
BorderSpacing.Left = 4
|
||||||
|
BorderSpacing.Top = 8
|
||||||
|
BorderSpacing.Bottom = 8
|
||||||
|
Caption = 'svg'
|
||||||
|
ClientHeight = 137
|
||||||
|
ClientWidth = 126
|
||||||
|
ParentFont = False
|
||||||
|
TabOrder = 1
|
||||||
|
object BtnSaveAsSvg: TButton
|
||||||
|
AnchorSideLeft.Control = gbSVG
|
||||||
|
Left = 8
|
||||||
|
Height = 25
|
||||||
|
Top = 0
|
||||||
|
Width = 50
|
||||||
|
AutoSize = True
|
||||||
|
BorderSpacing.Left = 8
|
||||||
|
BorderSpacing.Bottom = 6
|
||||||
|
Caption = 'Save'
|
||||||
|
OnClick = BtnSaveToFileClick
|
||||||
|
TabOrder = 0
|
||||||
|
end
|
||||||
|
object BtnViewSVG: TButton
|
||||||
|
AnchorSideLeft.Control = BtnSaveAsSvg
|
||||||
|
AnchorSideLeft.Side = asrBottom
|
||||||
|
Left = 62
|
||||||
|
Height = 25
|
||||||
|
Top = 0
|
||||||
|
Width = 60
|
||||||
|
AutoSize = True
|
||||||
|
BorderSpacing.Left = 4
|
||||||
|
BorderSpacing.Right = 4
|
||||||
|
BorderSpacing.Bottom = 6
|
||||||
|
Caption = 'View...'
|
||||||
|
OnClick = BtnViewImageClick
|
||||||
|
TabOrder = 1
|
||||||
|
end
|
||||||
|
object SVGPaintbox: TPaintBox
|
||||||
|
AnchorSideLeft.Control = BtnSaveAsSvg
|
||||||
|
AnchorSideTop.Control = BtnSaveAsSvg
|
||||||
|
AnchorSideTop.Side = asrBottom
|
||||||
|
Left = 8
|
||||||
|
Height = 100
|
||||||
|
Top = 31
|
||||||
|
Width = 100
|
||||||
|
BorderSpacing.Bottom = 6
|
||||||
|
OnPaint = PaintBoxPaint
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object Label14: TLabel
|
||||||
|
Left = 8
|
||||||
|
Height = 15
|
||||||
|
Top = 19
|
||||||
|
Width = 491
|
||||||
|
Align = alTop
|
||||||
|
BorderSpacing.Left = 8
|
||||||
|
BorderSpacing.Top = 2
|
||||||
|
BorderSpacing.Right = 8
|
||||||
|
Caption = 'After clicking "Save" the file is opened and displayed in the box below.'
|
||||||
|
ParentColor = False
|
||||||
|
ParentFont = False
|
||||||
|
WordWrap = True
|
||||||
|
end
|
||||||
|
object LblBothImagesMustMatch1: TLabel
|
||||||
|
Left = 8
|
||||||
|
Height = 15
|
||||||
|
Top = 38
|
||||||
|
Width = 495
|
||||||
|
Align = alTop
|
||||||
|
BorderSpacing.Left = 8
|
||||||
|
BorderSpacing.Top = 4
|
||||||
|
BorderSpacing.Right = 4
|
||||||
|
Caption = 'This image must match the "Render test" image.'
|
||||||
|
Font.Style = [fsBold]
|
||||||
|
ParentColor = False
|
||||||
|
ParentFont = False
|
||||||
|
WordWrap = True
|
||||||
|
end
|
||||||
|
end
|
||||||
|
end
|
||||||
|
end
|
||||||
|
end
|
||||||
1168
components/fpvectorial/tests/vtmain.pas
Normal file
1168
components/fpvectorial/tests/vtmain.pas
Normal file
File diff suppressed because it is too large
Load Diff
453
components/fpvectorial/tests/vtprimitives.pas
Normal file
453
components/fpvectorial/tests/vtprimitives.pas
Normal file
@ -0,0 +1,453 @@
|
|||||||
|
unit vtprimitives;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, fpcanvas, fpimage, fpvectorial;
|
||||||
|
|
||||||
|
function CreateCircle(APage: TvVectorialPage; CtrX, CtrY, R: Double): TvCircle;
|
||||||
|
function CreateEllipse(APage: TvVectorialPage; X1, Y1, X2, Y2: Double): TvEllipse;
|
||||||
|
function CreateRectangle(APage: TvVectorialPage; X1, Y1, X2, Y2: Double): TvRectangle;
|
||||||
|
function CreateRoundedRect(APage: TvVectorialPage; X1, Y1, X2, Y2, RX, RY: Double): TvRectangle;
|
||||||
|
function CreatePolygon(APage: TvVectorialPage; const APoints: array of T3DPoint): TvPolygon;
|
||||||
|
function CreateArc(APage: TvVectorialPage; X1,Y1, X2,Y2, CX,CY, RX, RY: Double; Clockwise: Boolean): TPath;
|
||||||
|
|
||||||
|
function CreateSimpleBrush(AStyle: TFPBrushStyle; AColor: TFPColor): TvBrush; overload;
|
||||||
|
function CreateSimpleBrush(AStyle: TFPBrushStyle): TvBrush; overload;
|
||||||
|
function CreateLinearGradientBrush(AStartPt, AEndPt: T2DPoint; AFlags: TvGradientFlags;
|
||||||
|
AStartColor, AEndColor: TFPColor): TvBrush;
|
||||||
|
function CreateRadialGradientBrush(CX, CY, R, FX, FY: Double;
|
||||||
|
AStartColor, AEndColor: TFPColor): TvBrush;
|
||||||
|
function CreatePen(AStyle: TFPPenStyle; AWidth: Integer; AColor: TFPColor): TvPen;
|
||||||
|
|
||||||
|
function CreateStdCircle(APage: TvVectorialPage): TvCircle;
|
||||||
|
function CreateStdEllipse(APage: TvVectorialPage): TvEllipse;
|
||||||
|
function CreateStdRect(APage: TvVectorialPage): TvRectangle;
|
||||||
|
function CreateStdRoundedRect(APage: TvVectorialPage): TvRectangle;
|
||||||
|
function CreateStdPolygon(APage: TvVectorialPage): TvPolygon;
|
||||||
|
function CreateStdSelfIntersectingPolygon(APage: TvVectorialPage): TvPolygon;
|
||||||
|
function CreatePathWithHole(APage: TvVectorialPage): TPath;
|
||||||
|
function CreateStdArcQ1(APage: TvVectorialPage; Clockwise: Boolean): TPath;
|
||||||
|
function CreateStdArcQ2(APage: TvVectorialPage; Clockwise: Boolean): TPath;
|
||||||
|
function CreateStdArcQ3(APage: TvVectorialPage; Clockwise: Boolean): TPath;
|
||||||
|
function CreateStdArcQ4(APage: TvVectorialPage; Clockwise: Boolean): TPath;
|
||||||
|
|
||||||
|
function StdSolidBrush: TvBrush;
|
||||||
|
function StdHorizGradientBrush: TvBrush;
|
||||||
|
function StdVertGradientBrush: TvBrush;
|
||||||
|
function StdLinearGradientBrush: TvBrush;
|
||||||
|
function StdRadialGradientBrush: TvBrush;
|
||||||
|
function StdPen: TvPen;
|
||||||
|
|
||||||
|
const
|
||||||
|
PAGE_SIZE = 100;
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
Math, fpvutils;
|
||||||
|
|
||||||
|
{ Shapes }
|
||||||
|
|
||||||
|
{ circle with specified center and radius.
|
||||||
|
Valid for any coordinate system }
|
||||||
|
function CreateCircle(APage: TvVectorialPage; CtrX, CtrY, R: Double): TvCircle;
|
||||||
|
begin
|
||||||
|
Result := TvCircle.Create(APage);
|
||||||
|
Result.X := CtrX;
|
||||||
|
Result.Y := CtrY;
|
||||||
|
Result.Radius := R;
|
||||||
|
Result.Brush := CreateSimpleBrush(bsClear);
|
||||||
|
Result.Pen := CreatePen(psSolid, 1, colBlack);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Ellipse with specified center and halfaxes.
|
||||||
|
Coordinate system uses an upward y axis for input data, but is flipped if needed }
|
||||||
|
function CreateEllipse(APage: TvVectorialPage; X1, Y1, X2, Y2: Double): TvEllipse;
|
||||||
|
begin
|
||||||
|
Result := TvEllipse.Create(APage);
|
||||||
|
Result.X := (X1 + X2) / 2; // Center
|
||||||
|
Result.Y := (Y1 + Y2) / 2;
|
||||||
|
if APage.UseTopLeftCoordinates then
|
||||||
|
Result.Y := PAGE_SIZE - Result.Y;
|
||||||
|
Result.HorzHalfAxis := abs(X2 - X1) / 2;
|
||||||
|
Result.VertHalfAxis := abs(Y2 - Y1) / 2;
|
||||||
|
Result.Brush := CreateSimpleBrush(bsClear);
|
||||||
|
Result.Pen := CreatePen(psSolid, 1, colBlack);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Rectangle with specified top/left corner and width and height.
|
||||||
|
Coordinate system uses an upward y axis for input data, but is flipped if needed. }
|
||||||
|
function CreateRectangle(APage: TvVectorialPage; X1, Y1, X2, Y2: Double): TvRectangle;
|
||||||
|
begin
|
||||||
|
Result := TvRectangle.Create(APage);
|
||||||
|
Result.X := Min(X1, X2);
|
||||||
|
if APage.UseTopLeftCoordinates then
|
||||||
|
Result.Y := Min(PAGE_SIZE-Y1, PAGE_SIZE-Y2) else
|
||||||
|
Result.Y := Max(Y1, Y2);
|
||||||
|
Result.CX := abs(X2 - X1); // width
|
||||||
|
Result.CY := abs(Y2 - Y1); // height
|
||||||
|
Result.Brush := CreateSimpleBrush(bsClear);
|
||||||
|
Result.Pen := CreatePen(psSolid, 1, colBlack);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Rectangle with rounded corner
|
||||||
|
Coordinate system uses an upward y axis for input data, but is flipped if needed. }
|
||||||
|
function CreateRoundedRect(APage: TvVectorialPage;
|
||||||
|
X1, Y1, X2, Y2, RX, RY: Double): TvRectangle;
|
||||||
|
begin
|
||||||
|
Result := TvRectangle.Create(APage);
|
||||||
|
Result.X := Min(X1, X2);
|
||||||
|
if APage.UseTopLeftCoordinates then
|
||||||
|
Result.Y := Min(PAGE_SIZE-Y1, PAGE_SIZE-Y2) else
|
||||||
|
Result.Y := Max(Y1, Y2);
|
||||||
|
Result.CX := abs(X2 - X1);
|
||||||
|
Result.CY := abs(Y2 - Y1);
|
||||||
|
Result.RX := RX;
|
||||||
|
Result.RY := RY;
|
||||||
|
Result.Brush := CreateSimpleBrush(bsClear);
|
||||||
|
Result.Pen := CreatePen(psSolid, 1, colBlack);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Polygon with vertices specified in the array.
|
||||||
|
Valid for any coordinate system. }
|
||||||
|
function CreatePolygon(APage: TvVectorialPage;
|
||||||
|
const APoints: Array of T3DPoint): TvPolygon;
|
||||||
|
var
|
||||||
|
i: Integer;
|
||||||
|
begin
|
||||||
|
Result := TvPolygon.Create(APage);
|
||||||
|
SetLength(Result.Points, Length(APoints));
|
||||||
|
for i:=0 to High(APoints) do
|
||||||
|
Result.Points[i] := APoints[i];
|
||||||
|
Result.X := Result.Points[0].X;
|
||||||
|
Result.Y := Result.Points[0].Y;
|
||||||
|
Result.Brush := CreateSimpleBrush(bsClear);
|
||||||
|
Result.Pen := CreatePen(psSolid, 1, colBlack);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function CreateArc(APage: TvVectorialPage; X1,Y1, X2,Y2, CX,CY, RX, RY: Double;
|
||||||
|
Clockwise: Boolean): TPath;
|
||||||
|
var
|
||||||
|
path: TPath;
|
||||||
|
begin
|
||||||
|
if APage.UseTopLeftCoordinates then begin
|
||||||
|
Y1 := PAGE_SIZE - Y1;
|
||||||
|
Y2 := PAGE_SIZE - Y2;
|
||||||
|
CY := PAGE_SIZE - CY;
|
||||||
|
end;
|
||||||
|
// Don't invert "Clockwise" here. It does not matter where the y axis points to.
|
||||||
|
APage.StartPath(X1, Y1);
|
||||||
|
APage.AddEllipticalArcWithCenterToPath(RX, RY, 0, X2, Y2, CX, CY, Clockwise);
|
||||||
|
path := APage.EndPath;
|
||||||
|
path.Pen := StdPen;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Brushes }
|
||||||
|
|
||||||
|
function CreateSimpleBrush(AStyle: TFPBrushStyle): TvBrush;
|
||||||
|
begin
|
||||||
|
Result := CreateSimpleBrush(AStyle, colBlack);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function CreateSimpleBrush(AStyle: TFPBrushStyle; AColor: TFPColor): TvBrush;
|
||||||
|
begin
|
||||||
|
Result.Kind := bkSimpleBrush;
|
||||||
|
Result.Color := TFPColor(AColor);
|
||||||
|
Result.Style := AStyle;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function CreateLinearGradientBrush(AStartPt, AEndPt: T2DPoint;
|
||||||
|
AFlags: TvGradientFlags; AStartColor, AEndColor: TFPColor): TvBrush;
|
||||||
|
var
|
||||||
|
p1, p2: T2dPoint;
|
||||||
|
x1str, x2str, y1str, y2str: String;
|
||||||
|
begin
|
||||||
|
if AStartPt.Y = AEndPt.Y then
|
||||||
|
Result.Kind := bkHorizontalGradient
|
||||||
|
else if AStartPt.X = AEndPt.X then
|
||||||
|
Result.Kind := bkVerticalGradient
|
||||||
|
else
|
||||||
|
Result.Kind := bkOtherLinearGradient;
|
||||||
|
Result.Gradient_start := AStartPt;
|
||||||
|
Result.Gradient_end := AEndPt;
|
||||||
|
Result.Gradient_flags := AFlags;
|
||||||
|
SetLength(Result.Gradient_colors, 2);
|
||||||
|
Result.Gradient_colors[0].Color := AStartColor;
|
||||||
|
Result.Gradient_colors[0].Position := 0;
|
||||||
|
Result.Gradient_colors[1].Color := AEndColor;
|
||||||
|
Result.Gradient_colors[1].Position := 1;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function CreateRadialGradientBrush(CX, CY, R, FX, FY: Double;
|
||||||
|
AStartColor, AEndColor: TFPColor): TvBrush;
|
||||||
|
begin
|
||||||
|
Result.Kind := bkRadialGradient;
|
||||||
|
Result.Gradient_cx := CX;
|
||||||
|
Result.Gradient_cy := CY;
|
||||||
|
Result.Gradient_r := R;
|
||||||
|
Result.Gradient_fx := FX;
|
||||||
|
Result.Gradient_fy := FY;
|
||||||
|
SetLength(Result.Gradient_colors, 2);
|
||||||
|
Result.Gradient_colors[0].Color := AStartColor;
|
||||||
|
Result.Gradient_colors[0].Position := 0;
|
||||||
|
Result.Gradient_colors[1].Color := AEndColor;
|
||||||
|
Result.Gradient_colors[1].Position := 1;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Pen }
|
||||||
|
|
||||||
|
function CreatePen(AStyle: TFPPenStyle; AWidth: Integer; AColor: TFPColor): TvPen;
|
||||||
|
begin
|
||||||
|
Result.Style := AStyle;
|
||||||
|
Result.Width := AWidth;
|
||||||
|
Result.Color := AColor;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Standardized objects }
|
||||||
|
|
||||||
|
{ A circle shifted up }
|
||||||
|
function CreateStdCircle(APage: TvVectorialPage): TvCircle;
|
||||||
|
const
|
||||||
|
CENTER_X = 50;
|
||||||
|
CENTER_Y = 55; // y points up for this number
|
||||||
|
RADIUS = 40;
|
||||||
|
begin
|
||||||
|
if APage.UseTopLeftCoordinates then
|
||||||
|
Result := CreateCircle(APage, CENTER_X, PAGE_SIZE - CENTER_Y, RADIUS) else
|
||||||
|
Result := CreateCircle(APage, CENTER_X, CENTER_Y, RADIUS);
|
||||||
|
Result.Pen := StdPen;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ An ellipse shifted up }
|
||||||
|
function CreateStdEllipse(APage: TvVectorialPage): TvEllipse;
|
||||||
|
begin
|
||||||
|
Result := CreateEllipse(APage, 10, 30, 90, 80);
|
||||||
|
// CreateEllipse will invert the axis if needed
|
||||||
|
Result.Pen := StdPen;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ A rectangle shifted up }
|
||||||
|
function CreateStdRect(APage: TvVectorialPage): TvRectangle;
|
||||||
|
const
|
||||||
|
LEFT = 10;
|
||||||
|
RIGHT = 90;
|
||||||
|
TOP = 95; // for bottom-up y axis
|
||||||
|
BOTTOM = 15; // dto.
|
||||||
|
begin
|
||||||
|
Result := CreateRectangle(APage, LEFT, TOP, RIGHT, BOTTOM);
|
||||||
|
// CreateRect will invert the y axis if needed
|
||||||
|
Result.Pen := StdPen;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ A rounded rectangle shifted up }
|
||||||
|
function CreateStdRoundedRect(APage: TvVectorialPage): TvRectangle;
|
||||||
|
const
|
||||||
|
LEFT = 10;
|
||||||
|
RIGHT = 90;
|
||||||
|
TOP = 95; // for bottom-up y axis
|
||||||
|
BOTTOM = 15; // dto.
|
||||||
|
RX = 10;
|
||||||
|
RY = 10;
|
||||||
|
begin
|
||||||
|
Result := CreateRoundedRect(APage,LEFT, TOP, RIGHT, BOTTOM, RX, RY);
|
||||||
|
// CreateRect will invert the y axis if needed
|
||||||
|
Result.Pen := StdPen;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ A triangle as polygon, base line at bottom }
|
||||||
|
function CreateStdPolygon(APage: TvVectorialPage):TvPolygon;
|
||||||
|
var
|
||||||
|
pts: array[0..3] of T3DPoint;
|
||||||
|
i: Integer;
|
||||||
|
begin
|
||||||
|
pts[0] := Make3DPoint(10, 10);
|
||||||
|
pts[1] := Make3dPoint(90, 10);
|
||||||
|
pts[2] := Make3DPoint(50, 90);
|
||||||
|
pts[3] := pts[0];
|
||||||
|
if APage.UseTopLeftCoordinates then
|
||||||
|
for i:=0 to High(pts) do
|
||||||
|
pts[i].Y := PAGE_SIZE - pts[i].Y;
|
||||||
|
Result := CreatePolygon(APage, pts);
|
||||||
|
Result.Pen := StdPen;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ A star-like self-intersecting polygon, tip at bottom }
|
||||||
|
function CreateStdSelfIntersectingPolygon(APage: TvVectorialPage): TvPolygon;
|
||||||
|
var
|
||||||
|
pts: array[0..5] of T3DPoint;
|
||||||
|
i: Integer;
|
||||||
|
begin
|
||||||
|
pts[0] := Make3DPoint(50, 5);
|
||||||
|
pts[1] := Make3DPoint(20, 90);
|
||||||
|
pts[2] := Make3DPoint(95, 30);
|
||||||
|
pts[3] := Make3DPoint(5, 30);
|
||||||
|
pts[4] := Make3DPoint(80, 90);
|
||||||
|
pts[5] := Make3DPoint(50, 5);
|
||||||
|
if APage.UseTopLeftCoordinates then
|
||||||
|
for i:=0 to High(pts) do
|
||||||
|
pts[i].Y := PAGE_SIZE - pts[i].Y;
|
||||||
|
Result := CreatePolygon(APage, pts);
|
||||||
|
Result.Pen := StdPen;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function CreatePathWithHole(APage: TvVectorialPage): TPath;
|
||||||
|
const
|
||||||
|
OUTER_POINTS: array[0..4] of T2DPoint = (
|
||||||
|
(X:10; Y:5), (X:90; Y:5), (X:90; Y:90), (X:10; Y:90), (X:10; Y:5)
|
||||||
|
);
|
||||||
|
INNER_POINTS: array[0..4] of T2DPoint = (
|
||||||
|
(X:50; Y:45), (X:40; Y:55), (X:50; Y:65), (X:60; Y:55), (X:50; Y:45)
|
||||||
|
);
|
||||||
|
var
|
||||||
|
i: Integer;
|
||||||
|
begin
|
||||||
|
if APage.UseTopLeftCoordinates then begin
|
||||||
|
APage.StartPath(OUTER_POINTS[0].X, PAGE_SIZE - OUTER_POINTS[0].Y);
|
||||||
|
for i:=1 to High(OUTER_POINTS) do
|
||||||
|
APage.AddLineToPath(OUTER_POINTS[i].X, PAGE_SIZE - OUTER_POINTS[i].Y);
|
||||||
|
APage.AddMoveToPath(INNER_POINTS[0].X, PAGE_SIZE - INNER_POINTS[0].Y);
|
||||||
|
for i:=1 to High(INNER_POINTS) do
|
||||||
|
APage.AddLineToPath(INNER_POINTS[i].X, PAGE_SIZE - INNER_POINTS[i].Y);
|
||||||
|
end else begin
|
||||||
|
APage.StartPath(OUTER_POINTS[0].X, OUTER_POINTS[0].Y);
|
||||||
|
for i:=1 to High(OUTER_POINTS) do
|
||||||
|
APage.AddLineToPath(OUTER_POINTS[i].X, OUTER_POINTS[i].Y);
|
||||||
|
APage.AddMoveToPath(INNER_POINTS[0].X, INNER_POINTS[0].Y);
|
||||||
|
for i:=1 to High(INNER_POINTS) do
|
||||||
|
APage.AddLineToPath(INNER_POINTS[i].X, INNER_POINTS[i].Y);
|
||||||
|
end;
|
||||||
|
Result := APage.EndPath;
|
||||||
|
Result.Pen := StdPen;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Quarter circle in quadrant I }
|
||||||
|
function CreateStdArcQ1(APage: TvVectorialPage; Clockwise: Boolean): TPath;
|
||||||
|
const
|
||||||
|
X1 = 50;
|
||||||
|
Y1 = 95;
|
||||||
|
X2 = 90;
|
||||||
|
Y2 = 55;
|
||||||
|
CX = 50;
|
||||||
|
CY = 55;
|
||||||
|
RX = 40;
|
||||||
|
RY = 40;
|
||||||
|
begin
|
||||||
|
Result := CreateArc(APage, X1, Y1, X2, Y2, CX, CY, RX, RY, Clockwise);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Quarter circle in quadrant II }
|
||||||
|
function CreateStdArcQ2(APage: TvVectorialPage; Clockwise: Boolean): TPath;
|
||||||
|
const
|
||||||
|
X1 = 50;
|
||||||
|
Y1 = 95;
|
||||||
|
X2 = 10;
|
||||||
|
Y2 = 55;
|
||||||
|
CX = 50;
|
||||||
|
CY = 55;
|
||||||
|
RX = 40;
|
||||||
|
RY = 40;
|
||||||
|
begin
|
||||||
|
Result := CreateArc(APage, X1, Y1, X2, Y2, CX, CY, RX, RY, Clockwise);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Quarter circle in quadrant III }
|
||||||
|
function CreateStdArcQ3(APage: TvVectorialPage; Clockwise: Boolean): TPath;
|
||||||
|
const
|
||||||
|
X1 = 10;
|
||||||
|
Y1 = 55;
|
||||||
|
X2 = 50;
|
||||||
|
Y2 = 15;
|
||||||
|
CX = 50;
|
||||||
|
CY = 55;
|
||||||
|
RX = 40;
|
||||||
|
RY = 40;
|
||||||
|
begin
|
||||||
|
Result := CreateArc(APage, X1, Y1, X2, Y2, CX, CY, RX, RY, Clockwise);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Quarter circle in quadrant IV }
|
||||||
|
function CreateStdArcQ4(APage: TvVectorialPage; Clockwise: Boolean): TPath;
|
||||||
|
const
|
||||||
|
X1 = 90;
|
||||||
|
Y1 = 55;
|
||||||
|
X2 = 50;
|
||||||
|
Y2 = 15;
|
||||||
|
CX = 50;
|
||||||
|
CY = 55;
|
||||||
|
RX = 40;
|
||||||
|
RY = 40;
|
||||||
|
begin
|
||||||
|
Result := CreateArc(APage, X1, Y1, X2, Y2, CX, CY, RX, RY, Clockwise);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function StdSolidBrush: TvBrush;
|
||||||
|
begin
|
||||||
|
Result := CreateSimpleBrush(bsSolid, colRed);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function StdHorizGradientBrush: TvBrush;
|
||||||
|
begin
|
||||||
|
Result := CreateLinearGradientBrush(Point2D(0, 0), Point2D(1, 0),
|
||||||
|
[gfRelStartX, gfRelEndX, gfRelStartY, gfRelEndY],
|
||||||
|
colBlue, colWhite);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ A vertical gradient, yellow at top, red at bottom }
|
||||||
|
function StdVertGradientBrush: TvBrush;
|
||||||
|
var
|
||||||
|
P1, P2: T2DPoint;
|
||||||
|
begin
|
||||||
|
{if APage.UseTopLeftCoordinates then begin
|
||||||
|
P1 := Point2D(0, 1);
|
||||||
|
P2 := Point2D(0, 0);
|
||||||
|
end else
|
||||||
|
}
|
||||||
|
begin
|
||||||
|
P1 := Point2D(0, 0);
|
||||||
|
P2 := Point2D(0, 1);
|
||||||
|
end;
|
||||||
|
Result := CreateLinearGradientBrush(P1, P2,
|
||||||
|
[gfRelStartX, gfRelEndX, gfRelStartY, gfRelEndY],
|
||||||
|
colYellow, colRed);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ A diagonal gradient running from bottom/left (yellow) to top/right (red) }
|
||||||
|
function StdLinearGradientBrush: TvBrush;
|
||||||
|
var
|
||||||
|
P1, P2: T2DPoint;
|
||||||
|
begin
|
||||||
|
{
|
||||||
|
if APage.UseTopLeftCoordinates then begin
|
||||||
|
P1 := Point2D(0, 1);
|
||||||
|
P2 := Point2D(1, 0);
|
||||||
|
end else
|
||||||
|
}
|
||||||
|
begin
|
||||||
|
P1 := Point2D(0, 0);
|
||||||
|
P2 := Point2D(1, 1);
|
||||||
|
end;
|
||||||
|
Result := CreateLinearGradientBrush(Point2D(0, 0), Point2D(1, 1),
|
||||||
|
[gfRelStartX, gfRelEndX, gfRelStartY, gfRelEndY],
|
||||||
|
colYellow, colRed);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function StdRadialGradientBrush: TvBrush;
|
||||||
|
begin
|
||||||
|
Result := CreateRadialGradientBrush(0.5, 0.5, 0.5, 0.5, 0.5,
|
||||||
|
colRed, colYellow);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function StdPen: TvPen;
|
||||||
|
begin
|
||||||
|
Result := CreatePen(psSolid, 4, colBlack);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
Loading…
Reference in New Issue
Block a user