mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-20 16:09:31 +02:00
Adds support for texts in the core of fpvectorial and adds a new example application for generating a set of documents from code
git-svn-id: trunk@15884 -
This commit is contained in:
parent
90df24dfae
commit
274856e2f5
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -2395,6 +2395,7 @@ packages/fpvectorial/examples/fpvc_mainform.pas svneol=native#text/plain
|
||||
packages/fpvectorial/examples/fpvectorialconverter.ico -text
|
||||
packages/fpvectorial/examples/fpvectorialconverter.lpi svneol=native#text/plain
|
||||
packages/fpvectorial/examples/fpvectorialconverter.lpr svneol=native#text/plain
|
||||
packages/fpvectorial/examples/fpvwritetest.pas svneol=native#text/plain
|
||||
packages/fpvectorial/fpmake.pp svneol=native#text/plain
|
||||
packages/fpvectorial/src/avisocncgcodereader.pas svneol=native#text/plain
|
||||
packages/fpvectorial/src/avisocncgcodewriter.pas svneol=native#text/plain
|
||||
|
@ -51,4 +51,12 @@ object formCorelExplorer: TformCorelExplorer
|
||||
Caption = 'Version:'
|
||||
ParentColor = False
|
||||
end
|
||||
object labelSize: TLabel
|
||||
Left = 256
|
||||
Height = 14
|
||||
Top = 112
|
||||
Width = 24
|
||||
Caption = 'Size:'
|
||||
ParentColor = False
|
||||
end
|
||||
end
|
||||
|
@ -15,6 +15,7 @@ type
|
||||
TformCorelExplorer = class(TForm)
|
||||
Label1: TLabel;
|
||||
Label2: TLabel;
|
||||
labelSize: TLabel;
|
||||
labelVersion: TLabel;
|
||||
labelFilename: TLabel;
|
||||
shellInput: TShellTreeView;
|
||||
@ -64,9 +65,14 @@ begin
|
||||
labelFilename.Caption := 'Filename: ' + shellInput.GetSelectedNodePath();
|
||||
if (lChunk.ChildChunks <> nil) and (lChunk.ChildChunks.First <> nil) then
|
||||
begin
|
||||
// Version Chunk
|
||||
lCurChunk := TCDRChunk(lChunk.ChildChunks.First);
|
||||
Str := TCDRChunkVRSN(lCurChunk).VersionStr;
|
||||
labelVersion.Caption := 'Version: ' + Str;
|
||||
|
||||
// Main data
|
||||
lCurChunk := TCDRChunk(lChunk.ChildChunks.Items[1]);
|
||||
labelSize.Caption := 'Size: ' + ;
|
||||
end;
|
||||
finally
|
||||
Reader.Free;
|
||||
|
74
packages/fpvectorial/examples/fpvwritetest.pas
Normal file
74
packages/fpvectorial/examples/fpvwritetest.pas
Normal file
@ -0,0 +1,74 @@
|
||||
{
|
||||
FPVectorial example application for writing vectorial images
|
||||
generated in code to disk. This program will generate the following
|
||||
vectorial images:
|
||||
|
||||
single_line_1 One line from (0, 20) to (30, 30)
|
||||
single_line_2 One line from (20, 30) to (30, 20)
|
||||
polyline_1 One line from (0, 0) to (10, 10) to (20, 30) to (30, 20)
|
||||
polyline_2 One line from (10, 10) to (20, 30) to (30, 20) to (40, 40)
|
||||
bezier_1 One path starting in (0, 0) lining to (10, 10) then bezier to (20, 10) and then line to (30, 0)
|
||||
bezier_2 One curve from (10, 10) to (20, 20)
|
||||
text_ascii One text written at (10, 10)
|
||||
text_europen One text testing european languages at (20, 20)
|
||||
text_asian One text testing asian languages at (30, 30)
|
||||
|
||||
Author: Felipe Monteiro de Carvalho
|
||||
|
||||
License: Public Domain
|
||||
}
|
||||
program fpvwritetest;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
fpvectorial, svgvectorialwriter;
|
||||
|
||||
const
|
||||
cFormat = vfSVG;
|
||||
cExtension = '.svg';
|
||||
var
|
||||
Vec: TvVectorialDocument;
|
||||
begin
|
||||
Vec := TvVectorialDocument.Create;
|
||||
try
|
||||
// single_line_1 One line from (0, 20) to (30, 30)
|
||||
Vec.StartPath(0, 20);
|
||||
Vec.AddLineToPath(30, 30);
|
||||
Vec.EndPath();
|
||||
Vec.WriteToFile('single_line_1' + cExtension, cFormat);
|
||||
|
||||
// single_line_2 One line from (20, 30) to (30, 20)
|
||||
Vec.Clear;
|
||||
Vec.StartPath(20, 30);
|
||||
Vec.AddLineToPath(30, 20);
|
||||
Vec.EndPath();
|
||||
Vec.WriteToFile('single_line_2' + cExtension, cFormat);
|
||||
|
||||
// polyline_1 One line from (0, 0) to (10, 10) to (20, 30) to (30, 20)
|
||||
Vec.Clear;
|
||||
Vec.StartPath(0, 0);
|
||||
Vec.AddLineToPath(10, 10);
|
||||
Vec.AddLineToPath(20, 30);
|
||||
Vec.AddLineToPath(30, 20);
|
||||
Vec.EndPath();
|
||||
Vec.WriteToFile('polyline_1' + cExtension, cFormat);
|
||||
|
||||
// polyline_2 One line from (10, 10) to (20, 30) to (30, 20) to (40, 40)
|
||||
Vec.Clear;
|
||||
Vec.StartPath(10, 10);
|
||||
Vec.AddLineToPath(20, 30);
|
||||
Vec.AddLineToPath(30, 20);
|
||||
Vec.AddLineToPath(40, 40);
|
||||
Vec.EndPath();
|
||||
Vec.WriteToFile('polyline_2' + cExtension, cFormat);
|
||||
// bezier_1 One path starting in (0, 0) lining to (10, 10) then bezier to (20, 10) and then line to (30, 0)
|
||||
// bezier_2 One curve from (10, 10) to (20, 20)
|
||||
// text_ascii One text written at (10, 10)
|
||||
// text_europen One text testing european languages at (20, 20)
|
||||
// text_asian One text testing asian languages at (30, 30)
|
||||
finally
|
||||
Vec.Free;
|
||||
end;
|
||||
end.
|
||||
|
@ -63,6 +63,18 @@ type
|
||||
|
||||
PPath = ^TPath;
|
||||
|
||||
{@@
|
||||
TvText represents a text in memory.
|
||||
|
||||
At the moment fonts are unsupported, only simple texts
|
||||
up to 255 chars are supported.
|
||||
}
|
||||
TvText = record
|
||||
Value: array[0..255] of Char;
|
||||
end;
|
||||
|
||||
PText = ^TvText;
|
||||
|
||||
type
|
||||
|
||||
TvCustomVectorialWriter = class;
|
||||
@ -73,6 +85,7 @@ type
|
||||
TvVectorialDocument = class
|
||||
private
|
||||
FPaths: TFPList;
|
||||
FTexts: TFPList;
|
||||
FTmpPath: TPath;
|
||||
procedure RemoveCallback(data, arg: pointer);
|
||||
function CreateVectorialWriter(AFormat: TvVectorialFormat): TvCustomVectorialWriter;
|
||||
@ -94,9 +107,12 @@ type
|
||||
{ Data reading methods }
|
||||
function GetPath(ANum: Cardinal): TPath;
|
||||
function GetPathCount: Integer;
|
||||
function GetText(ANum: Cardinal): TvText;
|
||||
function GetTextCount: Integer;
|
||||
{ Data removing methods }
|
||||
procedure Clear;
|
||||
procedure RemoveAllPaths;
|
||||
procedure RemoveAllTexts;
|
||||
{ Data writing methods }
|
||||
procedure AddPath(APath: TPath);
|
||||
procedure StartPath(AX, AY: Double);
|
||||
@ -105,6 +121,8 @@ type
|
||||
procedure AddBezierToPath(AX1, AY1, AX2, AY2, AX3, AY3: Double); overload;
|
||||
procedure AddBezierToPath(AX1, AY1, AZ1, AX2, AY2, AZ2, AX3, AY3, AZ3: Double); overload;
|
||||
procedure EndPath();
|
||||
procedure AddText(AText: TvText); overload;
|
||||
procedure AddText(AStr: utf8string); overload;
|
||||
{ properties }
|
||||
property PathCount: Integer read GetPathCount;
|
||||
property Paths[Index: Cardinal]: TPath read GetPath;
|
||||
@ -264,6 +282,7 @@ begin
|
||||
inherited Create;
|
||||
|
||||
FPaths := TFPList.Create;
|
||||
FTexts := TFPList.Create;
|
||||
end;
|
||||
|
||||
{@@
|
||||
@ -274,6 +293,7 @@ begin
|
||||
Clear;
|
||||
|
||||
FPaths.Free;
|
||||
FTexts.Free;
|
||||
|
||||
inherited Destroy;
|
||||
end;
|
||||
@ -287,6 +307,12 @@ begin
|
||||
FPaths.Clear;
|
||||
end;
|
||||
|
||||
procedure TvVectorialDocument.RemoveAllTexts;
|
||||
begin
|
||||
FTexts.ForEachCall(RemoveCallback, nil);
|
||||
FTexts.Clear;
|
||||
end;
|
||||
|
||||
procedure TvVectorialDocument.AddPath(APath: TPath);
|
||||
var
|
||||
Path: PPath;
|
||||
@ -389,6 +415,25 @@ begin
|
||||
FTmPPath.Len := 0;
|
||||
end;
|
||||
|
||||
procedure TvVectorialDocument.AddText(AText: TvText);
|
||||
var
|
||||
lText: PText;
|
||||
Len: Integer;
|
||||
begin
|
||||
Len := SizeOf(TvText);
|
||||
lText := GetMem(Len);
|
||||
Move(AText, lText^, Len);
|
||||
FTexts.Add(lText);
|
||||
end;
|
||||
|
||||
procedure TvVectorialDocument.AddText(AStr: utf8string);
|
||||
var
|
||||
lText: TvText;
|
||||
begin
|
||||
lText.Value := AStr;
|
||||
AddText(lText);
|
||||
end;
|
||||
|
||||
{@@
|
||||
Convenience method which creates the correct
|
||||
writer object for a given vector graphics document format.
|
||||
@ -568,12 +613,27 @@ begin
|
||||
Result := FPaths.Count;
|
||||
end;
|
||||
|
||||
function TvVectorialDocument.GetText(ANum: Cardinal): TvText;
|
||||
begin
|
||||
if ANum >= FTexts.Count then raise Exception.Create('TvVectorialDocument.GetText: Text number out of bounds');
|
||||
|
||||
if FTexts.Items[ANum] = nil then raise Exception.Create('TvVectorialDocument.GetText: Invalid Text number');
|
||||
|
||||
Result := PText(FTexts.Items[ANum])^;
|
||||
end;
|
||||
|
||||
function TvVectorialDocument.GetTextCount: Integer;
|
||||
begin
|
||||
Result := FTexts.Count;
|
||||
end;
|
||||
|
||||
{@@
|
||||
Clears all data in the document
|
||||
}
|
||||
procedure TvVectorialDocument.Clear;
|
||||
begin
|
||||
RemoveAllPaths();
|
||||
RemoveAllTexts();
|
||||
end;
|
||||
|
||||
{ TvCustomVectorialReader }
|
||||
|
Loading…
Reference in New Issue
Block a user