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

fpvectorial: Rewrites more of the page handling system, introducing a necessary API break. Advances the ODT writer, now it starts showing some text

Browse Source 
git-svn-id: trunk@42374 -
This commit is contained in:
sekelsenmat 2013-08-09 12:24:33 +00:00
parent 409456340f
commit fbd4d7e732
6 changed files with 148 additions and 42 deletions

2
components/fpvectorial/avisocncgcodewriter.pas
View File

@ -107,7 +107,7 @@ procedure TvAvisoCNCGCodeWriter.WriteToStrings(AStrings: TStrings;
var
lPage: TvVectorialPage;
begin
lPage := AData.GetPage(0);
lPage := AData.GetPageAsVectorial(0);
WritePageToStrings(AStrings, lPage);
end;

4
components/fpvectorial/examples/fpvtextwritetest.pas
View File

@ -28,8 +28,12 @@ begin
// First page sequence
Page := Vec.AddTextPageSequence();
// First paragraph
CurParagraph := Page.AddParagraph();
CurParagraph.AddText('');
CurParagraph := Page.AddParagraph();
CurParagraph.AddText('Some text 2');
Vec.WriteToFile('text_output.odt', vfODT);
finally

44
components/fpvectorial/fpvectorial.pas
View File

@ -137,7 +137,11 @@ type
);
TvSetPenBrushAndFontElements = set of TvSetPenBrushAndFontElement;
TvStyleKind = (vskTextBody, vskHeading);
TvStyleKind = (
// Paragraph kinds
vskTextBody, vskHeading,
// Text-span kind
vskTextSpan);
{ TvStyle }
@ -808,7 +812,7 @@ type
Style: TvStyle;
constructor Create; override;
destructor Destroy; override;
function AddText: TvText;
function AddText(AText: string): TvText;
function TryToSelect(APos: TPoint; var ASubpart: Cardinal): TvFindEntityResult; override;
procedure Render(ADest: TFPCustomCanvas; ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0); override;
@ -874,11 +878,12 @@ type
procedure GuessDocumentSize();
procedure GuessGoodZoomLevel(AScreenSize: Integer = 500);
{ Page methods }
function GetPageAsBaseClass(AIndex: Integer): TvPage;
function GetPage(AIndex: Integer): TvVectorialPage;
function GetPage(AIndex: Integer): TvPage;
function GetPageAsVectorial(AIndex: Integer): TvVectorialPage;
function GetPageAsText(AIndex: Integer): TvTextPageSequence;
function GetPageCount: Integer;
function GetCurrentPage: TvVectorialPage;
function GetCurrentPage: TvPage;
function GetCurrentPageAsVectorial: TvVectorialPage;
procedure SetCurrentPage(AIndex: Integer);
function AddPage(): TvVectorialPage;
function AddTextPageSequence(): TvTextPageSequence;
@ -4204,9 +4209,10 @@ begin
inherited Destroy;
end;
function TvParagraph.AddText: TvText;
function TvParagraph.AddText(AText: string): TvText;
begin
Result := TvText.Create;
Result.Value.Text := AText;;
AddEntity(Result);
end;
@ -4242,7 +4248,8 @@ end;
function TvRichText.AddParagraph: TvParagraph;
begin
Result := TvParagraph.Create;
AddEntity(Result);
end;
function TvRichText.TryToSelect(APos: TPoint; var ASubpart: Cardinal
@ -5276,7 +5283,7 @@ var
i, j: Integer;
lEntity: TvEntity;
lLeft, lTop, lRight, lBottom: Double;
CurPage: TvVectorialPage;
CurPage: TvPage;
begin
lLeft := 0;
lTop := 0;
@ -5302,16 +5309,16 @@ begin
ZoomLevel := AScreenSize / Height;
end;
function TvVectorialDocument.GetPageAsBaseClass(AIndex: Integer): TvPage;
function TvVectorialDocument.GetPage(AIndex: Integer): TvPage;
begin
Result := TvPage(FPages.Items[AIndex]);
end;
function TvVectorialDocument.GetPage(AIndex: Integer): TvVectorialPage;
function TvVectorialDocument.GetPageAsVectorial(AIndex: Integer): TvVectorialPage;
var
lPage: TvPage;
begin
lPage := GetPageAsBaseClass(AIndex);
lPage := GetPage(AIndex);
if (Assigned(lPage) and (lPage is TvVectorialPage)) then
Result := TvVectorialPage(lPage)
else
@ -5322,7 +5329,7 @@ function TvVectorialDocument.GetPageAsText(AIndex: Integer): TvTextPageSequence;
var
lPage: TvPage;
begin
lPage := GetPageAsBaseClass(AIndex);
lPage := GetPage(AIndex);
if (Assigned(lPage) and (lPage is TvTextPageSequence)) then
Result := TvTextPageSequence(lPage)
else
@ -5334,7 +5341,7 @@ begin
Result := FPages.Count;
end;
function TvVectorialDocument.GetCurrentPage: TvVectorialPage;
function TvVectorialDocument.GetCurrentPage: TvPage;
begin
if FCurrentPageIndex >= 0 then
Result := GetPage(FCurrentPageIndex)
@ -5342,6 +5349,17 @@ begin
Result := nil;
end;
function TvVectorialDocument.GetCurrentPageAsVectorial: TvVectorialPage;
var
lCurPage: TvPage;
begin
lCurPage := GetCurrentPage();
if (lCurPage <> nil) and (lCurPage is TvVectorialPage) then
Result := TvVectorialPage(lCurPage)
else
Result := nil
end;
procedure TvVectorialDocument.SetCurrentPage(AIndex: Integer);
begin
FCurrentPageIndex := AIndex;

2
components/fpvectorial/lasvectorialreader.pas
View File

@ -186,7 +186,7 @@ var
i: Integer;
begin
// Get the first page
lPage := AData.GetPage(0);
lPage := AData.GetPageAsVectorial(0);
lCreationDate := Now;
// Write our LAS 1.0 header

136
components/fpvectorial/odtvectorialwriter.pas
View File

@ -63,7 +63,8 @@ type
FMeta, FSettings, FStyles, FContent, FMimetype: string;
FMetaInfManifest: string;
// helper routines
function StyleNameToODTStyleName(AData: TvVectorialDocument; AStyleIndex: Integer; AToContentAutoStyle: Boolean = False): string;
function StyleNameToODTStyleName(AData: TvVectorialDocument; AStyleIndex: Integer; AToContentAutoStyle: Boolean = False): string; overload;
function StyleNameToODTStyleName(AData: TvVectorialDocument; AStyle: TvStyle; AToContentAutoStyle: Boolean = False): string; overload;
function FloatToODTText(AFloat: Double): string;
// Routines to write those files
procedure WriteMimetype;
@ -72,9 +73,10 @@ type
procedure WriteSettings;
procedure WriteStyles(AData: TvVectorialDocument);
procedure WriteDocument(AData: TvVectorialDocument);
procedure WritePage(ACurPage: TvTextPageSequence);
procedure WritePage(ACurPage: TvTextPageSequence; AData: TvVectorialDocument);
//
procedure WriteParagraph(AEntity: TvParagraph; ACurPage: TvTextPageSequence);
procedure WriteParagraph(AEntity: TvParagraph; ACurPage: TvTextPageSequence; AData: TvVectorialDocument);
procedure WriteTextSpan(AEntity: TvText; ACurPage: TvTextPageSequence; AData: TvVectorialDocument);
// Routines to write parts of those files
function WriteStylesXMLAsString: string;
//
@ -169,6 +171,16 @@ begin
end;
end;
function TvODTVectorialWriter.StyleNameToODTStyleName(
AData: TvVectorialDocument; AStyle: TvStyle; AToContentAutoStyle: Boolean
): string;
var
lStyleIndex: Integer;
begin
lStyleIndex := AData.FindStyleIndex(AStyle);
StyleNameToODTStyleName(AData, lStyleIndex, AToContentAutoStyle);
end;
function TvODTVectorialWriter.FloatToODTText(AFloat: Double): string;
begin
Result := FloatToStr(AFloat, FPointSeparator);
@ -456,26 +468,58 @@ begin
lTextPropsStr := lTextPropsStr + ' style:font-name-asian="Microsoft YaHei" ';
lTextPropsStr := lTextPropsStr + ' style:font-name-complex="Mangal" ';
end;
if (spbfFontBold in CurStyle.SetElements) and CurStyle.Font.Bold then
if (spbfFontBold in CurStyle.SetElements) then
begin
lTextPropsStr := lTextPropsStr + ' fo:font-weight="bold" ';
lTextPropsStr := lTextPropsStr + ' style:font-weight-asian="bold" ';
lTextPropsStr := lTextPropsStr + ' style:font-weight-complex="bold" ';
if CurStyle.Font.Bold then
begin
lTextPropsStr := lTextPropsStr + ' fo:font-weight="bold" ';
lTextPropsStr := lTextPropsStr + ' style:font-weight-asian="bold" ';
lTextPropsStr := lTextPropsStr + ' style:font-weight-complex="bold" ';
end
else
begin
lTextPropsStr := lTextPropsStr + ' fo:font-weight="normal" ';
lTextPropsStr := lTextPropsStr + ' style:font-weight-asian="normal" ';
lTextPropsStr := lTextPropsStr + ' style:font-weight-complex="normal" ';
end;
end;
if (spbfFontItalic in CurStyle.SetElements) and CurStyle.Font.Italic then
if (spbfFontItalic in CurStyle.SetElements) then
begin
lTextPropsStr := lTextPropsStr + ' fo:font-style="italic" ';
lTextPropsStr := lTextPropsStr + ' style:font-style-asian="italic" ';
lTextPropsStr := lTextPropsStr + ' style:font-style-complex="italic" ';
if CurStyle.Font.Italic then
begin
lTextPropsStr := lTextPropsStr + ' fo:font-style="italic" ';
lTextPropsStr := lTextPropsStr + ' style:font-style-asian="italic" ';
lTextPropsStr := lTextPropsStr + ' style:font-style-complex="italic" ';
end
else
begin
// ToDo
end;
end;
lCurStyleTmpStr := // tmp string to help see the text in the debugger
' <style:style style:name="'+StyleNameToODTStyleName(AData, i, False)+'" style:display-name="'+ CurStyle.Name +'" style:family="paragraph" style:parent-style-name="'+CurStyleParent+'" style:class="text">' + LineEnding +
' <style:paragraph-properties fo:margin-top="'+FloatToODTText(CurStyle.MarginTop)+'mm" fo:margin-bottom="'+FloatToODTText(CurStyle.MarginTop)+'mm" style:contextual-spacing="false" />' + LineEnding +
' <style:text-properties '+lTextPropsStr+' />' + LineEnding +
' </style:style>' + LineEnding;
FStyles := FStyles + lCurStyleTmpStr;
if CurStyle.GetKind() = vskTextSpan then
begin
{
<style:style style:name="MT2" style:family="text">
<style:text-properties fo:font-style="italic" fo:font-weight="normal" officeooo:rsid="0009f49c" style:font-style-asian="italic" style:font-weight-asian="normal" style:font-style-complex="italic" style:font-weight-complex="normal" />
</style:style>
}
lCurStyleTmpStr := // tmp string to help see the text in the debugger
' <style:style style:name="'+StyleNameToODTStyleName(AData, i, False)+'" style:display-name="'+ CurStyle.Name +'" style:family="text" style:parent-style-name="'+CurStyleParent+'" >' + LineEnding +
' <style:text-properties '+lTextPropsStr+' />' + LineEnding +
' </style:style>' + LineEnding;
FStyles := FStyles + lCurStyleTmpStr;
end
// Paragraph kind
else
begin
lCurStyleTmpStr := // tmp string to help see the text in the debugger
' <style:style style:name="'+StyleNameToODTStyleName(AData, i, False)+'" style:display-name="'+ CurStyle.Name +'" style:family="paragraph" style:parent-style-name="'+CurStyleParent+'" style:class="text">' + LineEnding +
' <style:paragraph-properties fo:margin-top="'+FloatToODTText(CurStyle.MarginTop)+'mm" fo:margin-bottom="'+FloatToODTText(CurStyle.MarginTop)+'mm" style:contextual-spacing="false" />' + LineEnding +
' <style:text-properties '+lTextPropsStr+' />' + LineEnding +
' </style:style>' + LineEnding;
FStyles := FStyles + lCurStyleTmpStr;
end;
{
<style:style style:name="Heading" style:family="paragraph" style:parent-style-name="Standard" style:next-style-name="Text_20_body" style:class="text">
<style:paragraph-properties fo:margin-top="0.423cm" fo:margin-bottom="0.212cm" style:contextual-spacing="false" fo:keep-with-next="always" />
@ -728,7 +772,7 @@ begin
' </office:automatic-styles>' + LineEnding;
FContent := FContent +
' <office:body>' + LineEnding;
' <office:body>' + LineEnding;
for i := 0 to AData.GetPageCount()-1 do
begin
@ -738,7 +782,7 @@ begin
FContent := FContent +
' <office:text>' + LineEnding;
WritePage(CurTextPage);
WritePage(CurTextPage, AData);
FContent := FContent +
' </office:text>' + LineEnding;
@ -751,7 +795,7 @@ begin
'</office:document-content>' + LineEnding;
end;
procedure TvODTVectorialWriter.WritePage(ACurPage: TvTextPageSequence);
procedure TvODTVectorialWriter.WritePage(ACurPage: TvTextPageSequence; AData: TvVectorialDocument);
var
i: Integer;
lCurEntity: TvEntity;
@ -775,14 +819,16 @@ begin
if not (lCurEntity is TvParagraph) then Continue;
WriteParagraph(TvParagraph(lCurEntity), ACurPage);
WriteParagraph(TvParagraph(lCurEntity), ACurPage, AData);
end;
end;
procedure TvODTVectorialWriter.WriteParagraph(AEntity: TvParagraph;
ACurPage: TvTextPageSequence);
ACurPage: TvTextPageSequence; AData: TvVectorialDocument);
var
EntityKindName, AEntityStyleName: string;
i: Integer;
lCurEntity: TvEntity;
begin
if AEntity.Style = nil then
begin
@ -797,12 +843,22 @@ begin
EntityKindName := 'p';
end;
AEntityStyleName := AEntity.Style.Name;
AEntityStyleName := StyleNameToODTStyleName(AData, AEntity.Style, False);
end;
FContent := FContent +
' <text:'+EntityKindName+' text:style-name="'+AEntityStyleName+'" >';
for i := 0 to AEntity.GetEntitiesCount()-1 do
begin
lCurEntity := AEntity.GetEntity(i);
if not (lCurEntity is TvText) then Continue;
WriteTextSpan(TvText(lCurEntity), ACurPage, AData);
end;
FContent := FContent +
' <text:'+EntityKindName+' text:style-name="'+AEntityStyleName+'" >' +
' ' +
'</text:'+EntityKindName+'>' + LineEnding;
{
<text:h text:style-name="P2" text:outline-level="1">Laza<text:span text:style-name="T1">ru</text:span>s</text:h>
@ -859,6 +915,34 @@ begin
end;
procedure TvODTVectorialWriter.WriteTextSpan(AEntity: TvText;
ACurPage: TvTextPageSequence; AData: TvVectorialDocument);
var
AEntityStyleName: string;
begin
if AEntity.Style = nil then
begin
AEntityStyleName := 'Standard';
end
else
begin
AEntityStyleName := StyleNameToODTStyleName(AData, AEntity.Style, False);
end;
{
<text:p text:style-name="P2">
Lazaru
<text:span text:style-name="T2">s is a fre</text:span>
e and open sou
<text:span text:style-name="T5">rce development tool for</text:span>
the Free Pascal compiler, which is also free and open source.
</text:p>
}
// Note that here we write only text spans!
FContent := FContent +
'<text:span text:style-name="'+AEntityStyleName+'">'+AEntity.Value.Text+'</text:span>';
end;
function TvODTVectorialWriter.WriteStylesXMLAsString: string;
begin

2
components/fpvectorial/svgvectorialwriter.pas
View File

@ -229,7 +229,7 @@ begin
// Now data
AStrings.Add(' <g id="layer1">');
lPage := AData.GetPage(0);
lPage := AData.GetPageAsVectorial(0);
WriteEntities(AStrings, lPage, AData);
AStrings.Add(' </g>');