paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-05-25 16:22:45 +02:00
Code Issues Packages Projects Releases Wiki Activity

fpvectorial: Font size as floating point value, issue #40073, patch by Johann Glaser.

Browse Source
This commit is contained in:
wp_xyz 2022-12-31 00:49:37 +01:00
parent cc81fa77a5
commit 53f7749d99
6 changed files with 41 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
components/fpvectorial/docxvectorialwriter.pas
View File

@ -173,6 +173,7 @@ Type
FData: TvVectorialDocument; FData: TvVectorialDocument;
FFiles: TFileList; FFiles: TFileList;
FPointSeparator: TFormatSettings;
Function PrepareContentTypes: String; Function PrepareContentTypes: String;
Function PrepareRelationships: String; Function PrepareRelationships: String;
@ -184,6 +185,7 @@ Type
Procedure PrepareTextRunStyle(ADoc: TIndentedStringList; AStyle: TvStyle); Procedure PrepareTextRunStyle(ADoc: TIndentedStringList; AStyle: TvStyle);
Function StyleNameToStyleID(AStyle: TvStyle): String; Function StyleNameToStyleID(AStyle: TvStyle): String;
function FloatToDOCXStr(x: Double): String;
Public Public
{ General reading methods } { General reading methods }
Constructor Create; Override; Constructor Create; Override;
@ -461,6 +463,10 @@ Begin
Inherited Create; Inherited Create;
FFiles := TFileList.Create; FFiles := TFileList.Create;
// Format seetings to convert a string to a float
FPointSeparator := DefaultFormatSettings;
FPointSeparator.DecimalSeparator := '.';
FPointSeparator.ThousandSeparator := '#';// disable the thousand separator
End; End;
Destructor TvDOCXVectorialWriter.Destroy; Destructor TvDOCXVectorialWriter.Destroy;
@ -1077,6 +1083,11 @@ Begin
End; End;
End; End;
Function TvDOCXVectorialWriter.FloatToDOCXStr(x : Double) : String;
Begin
Result := FloatToStr(x, FPointSeparator);
End;
Procedure TvDOCXVectorialWriter.PrepareTextRunStyle(ADoc: TIndentedStringList; Procedure TvDOCXVectorialWriter.PrepareTextRunStyle(ADoc: TIndentedStringList;
AStyle: TvStyle); AStyle: TvStyle);
Begin Begin
@ -1088,7 +1099,7 @@ Begin
If spbfFontSize In AStyle.SetElements Then If spbfFontSize In AStyle.SetElements Then
{ TODO : Where does the magic Font.Size*2 come from? Confirm... } { TODO : Where does the magic Font.Size*2 come from? Confirm... }
ADoc.Add('<w:sz w:val="' + IntToStr(2 * AStyle.Font.Size) + '"/>'); ADoc.Add('<w:sz w:val="' + FloatToDOCXStr(2 * AStyle.Font.Size) + '"/>');
If spbfFontBold In AStyle.SetElements Then If spbfFontBold In AStyle.SetElements Then
ADoc.Add('<w:b w:val="' + LU_ON_OFF[AStyle.Font.Bold] + '"/>'); ADoc.Add('<w:b w:val="' + LU_ON_OFF[AStyle.Font.Bold] + '"/>');

4
components/fpvectorial/dxfvectorialreader.pas
View File

@ -1759,7 +1759,7 @@ begin
Result.Value.Text := Str; Result.Value.Text := Str;
Result.X := PosX; Result.X := PosX;
Result.Y := PosY; Result.Y := PosY;
Result.Font.Size := Round(FontSize); Result.Font.Size := FontSize;
Result.Font.Color := colWhite; Result.Font.Color := colWhite;
if not AOnlyCreate then AData.AddEntity(Result); if not AOnlyCreate then AData.AddEntity(Result);
end; end;
@ -2026,7 +2026,7 @@ begin
PosY := PosY + FontSize - DOC_OFFSET.Y; PosY := PosY + FontSize - DOC_OFFSET.Y;
// //
Result := AData.AddText(PosX, PosY, 0, '', Round(FontSize), Str, AOnlyCreate); Result := AData.AddText(PosX, PosY, 0, '', FontSize, Str, AOnlyCreate);
Result.Font.Color := colWhite; Result.Font.Color := colWhite;
end; end;

37
components/fpvectorial/fpvectorial.pas
View File

@ -174,7 +174,7 @@ type
TvFont = record TvFont = record
Color: TFPColor; Color: TFPColor;
Size: integer; Size: Double;
Name: utf8string; Name: utf8string;
{@@ {@@
Font orientation is measured in degrees and uses the Font orientation is measured in degrees and uses the
@ -1565,7 +1565,7 @@ type
procedure SetPenWidth(AWidth: Integer); procedure SetPenWidth(AWidth: Integer);
procedure SetClipPath(AClipPath: TPath; AClipMode: TvClipMode); procedure SetClipPath(AClipPath: TPath; AClipMode: TvClipMode);
function EndPath(AOnlyCreate: Boolean = False): TPath; function EndPath(AOnlyCreate: Boolean = False): TPath;
function AddText(AX, AY, AZ: Double; FontName: string; FontSize: integer; AText: utf8string; AOnlyCreate: Boolean = False): TvText; overload; function AddText(AX, AY, AZ: Double; FontName: string; FontSize: Double; AText: utf8string; AOnlyCreate: Boolean = False): TvText; overload;
function AddText(AX, AY: Double; AStr: utf8string; AOnlyCreate: Boolean = False): TvText; overload; function AddText(AX, AY: Double; AStr: utf8string; AOnlyCreate: Boolean = False): TvText; overload;
function AddText(AX, AY, AZ: Double; AStr: utf8string; AOnlyCreate: Boolean = False): TvText; overload; function AddText(AX, AY, AZ: Double; AStr: utf8string; AOnlyCreate: Boolean = False): TvText; overload;
function AddCircle(ACenterX, ACenterY, ARadius: Double; AOnlyCreate: Boolean = False): TvCircle; function AddCircle(ACenterX, ACenterY, ARadius: Double; AOnlyCreate: Boolean = False): TvCircle;
@ -2068,7 +2068,7 @@ begin
if spbfFontColor in SetElements then if spbfFontColor in SetElements then
lStr := lStr + Format(' Font.Color=%s', [TvEntity.GenerateDebugStrForFPColor(Pen.Color)]); lStr := lStr + Format(' Font.Color=%s', [TvEntity.GenerateDebugStrForFPColor(Pen.Color)]);
if spbfFontSize in SetElements then if spbfFontSize in SetElements then
lStr := lStr + Format(' Font.Size=%d', [Font.Size]); lStr := lStr + Format(' Font.Size=%f', [Font.Size]);
if spbfFontName in SetElements then if spbfFontName in SetElements then
lStr := lStr + ' Font.Name=' + Font.Name; lStr := lStr + ' Font.Name=' + Font.Name;
if spbfFontBold in SetElements then if spbfFontBold in SetElements then
@ -4640,7 +4640,7 @@ end;
procedure TvEntityWithPenBrushAndFont.Scale(ADeltaScaleX, ADeltaScaleY: Double); procedure TvEntityWithPenBrushAndFont.Scale(ADeltaScaleX, ADeltaScaleY: Double);
begin begin
inherited Scale(ADeltaScaleX, ADeltaScaleY); inherited Scale(ADeltaScaleX, ADeltaScaleY);
Font.Size := Round(Font.Size * ADeltaScaleX); Font.Size := Font.Size * ADeltaScaleX;
end; end;
procedure TvEntityWithPenBrushAndFont.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean); procedure TvEntityWithPenBrushAndFont.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
@ -4656,7 +4656,7 @@ var
begin begin
Result := inherited GenerateDebugTree(ADestRoutine, APageItem); Result := inherited GenerateDebugTree(ADestRoutine, APageItem);
// Add the font debug info in a sub-item // Add the font debug info in a sub-item
lStr := Format('[Font] Color=%s Size=%d Name=%s Orientation=%f Bold=%s Italic=%s Underline=%s StrikeThrough=%s', lStr := Format('[Font] Color=%s Size=%f Name=%s Orientation=%f Bold=%s Italic=%s Underline=%s StrikeThrough=%s',
[GenerateDebugStrForFPColor(Font.Color), [GenerateDebugStrForFPColor(Font.Color),
Font.Size, Font.Name, Font.Orientation, Font.Size, Font.Name, Font.Orientation,
BoolToStr(Font.Bold), BoolToStr(Font.Bold),
@ -5608,7 +5608,7 @@ var
ACanvas: TCanvas absolute ARenderInfo.Canvas; ACanvas: TCanvas absolute ARenderInfo.Canvas;
tm: TLCLTextMetric; tm: TLCLTextMetric;
{$else} {$else}
lFontSizePx: Integer; lFontSizePx: Double;
lTextSize: TSize; lTextSize: TSize;
{$endif} {$endif}
begin begin
@ -5621,7 +5621,7 @@ begin
lFontSizePx := Font.Size; // is without multiplier! lFontSizePx := Font.Size; // is without multiplier!
if lFontSizePx = 0 then lFontSizePx := 10; if lFontSizePx = 0 then lFontSizePx := 10;
lTextSize := ADest.TextExtent(Str_Line_Height_Tester); lTextSize := ADest.TextExtent(Str_Line_Height_Tester);
Result := (lTextSize.CY - lFontSizePx) div 2; // rough estimate only Result := Round((lTextSize.CY*1.0 - lFontSizePx) * 0.5); // rough estimate only
{$ENDIF} {$ENDIF}
end; end;
@ -5708,7 +5708,8 @@ var
pt, refPt: TPoint; pt, refPt: TPoint;
LowerDimY, UpperDimY, CurDimY: Double; LowerDimY, UpperDimY, CurDimY: Double;
XAnchorAdjustment: Integer; XAnchorAdjustment: Integer;
lLongestLine, lLineWidth, lFontSizePx, lFontDescenderPx: Integer; lLongestLine, lLineWidth, lFontDescenderPx: Integer;
lFontSizePx: Double;
lText: string; lText: string;
lDescender: Integer; lDescender: Integer;
phi: Double; phi: Double;
@ -5840,7 +5841,7 @@ var
lStr, lValueStr: string; lStr, lValueStr: string;
begin begin
lValueStr := GenerateDebugStrForString(Value.Text); lValueStr := GenerateDebugStrForString(Value.Text);
lStr := Format('[%s] Name=%s X=%f Y=%f Text="%s" [.Font=>] Color=%s Size=%d Name=%s Orientation=%f Bold=%s Italic=%s Underline=%s StrikeThrough=%s TextAnchor=%s', lStr := Format('[%s] Name=%s X=%f Y=%f Text="%s" [.Font=>] Color=%s Size=%f Name=%s Orientation=%f Bold=%s Italic=%s Underline=%s StrikeThrough=%s TextAnchor=%s',
[ [
Self.ClassName, Name, X, Y, lValueStr, Self.ClassName, Name, X, Y, lValueStr,
GenerateDebugStrForFPColor(Font.Color), GenerateDebugStrForFPColor(Font.Color),
@ -7456,7 +7457,7 @@ var
var var
LeftC, TopC: Integer; LeftC, TopC: Integer;
lPt: array[0..3] of TPoint; lPt: array[0..3] of TPoint;
lOldFontSize: Integer; lOldFontSize: Double;
lStr: string; lStr: string;
begin begin
LeftC := CoordToCanvasX(Left); LeftC := CoordToCanvasX(Left);
@ -7517,9 +7518,9 @@ begin
// The superscripted power // The superscripted power
lOldFontSize := ADest.Font.Size; lOldFontSize := ADest.Font.Size;
if lOldFontSize = 0 then ADest.Font.Size := 5 if lOldFontSize = 0 then ADest.Font.Size := 5
else ADest.Font.Size := lOldFontSize div 2; else ADest.Font.Size := Round(lOldFontSize * 0.5);
AdjacentFormula.Render(ARenderInfo, ADoDraw); AdjacentFormula.Render(ARenderInfo, ADoDraw);
ADest.Font.Size := lOldFontSize; ADest.Font.Size := Round(lOldFontSize);
end; end;
fekSubscript: fekSubscript:
begin begin
@ -7527,9 +7528,9 @@ begin
// The subscripted item // The subscripted item
lOldFontSize := ADest.Font.Size; lOldFontSize := ADest.Font.Size;
if lOldFontSize = 0 then ADest.Font.Size := 5 if lOldFontSize = 0 then ADest.Font.Size := 5
else ADest.Font.Size := lOldFontSize div 2; else ADest.Font.Size := Round(lOldFontSize * 0.5);
AdjacentFormula.Render(ARenderInfo, ADoDraw); AdjacentFormula.Render(ARenderInfo, ADoDraw);
ADest.Font.Size := lOldFontSize; ADest.Font.Size := Round(lOldFontSize);
end; end;
fekSummation: fekSummation:
begin begin
@ -7538,7 +7539,7 @@ begin
ADest.Font.Size := 15; ADest.Font.Size := 15;
lStr := #$E2#$88#$91; // Unicode Character 'N-ARY SUMMATION' (U+2211) lStr := #$E2#$88#$91; // Unicode Character 'N-ARY SUMMATION' (U+2211)
ADest.TextOut(LeftC, TopC, lStr); ADest.TextOut(LeftC, TopC, lStr);
ADest.Font.Size := lOldFontSize; ADest.Font.Size := Round(lOldFontSize);
// Draw the bottom/main formula // Draw the bottom/main formula
Formula.Render(ARenderInfo, ADoDraw); Formula.Render(ARenderInfo, ADoDraw);
@ -8194,7 +8195,7 @@ begin
if spbfFontColor in SetPenBrushAndFontElements then if spbfFontColor in SetPenBrushAndFontElements then
lStr := lStr + Format(' Font.Color=%s', [GenerateDebugStrForFPColor(Font.Color)]); lStr := lStr + Format(' Font.Color=%s', [GenerateDebugStrForFPColor(Font.Color)]);
if spbfFontSize in SetPenBrushAndFontElements then if spbfFontSize in SetPenBrushAndFontElements then
lStr := lStr + Format(' Font.Size=%d', [Font.Size]); lStr := lStr + Format(' Font.Size=%f', [Font.Size]);
Result := ADestRoutine(lStr, APageItem); Result := ADestRoutine(lStr, APageItem);
@ -9508,7 +9509,7 @@ begin
end; end;
function TvVectorialPage.AddText(AX, AY, AZ: Double; FontName: string; function TvVectorialPage.AddText(AX, AY, AZ: Double; FontName: string;
FontSize: integer; AText: utf8string; AOnlyCreate: Boolean = False): TvText; FontSize: Double; AText: utf8string; AOnlyCreate: Boolean = False): TvText;
var var
lText: TvText; lText: TvText;
begin begin
@ -10487,7 +10488,7 @@ begin
case AFormat of case AFormat of
vfHTML: lCurStyle.Font.Size := 20; vfHTML: lCurStyle.Font.Size := 20;
else else
lCurStyle.Font.Size := Round(1.15 * lBaseHeading.Font.Size); lCurStyle.Font.Size := 1.15 * lBaseHeading.Font.Size;
end; end;
lCurStyle.Brush.Style := bsClear; lCurStyle.Brush.Style := bsClear;
lCurStyle.SetElements := [spbfFontSize, spbfFontBold]; lCurStyle.SetElements := [spbfFontSize, spbfFontBold];

6
components/fpvectorial/odtvectorialwriter.pas
View File

@ -1416,9 +1416,9 @@ begin
if spbfFontSize in AStyle.SetElements then if spbfFontSize in AStyle.SetElements then
begin begin
Result := Result + ' fo:font-size="'+IntToStr(AStyle.Font.Size)+'pt" '; Result := Result + ' fo:font-size="'+FloatToODTText(AStyle.Font.Size)+'pt" ';
Result := Result + ' fo:font-size-asian="'+IntToStr(AStyle.Font.Size)+'pt" '; Result := Result + ' fo:font-size-asian="'+FloatToODTText(AStyle.Font.Size)+'pt" ';
Result := Result + ' fo:font-size-complex="'+IntToStr(AStyle.Font.Size)+'pt" '; Result := Result + ' fo:font-size-complex="'+FloatToODTText(AStyle.Font.Size)+'pt" ';
end; end;
if spbfFontName in AStyle.SetElements then if spbfFontName in AStyle.SetElements then

4
components/fpvectorial/svgvectorialreader.pas
View File

@ -1108,8 +1108,8 @@ begin
end end
else if AKey = 'font-size' then else if AKey = 'font-size' then
begin begin
if ADestEntity <> nil then ADestEntity.Font.Size := Round(StringWithUnitToFloat(AValue, sckXSize, suPT, suPT)); if ADestEntity <> nil then ADestEntity.Font.Size := StringWithUnitToFloat(AValue, sckXSize, suPT, suPT);
if ADestStyle <> nil then ADestStyle.Font.Size := Round(StringWithUnitToFloat(AValue, sckXSize, suPT, suPT)); if ADestStyle <> nil then ADestStyle.Font.Size := StringWithUnitToFloat(AValue, sckXSize, suPT, suPT);
Result := Result + [spbfFontSize]; Result := Result + [spbfFontSize];
end end
else if AKey = 'font-family' then else if AKey = 'font-family' then

6
components/fpvectorial/svgvectorialwriter.pas
View File

@ -591,13 +591,13 @@ const
TEXT_ANCHORS: array[TvTextAnchor] of string = ('start', 'middle', 'end'); TEXT_ANCHORS: array[TvTextAnchor] of string = ('start', 'middle', 'end');
TEXT_DECO: array[0..3] of string = ('none', 'underline', 'line-through', 'line-through,underline'); TEXT_DECO: array[0..3] of string = ('none', 'underline', 'line-through', 'line-through,underline');
var var
FontSize: Integer; FontSize: Double;
TextStr: String; TextStr: String;
PtX, PtY: double; PtX, PtY: double;
begin begin
ConvertFPVCoordinatesToSVGCoordinates(APage, AText.X, AText.Y, PtX, PtY); ConvertFPVCoordinatesToSVGCoordinates(APage, AText.X, AText.Y, PtX, PtY);
TextStr := AText.Value.Text; TextStr := AText.Value.Text;
FontSize:= ceil(AText.Font.Size * FLOAT_PIXELS_PER_MILLIMETER); FontSize:= AText.Font.Size * FLOAT_PIXELS_PER_MILLIMETER;
AStrings.Add(' <text '); AStrings.Add(' <text ');
// Discussion about this offset in bugs 22091 and 26817 // Discussion about this offset in bugs 22091 and 26817
@ -630,7 +630,7 @@ begin
Format(' font-family="%s"', [AText.Font.Name])); Format(' font-family="%s"', [AText.Font.Name]));
AStrings.Add( AStrings.Add(
Format(' font-size="%d"', [FontSize])); Format(' font-size="%f"', [FontSize], FPointSeparator));
AStrings.Add( AStrings.Add(
Format(' fill="#%s"', [FPColorToRGBHexString(AText.Font.Color)])); Format(' fill="#%s"', [FPColorToRGBHexString(AText.Font.Color)]));