mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-06-04 08:38:23 +02:00
TAChart: Fix font rotation for svg drawer. Add class helper to TChart for saving to svg.
git-svn-id: trunk@55434 -
This commit is contained in:
parent
658713d714
commit
586c68002e
@ -7,7 +7,7 @@ object Form1: TForm1
|
|||||||
ClientHeight = 299
|
ClientHeight = 299
|
||||||
ClientWidth = 538
|
ClientWidth = 538
|
||||||
OnCreate = FormCreate
|
OnCreate = FormCreate
|
||||||
LCLVersion = '1.5'
|
LCLVersion = '1.9.0.0'
|
||||||
object Chart1: TChart
|
object Chart1: TChart
|
||||||
Left = 0
|
Left = 0
|
||||||
Height = 275
|
Height = 275
|
||||||
@ -48,7 +48,6 @@ object Form1: TForm1
|
|||||||
'TAChart'
|
'TAChart'
|
||||||
)
|
)
|
||||||
Align = alClient
|
Align = alClient
|
||||||
ParentColor = False
|
|
||||||
object Chart1BarSeries1: TBarSeries
|
object Chart1BarSeries1: TBarSeries
|
||||||
Marks.Format = '%0:.9g'
|
Marks.Format = '%0:.9g'
|
||||||
Marks.Style = smsValue
|
Marks.Style = smsValue
|
||||||
@ -66,6 +65,7 @@ object Form1: TForm1
|
|||||||
Height = 24
|
Height = 24
|
||||||
Top = 0
|
Top = 0
|
||||||
Width = 538
|
Width = 538
|
||||||
|
ButtonHeight = 22
|
||||||
ButtonWidth = 100
|
ButtonWidth = 100
|
||||||
Caption = 'ToolBar1'
|
Caption = 'ToolBar1'
|
||||||
Flat = False
|
Flat = False
|
||||||
|
@ -91,6 +91,10 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TForm1.tbSaveAsSVGClick(Sender: TObject);
|
procedure TForm1.tbSaveAsSVGClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
Chart1.SaveToSVGFile(GetFilename('svg'));
|
||||||
|
end;
|
||||||
|
{ or ...
|
||||||
var
|
var
|
||||||
fs: TFileStream;
|
fs: TFileStream;
|
||||||
id: IChartDrawer;
|
id: IChartDrawer;
|
||||||
@ -103,7 +107,7 @@ begin
|
|||||||
finally
|
finally
|
||||||
fs.Free;
|
fs.Free;
|
||||||
end;
|
end;
|
||||||
end;
|
end; }
|
||||||
|
|
||||||
end.
|
end.
|
||||||
|
|
||||||
|
@ -14,7 +14,7 @@ unit TADrawerSVG;
|
|||||||
interface
|
interface
|
||||||
|
|
||||||
uses
|
uses
|
||||||
Graphics, Classes, FPImage, FPCanvas, TAChartUtils, TADrawUtils;
|
Graphics, Classes, FPImage, FPCanvas, TAChartUtils, TADrawUtils, TAGraph;
|
||||||
|
|
||||||
type
|
type
|
||||||
TSVGFont = record
|
TSVGFont = record
|
||||||
@ -22,10 +22,7 @@ type
|
|||||||
Color: TFPColor;
|
Color: TFPColor;
|
||||||
Size: integer;
|
Size: integer;
|
||||||
Orientation: Integer; // angle * 10 (90° --> 900), >0 if ccw.
|
Orientation: Integer; // angle * 10 (90° --> 900), >0 if ccw.
|
||||||
Bold: boolean;
|
Style: TChartFontStyles;
|
||||||
Italic: boolean;
|
|
||||||
Underline: boolean;
|
|
||||||
StrikeThrough: boolean;
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
@ -56,7 +53,6 @@ type
|
|||||||
procedure WriteFmt(const AFormat: String; AParams: array of const);
|
procedure WriteFmt(const AFormat: String; AParams: array of const);
|
||||||
procedure WriteStr(const AString: String);
|
procedure WriteStr(const AString: String);
|
||||||
strict protected
|
strict protected
|
||||||
function GetFontAngle: Double; override;
|
|
||||||
function SimpleTextExtent(const AText: String): TPoint; override;
|
function SimpleTextExtent(const AText: String): TPoint; override;
|
||||||
procedure SimpleTextOut(AX, AY: Integer; const AText: String); override;
|
procedure SimpleTextOut(AX, AY: Integer; const AText: String); override;
|
||||||
|
|
||||||
@ -73,6 +69,7 @@ type
|
|||||||
procedure Ellipse(AX1, AY1, AX2, AY2: Integer);
|
procedure Ellipse(AX1, AY1, AX2, AY2: Integer);
|
||||||
procedure FillRect(AX1, AY1, AX2, AY2: Integer);
|
procedure FillRect(AX1, AY1, AX2, AY2: Integer);
|
||||||
function GetBrushColor: TChartColor;
|
function GetBrushColor: TChartColor;
|
||||||
|
function GetFontAngle: Double; override;
|
||||||
function GetFontColor: TFPColor; override;
|
function GetFontColor: TFPColor; override;
|
||||||
function GetFontName: String; override;
|
function GetFontName: String; override;
|
||||||
function GetFontSize: Integer; override;
|
function GetFontSize: Integer; override;
|
||||||
@ -100,6 +97,14 @@ type
|
|||||||
procedure SetPenParams(AStyle: TFPPenStyle; AColor: TChartColor);
|
procedure SetPenParams(AStyle: TFPPenStyle; AColor: TChartColor);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ TSVGChartHelper }
|
||||||
|
|
||||||
|
TSVGChartHelper = class helper for TChart
|
||||||
|
procedure SaveToSVGFile(const AFileName: String);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
|
||||||
uses
|
uses
|
||||||
@ -254,7 +259,7 @@ end;
|
|||||||
|
|
||||||
function TSVGDrawer.GetFontAngle: Double;
|
function TSVGDrawer.GetFontAngle: Double;
|
||||||
begin
|
begin
|
||||||
Result := FFont.Orientation;
|
Result := OrientToRad(FFont.Orientation);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TSVGDrawer.GetFontColor: TFPColor;
|
function TSVGDrawer.GetFontColor: TFPColor;
|
||||||
@ -274,11 +279,7 @@ end;
|
|||||||
|
|
||||||
function TSVGDrawer.GetFontStyle: TChartFontStyles;
|
function TSVGDrawer.GetFontStyle: TChartFontStyles;
|
||||||
begin
|
begin
|
||||||
Result := [];
|
Result := FFont.Style;
|
||||||
if FFont.Bold then Include(Result, cfsBold);
|
|
||||||
if FFont.Italic then Include(Result, cfsItalic);
|
|
||||||
if FFont.Underline then Include(Result, cfsUnderline);
|
|
||||||
if FFont.StrikeThrough then Include(Result, cfsStrikeout);
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TSVGDrawer.Line(AX1, AY1, AX2, AY2: Integer);
|
procedure TSVGDrawer.Line(AX1, AY1, AX2, AY2: Integer);
|
||||||
@ -459,10 +460,11 @@ begin
|
|||||||
Color := AFont.FPColor;
|
Color := AFont.FPColor;
|
||||||
|
|
||||||
Orientation := FGetFontOrientationFunc(AFont);
|
Orientation := FGetFontOrientationFunc(AFont);
|
||||||
FFont.Bold := AFont.Bold;
|
FFont.Style := [];
|
||||||
FFont.Italic := AFont.Italic;
|
if AFont.Bold then Include(FFont.Style, cfsBold);
|
||||||
FFont.Underline := AFont.Underline;
|
if AFont.Italic then Include(FFont.Style, cfsItalic);
|
||||||
FFont.Strikethrough := AFont.Strikethrough;
|
if AFont.Underline then Include(FFont.Style, cfsUnderline);
|
||||||
|
if AFont.StrikeThrough then Include(FFont.Style, cfsStrikeout);
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -508,15 +510,15 @@ begin
|
|||||||
|
|
||||||
sstyle := Format('fill:%s; font-family:''%s''; font-size:%dpt;',
|
sstyle := Format('fill:%s; font-family:''%s''; font-size:%dpt;',
|
||||||
[ColorToHex(FFont.Color), FFont.Name, FontSize]);
|
[ColorToHex(FFont.Color), FFont.Name, FontSize]);
|
||||||
if FFont.Bold then
|
if (cfsBold in FFont.Style) then
|
||||||
sstyle := sstyle + ' font-weight:bold;';
|
sstyle := sstyle + ' font-weight:bold;';
|
||||||
if FFont.Italic then
|
if (cfsItalic in FFont.Style) then
|
||||||
sstyle := sstyle + ' font-style:oblique;';
|
sstyle := sstyle + ' font-style:oblique;';
|
||||||
if FFont.Underline and FFont.Strikethrough then
|
if FFont.Style * [cfsUnderline, cfsStrikeout] = [cfsUnderline, cfsStrikeout] then
|
||||||
sstyle := sstyle + ' text-decoration:underline,line-through;'
|
sstyle := sstyle + ' text-decoration:underline,line-through;'
|
||||||
else if FFont.Underline then
|
else if FFont.Style * [cfsUnderline, cfsStrikeout] = [cfsUnderline] then
|
||||||
sstyle := sstyle + ' text-deocration:underline;'
|
sstyle := sstyle + ' text-deocration:underline;'
|
||||||
else if FFont.Strikethrough then
|
else if FFont.Style * [cfsUnderline, cfsStrikeout] = [cfsStrikeout] then
|
||||||
sstyle := sstyle + ' text-decoration:line-through;';
|
sstyle := sstyle + ' text-decoration:line-through;';
|
||||||
if OpacityStr <> '' then
|
if OpacityStr <> '' then
|
||||||
sstyle := sstyle + OpacityStr + ';';
|
sstyle := sstyle + OpacityStr + ';';
|
||||||
@ -526,7 +528,7 @@ end;
|
|||||||
|
|
||||||
function TSVGDrawer.StyleFill: String;
|
function TSVGDrawer.StyleFill: String;
|
||||||
|
|
||||||
function AddPattern(APattern: String): String;
|
function AddPattern(APattern: String): String;
|
||||||
var
|
var
|
||||||
i: Integer;
|
i: Integer;
|
||||||
begin
|
begin
|
||||||
@ -590,6 +592,22 @@ begin
|
|||||||
FStream.WriteBuffer(le[1], Length(le));
|
FStream.WriteBuffer(le[1], Length(le));
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ TSVGChartHelper }
|
||||||
|
|
||||||
|
procedure TSVGChartHelper.SaveToSVGFile(const AFileName: String);
|
||||||
|
var
|
||||||
|
fs: TFileStream;
|
||||||
|
begin
|
||||||
|
fs := TFileStream.Create(AFileName, fmCreate);
|
||||||
|
try
|
||||||
|
Draw(TSVGDrawer.Create(fs, true), Rect(0, 0, Width, Height));
|
||||||
|
finally
|
||||||
|
fs.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
initialization
|
initialization
|
||||||
|
|
||||||
fmtSettings := DefaultFormatSettings;
|
fmtSettings := DefaultFormatSettings;
|
||||||
|
Loading…
Reference in New Issue
Block a user