diff --git a/components/tachart/aggpas/tadraweraggpas.pas b/components/tachart/aggpas/tadraweraggpas.pas
index 1cc7d4dca4..c73285c215 100644
--- a/components/tachart/aggpas/tadraweraggpas.pas
+++ b/components/tachart/aggpas/tadraweraggpas.pas
@@ -41,6 +41,10 @@ type
procedure Ellipse(AX1, AY1, AX2, AY2: Integer);
procedure FillRect(AX1, AY1, AX2, AY2: Integer);
function GetBrushColor: TChartColor;
+ function GetFontColor: TFPColor; override;
+ function GetFontName: String; override;
+ function GetFontSize: Integer; override;
+ function GetFontStyle: TChartFontStyles; override;
procedure Line(AX1, AY1, AX2, AY2: Integer);
procedure Line(const AP1, AP2: TPoint);
procedure LineTo(AX, AY: Integer); override;
@@ -123,6 +127,34 @@ begin
Result := FCanvas.Font.AggAngle;
end;
+function TAggPasDrawer.GetFontColor: TFPColor;
+begin
+ Result.Red := FCanvas.Font.AggColor.r shl 8;
+ Result.Green := FCanvas.Font.AggColor.g shl 8;
+ Result.Blue := FCanvas.Font.AggColor.b shl 8;
+end;
+
+function TAggPasDrawer.GetFontName: String;
+begin
+ Result := FCanvas.Font.Name;
+end;
+
+function TAggPasDrawer.GetFontSize: Integer;
+begin
+ if FCanvas.Font.AggHeight = 0 then
+ Result := DEFAULT_FONT_SIZE else
+ Result := round(FCanvas.Font.AggHeight * 72 / 96);
+end;
+
+function TAggPasDrawer.GetFontStyle: TChartFontStyles;
+begin
+ Result := [];
+ if FCanvas.Font.Bold then Include(Result, cfsBold);
+ if FCanvas.Font.Italic then Include(Result, cfsItalic);
+ if FCanvas.Font.Underline then Include(Result, cfsUnderline);
+ if FCanvas.Font.StrikeThrough then Include(Result, cfsStrikeout);
+end;
+
procedure TAggPasDrawer.Line(AX1, AY1, AX2, AY2: Integer);
begin
FCanvas.Line(AX1, AY1, AX2, AY2);
diff --git a/components/tachart/tachartaxisutils.pas b/components/tachart/tachartaxisutils.pas
index e056468878..54380a2728 100644
--- a/components/tachart/tachartaxisutils.pas
+++ b/components/tachart/tachartaxisutils.pas
@@ -59,6 +59,7 @@ type
property LabelBrush;
property PositionOnMarks: Boolean
read FPositionOnMarks write SetPositionOnMarks default false;
+ property TextFormat;
property Visible default false;
end;
@@ -138,6 +139,7 @@ type
property Source: TCustomChartSource read FSource write SetSource;
property Stripes;
property Style default smsValue;
+ property TextFormat;
property YIndex;
end;
diff --git a/components/tachart/tachartlazaruspkg.lpk b/components/tachart/tachartlazaruspkg.lpk
index 29f9b0adbc..9ad620a9b4 100644
--- a/components/tachart/tachartlazaruspkg.lpk
+++ b/components/tachart/tachartlazaruspkg.lpk
@@ -29,7 +29,7 @@
for details about the copyright.
"/>
-
+
@@ -245,6 +245,10 @@
+
+
+
+
diff --git a/components/tachart/tachartlazaruspkg.pas b/components/tachart/tachartlazaruspkg.pas
index 8617cdfb56..9a6ad92405 100644
--- a/components/tachart/tachartlazaruspkg.pas
+++ b/components/tachart/tachartlazaruspkg.pas
@@ -17,7 +17,7 @@ uses
TAToolEditors, TAMath, TAChartImageList, TAChartTeeChart, TADataTools,
TAAnimatedSource, TATextElements, TAAxisSource, TASeriesPropEditors,
TACustomFuncSeries, TAFitUtils, TAGUIConnector, TADiagram, TADiagramDrawing,
- TADiagramLayout, TAChartStrConsts, TAChartCombos, LazarusPackageIntf;
+ TADiagramLayout, TAChartStrConsts, TAChartCombos, TAHtml, LazarusPackageIntf;
implementation
diff --git a/components/tachart/tachartutils.pas b/components/tachart/tachartutils.pas
index 8a7831cf62..74a0cc03f2 100644
--- a/components/tachart/tachartutils.pas
+++ b/components/tachart/tachartutils.pas
@@ -43,6 +43,12 @@ type
// Like TColor, but avoiding dependency on Graphics.
TChartColor = -$7FFFFFFF-1..$7FFFFFFF;
+ // dto with TFontStyle
+ TChartFontStyle = (cfsBold, cfsItalic, cfsUnderline, cfsStrikeout);
+ TChartFontStyles = set of TChartFontStyle;
+
+ TChartTextFormat = (tfNormal, tfHTML);
+
TDoublePoint = record
X, Y: Double;
end;
diff --git a/components/tachart/tadrawerbgra.pas b/components/tachart/tadrawerbgra.pas
index 01ecc3af38..d11f3238f2 100644
--- a/components/tachart/tadrawerbgra.pas
+++ b/components/tachart/tadrawerbgra.pas
@@ -44,6 +44,10 @@ type
procedure Ellipse(AX1, AY1, AX2, AY2: Integer);
procedure FillRect(AX1, AY1, AX2, AY2: Integer);
function GetBrushColor: TChartColor;
+ function GetFontColor: TFPColor; override;
+ function GetFontName: String; override;
+ function GetFontSize: Integer; override;
+ function GetFontStyle: TChartFontStyles; override;
procedure Line(AX1, AY1, AX2, AY2: Integer);
procedure Line(const AP1, AP2: TPoint);
procedure LineTo(AX, AY: Integer); override;
@@ -70,7 +74,7 @@ type
implementation
uses
- BGRAText, Graphics, TAGeometry;
+ BGRAText, Graphics, Math, TAGeometry;
{ TBGRABitmapDrawer }
@@ -135,6 +139,29 @@ begin
Result := 0.0;
end;
+function TBGRABitmapDrawer.GetFontColor: TFPColor;
+begin
+ Result := TColorToFPColor(Canvas.Font.Color);
+end;
+
+function TBGRABitmapDrawer.GetFontName: String;
+begin
+ Result := Canvas.Font.Name;
+end;
+
+function TBGRABitmapDrawer.GetFontSize: Integer;
+begin
+ Result := IfThen(Canvas.Font.Height = 0,
+ DEFAULT_FONT_SIZE,
+ round(abs(Canvas.Font.Height) / ScreenInfo.PixelsPerInchY * 72)
+ );
+end;
+
+function TBGRABitmapDrawer.GetFontStyle: TChartFontStyles;
+begin
+ Result := TChartFontStyles(Canvas.Font.Style);
+end;
+
procedure TBGRABitmapDrawer.Line(AX1, AY1, AX2, AY2: Integer);
begin
Canvas.MoveTo(AX1, AY1);
diff --git a/components/tachart/tadrawercanvas.pas b/components/tachart/tadrawercanvas.pas
index a74c6d0d0a..97a636430b 100644
--- a/components/tachart/tadrawercanvas.pas
+++ b/components/tachart/tadrawercanvas.pas
@@ -35,7 +35,7 @@ type
strict protected
FCanvas: TCanvas;
FBuffer: TBitmap;
- function GetFontAngle: Double; override;
+// function GetFontAngle: Double; override;
function SimpleTextExtent(const AText: String): TPoint; override;
procedure SimpleTextOut(AX, AY: Integer; const AText: String); override;
public
@@ -49,6 +49,11 @@ type
procedure FillRect(AX1, AY1, AX2, AY2: Integer);
function GetBrushColor: TChartColor;
function GetCanvas: TCanvas; virtual;
+ function GetFontAngle: Double; override;
+ function GetFontColor: TFPColor; override;
+ function GetFontName: String; override;
+ function GetFontSize: Integer; override;
+ function GetFontStyle: TChartFontStyles; override;
procedure Line(AX1, AY1, AX2, AY2: Integer);
procedure Line(const AP1, AP2: TPoint);
procedure LineTo(AX, AY: Integer); override;
@@ -84,6 +89,7 @@ type
function CanvasGetFontOrientationFunc(AFont: TFPCustomFont): Integer;
function ChartColorSysToFPColor(AChartColor: TChartColor): TFPColor;
+
implementation
uses
@@ -173,6 +179,32 @@ begin
Result := OrientToRad(GetCanvas.Font.Orientation);
end;
+function TCanvasDrawer.GetFontColor: TFPColor;
+begin
+ Result := TColorToFPColor(GetCanvas.Font.Color);
+end;
+
+function TCanvasDrawer.GetFontName: String;
+begin
+ Result := GetCanvas.Font.Name;
+end;
+
+function TCanvasDrawer.GetFontSize: Integer;
+var
+ h: Integer;
+begin
+ Result := GetCanvas.Font.Size;
+ if Result = 0 then begin
+ h := GetFontData(GetCanvas.Font.Reference.Handle).Height;
+ Result := round(abs(h) * 72 / ScreenInfo.PixelsPerInchY);
+ end;
+end;
+
+function TCanvasDrawer.GetFontStyle: TChartFontStyles;
+begin
+ Result := TChartFontStyles(GetCanvas.Font.Style);
+end;
+
procedure TCanvasDrawer.Line(AX1, AY1, AX2, AY2: Integer);
begin
GetCanvas.Line(AX1, AY1, AX2, AY2);
diff --git a/components/tachart/tadrawerfpcanvas.pas b/components/tachart/tadrawerfpcanvas.pas
index bad9025f7f..06e7fed018 100644
--- a/components/tachart/tadrawerfpcanvas.pas
+++ b/components/tachart/tadrawerfpcanvas.pas
@@ -19,7 +19,7 @@ interface
{$ENDIF}
uses
- Classes, FPCanvas, {$IFDEF USE_FTFONT}FTFont,{$ENDIF}
+ Classes, FPCanvas, FPImage, {$IFDEF USE_FTFONT}FTFont,{$ENDIF}
TAChartUtils, TADrawUtils;
type
@@ -36,7 +36,6 @@ type
procedure SetFont(AFont: TFPCustomFont);
procedure SetPen(APen: TFPCustomPen);
strict protected
- function GetFontAngle: Double; override;
function SimpleTextExtent(const AText: String): TPoint; override;
procedure SimpleTextOut(AX, AY: Integer; const AText: String); override;
public
@@ -50,6 +49,11 @@ type
procedure Ellipse(AX1, AY1, AX2, AY2: Integer);
procedure FillRect(AX1, AY1, AX2, AY2: Integer);
function GetBrushColor: TChartColor;
+ function GetFontAngle: Double; override;
+ function GetFontColor: TFPColor; override;
+ function GetFontName: String; override;
+ function GetFontSize: Integer; override;
+ function GetFontStyle: TChartFontStyles; override;
procedure Line(AX1, AY1, AX2, AY2: Integer);
procedure Line(const AP1, AP2: TPoint);
procedure LineTo(AX, AY: Integer); override;
@@ -160,6 +164,33 @@ begin
Result := 0.0;
end;
+function TFPCanvasDrawer.GetFontColor: TFPColor;
+begin
+ Result := FCanvas.Font.FPColor;
+end;
+
+function TFPCanvasDrawer.GetFontName: String;
+begin
+ Result := FCanvas.Font.Name;
+end;
+
+function TFPCanvasDrawer.GetFontSize: Integer;
+begin
+ if FCanvas.Font.Size = 0 then
+ Result := DEFAULT_FONT_SIZE
+ else
+ Result := FCanvas.Font.Size;
+end;
+
+function TFPCanvasDrawer.GetFontStyle: TChartFontStyles;
+begin
+ Result := [];
+ if FCanvas.Font.Bold then Include(Result, cfsBold);
+ if FCanvas.Font.Italic then Include(Result, cfsItalic);
+ if FCanvas.Font.Underline then Include(Result, cfsUnderline);
+ if FCanvas.Font.Strikethrough then Include(Result, cfsStrikeout);
+end;
+
procedure TFPCanvasDrawer.Line(AX1, AY1, AX2, AY2: Integer);
begin
FCanvas.Line(AX1, AY1, AX2, AY2);
diff --git a/components/tachart/tadrawerfpvectorial.pas b/components/tachart/tadrawerfpvectorial.pas
index e80cf3d702..3d59bcc042 100644
--- a/components/tachart/tadrawerfpvectorial.pas
+++ b/components/tachart/tadrawerfpvectorial.pas
@@ -53,6 +53,10 @@ type
procedure Ellipse(AX1, AY1, AX2, AY2: Integer);
procedure FillRect(AX1, AY1, AX2, AY2: Integer);
function GetBrushColor: TChartColor;
+ function GetFontColor: TFPColor; override;
+ function GetFontName: String; override;
+ function GetFontSize: Integer; override;
+ function GetFontStyle: TChartFontStyles; override;
procedure Line(AX1, AY1, AX2, AY2: Integer);
procedure Line(const AP1, AP2: TPoint); overload;
procedure LineTo(AX, AY: Integer); override;
@@ -177,6 +181,30 @@ begin
Result := FFont.Orientation;
end;
+function TFPVectorialDrawer.GetFontcolor: TFPColor;
+begin
+ Result := FFont.Color;
+end;
+
+function TFPVectorialDrawer.GetFontName: String;
+begin
+ Result := FFont.Name;
+end;
+
+function TFPVectorialDrawer.GetFontSize: Integer;
+begin
+ Result := IfThen(FFont.Size = 0, DEFAULT_FONT_SIZE, FFont.Size);
+end;
+
+function TFPVectorialDrawer.GetFontStyle: TChartFontStyles;
+begin
+ Result := [];
+ 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;
+
function TFPVectorialDrawer.InvertY(AY: Integer): Integer;
begin
with FBoundingBox do
@@ -333,7 +361,7 @@ end;
procedure TFPVectorialDrawer.SetFont(AFont: TFPCustomFont);
begin
FFont.Name := AFont.Name;
- FFont.Size := IfThen(AFont.Size = 0, 10, AFont.Size);
+ FFont.Size := IfThen(AFont.Size = 0, DEFAULT_FONT_SIZE, AFont.Size);
FFont.Color := AFont.FPColor;
FFont.Orientation := FGetFontOrientationFunc(AFont);
FFont.Bold := AFont.Bold;
diff --git a/components/tachart/tadraweropengl.pas b/components/tachart/tadraweropengl.pas
index 18d14c7081..74d0d5fefa 100644
--- a/components/tachart/tadraweropengl.pas
+++ b/components/tachart/tadraweropengl.pas
@@ -43,7 +43,7 @@ type
FPenWidth: Integer;
FFontName: String;
FFontSize: Integer;
- FFontStyle: Integer;
+ FFontStyle: TChartFontStyles;
FFontAngle: Double;
FPos: TPoint;
procedure ChartGLColor(AColor: TFPColor);
@@ -66,6 +66,10 @@ type
procedure Ellipse(AX1, AY1, AX2, AY2: Integer);
procedure FillRect(AX1, AY1, AX2, AY2: Integer);
function GetBrushColor: TChartColor;
+ function GetFontColor: TFPColor; override;
+ function GetFontName: String; override;
+ function GetFontSize: Integer; override;
+ function GetFontStyle: TChartFontStyles; override;
procedure Line(AX1, AY1, AX2, AY2: Integer);
procedure Line(const AP1, AP2: TPoint);
procedure LineTo(AX, AY: Integer); override;
@@ -99,6 +103,7 @@ implementation
uses
GL, GLu, FileUtil,
+ Math,
{$IFDEF CHARTGL_USE_LAZFREETYPE}
LazFileUtils,
EasyLazFreeType, LazFreeTypeFPImageDrawer, LazFreeTypeFontCollection,
@@ -564,6 +569,26 @@ begin
Result := 0.0;
end;
+function TOpenGLDrawer.GetFontColor: TFPColor;
+begin
+ Result := FFontColor;
+end;
+
+function TOpenGLDrawer.GetFontName: String;
+begin
+ Result := FFontName;
+end;
+
+function TOpenGLDrawer.GetFontSize: Integer;
+begin
+ Result := IFThen(FFontSize = 0, DEFAULT_FONT_SIZE, FFontSize);
+end;
+
+function TOpenGLDrawer.GetFontStyle: TChartFontStyles;
+begin
+ Result := FFontStyle;
+end;
+
procedure TOpenGLDrawer.InternalPolyline(
const APoints: array of TPoint; AStartIndex, ANumPts, AMode: Integer);
var
@@ -705,14 +730,13 @@ end;
procedure TOpenGLDrawer.SetFont(AFont: TFPCustomFont);
begin
FFontName := AFont.Name;
- if Sametext(FFontName, 'default') then FFontName := 'Arial';
- FFontSize := AFont.Size;
- if FFontSize = 0 then FFontSize := 10;
- FFontStyle := 0;
- if AFont.Bold then inc(FFontStyle, 1);
- if AFont.Italic then inc(FFontStyle, 2);
- if AFont.Underline then inc(FFontStyle, 4);
- if AFont.Strikethrough then inc(FFontStyle, 8);
+ if SameText(FFontName, 'default') then FFontName := 'Arial';
+ FFontSize := IfThen(AFont.Size = 0, DEFAULT_FONT_SIZE, AFont.Size);
+ FFontStyle := [];
+ if AFont.Bold then Include(FFontStyle, cfsBold);
+ if AFont.Italic then Include(FFontStyle, cfsItalic);
+ if AFont.Underline then Include(FFontStyle, cfsUnderline);
+ if AFont.Strikethrough then Include(FFontStyle, cfsStrikeout);
FFontColor := AFont.FPColor;
{$IFDEF CHARTGL_USE_LAZFREETYPE}
diff --git a/components/tachart/tadrawersvg.pas b/components/tachart/tadrawersvg.pas
index 83c58263b7..e444ac5209 100644
--- a/components/tachart/tadrawersvg.pas
+++ b/components/tachart/tadrawersvg.pas
@@ -73,6 +73,10 @@ type
procedure Ellipse(AX1, AY1, AX2, AY2: Integer);
procedure FillRect(AX1, AY1, AX2, AY2: Integer);
function GetBrushColor: TChartColor;
+ function GetFontColor: TFPColor; override;
+ function GetFontName: String; override;
+ function GetFontSize: Integer; override;
+ function GetFontStyle: TChartFontStyles; override;
procedure Line(AX1, AY1, AX2, AY2: Integer);
procedure Line(const AP1, AP2: TPoint);
procedure LineTo(AX, AY: Integer); override;
@@ -253,6 +257,30 @@ begin
Result := FFont.Orientation;
end;
+function TSVGDrawer.GetFontColor: TFPColor;
+begin
+ Result := FFont.Color;
+end;
+
+function TSVGDrawer.GetFontName: String;
+begin
+ Result := FFont.Name;
+end;
+
+function TSVGDrawer.GetFontSize: Integer;
+begin
+ Result := IfThen(FFont.Size = 0, DEFAULT_FONT_SIZE, FFont.Size);
+end;
+
+function TSVGDrawer.GetFontStyle: TChartFontStyles;
+begin
+ Result := [];
+ 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;
+
procedure TSVGDrawer.Line(AX1, AY1, AX2, AY2: Integer);
begin
WriteFmt(
@@ -422,7 +450,7 @@ procedure TSVGDrawer.SetFont(AFont: TFPCustomFont);
begin
with FFont do begin
Name := AFont.Name;
- Size := IfThen(AFont.Size=0, 8, AFont.Size);
+ Size := IfThen(AFont.Size=0, DEFAULT_FONT_SIZE, AFont.Size);
// ???
if FMonochromeColor <> clTAColor then
diff --git a/components/tachart/tadrawutils.pas b/components/tachart/tadrawutils.pas
index bf72b58b97..61111c3905 100644
--- a/components/tachart/tadrawutils.pas
+++ b/components/tachart/tadrawutils.pas
@@ -22,8 +22,9 @@ type
TChartAntialiasingMode = (amDontCare, amOn, amOff);
type
-
ISimpleTextOut = interface
+ function HtmlTextExtent(const AText: String): TPoint;
+ procedure HtmlTextOut(AX, AY: Integer; const AText: String);
procedure SimpleTextOut(AX, AY: Integer; const AText: String);
function SimpleTextExtent(const AText: String): TPoint;
function GetFontAngle: Double;
@@ -38,6 +39,7 @@ type
FSimpleTextOut: ISimpleTextOut;
FText1: String;
FText2: TStrings;
+ FTextFormat: TChartTextFormat;
FWidth: Integer;
procedure DoTextOutList;
@@ -51,6 +53,7 @@ type
function Pos(const APos: TPoint): TChartTextOut;
function Text(const AText: String): TChartTextOut;
function Text(AText: TStrings): TChartTextOut;
+ function TextFormat(AFormat: TChartTextFormat): TChartTextOut;
function Width(AWidth: Integer): TChartTextOut;
end;
@@ -63,6 +66,7 @@ type
TScaleItems = set of TScaleItem;
IChartDrawer = interface
+ ['{6D8E5591-6788-4D2D-9FE6-596D5157C3C3}']
procedure AddToFontOrientation(ADelta: Integer);
procedure ClippingStart(const AClipRect: TRect);
procedure ClippingStart;
@@ -74,6 +78,11 @@ type
procedure Ellipse(AX1, AY1, AX2, AY2: Integer);
procedure FillRect(AX1, AY1, AX2, AY2: Integer);
function GetBrushColor: TChartColor;
+ function GetFontAngle: Double;
+ function GetFontColor: TFPColor;
+ function GetFontName: String;
+ function GetFontSize: Integer;
+ function GetFontStyle: TChartFontStyles;
procedure SetDoChartColorToFPColorFunc(AValue: TChartColorToFPColorFunc);
procedure Line(AX1, AY1, AX2, AY2: Integer);
procedure Line(const AP1, AP2: TPoint);
@@ -108,8 +117,10 @@ type
procedure SetRightToLeft(AValue: Boolean);
procedure SetTransparency(ATransparency: TChartTransparency);
procedure SetXor(AXor: Boolean);
- function TextExtent(const AText: String): TPoint;
- function TextExtent(AText: TStrings): TPoint;
+ function TextExtent(const AText: String;
+ ATextFormat: TChartTextFormat = tfNormal): TPoint;
+ function TextExtent(AText: TStrings;
+ ATextFormat: TChartTextFormat = tfNormal): TPoint;
function TextOut: TChartTextOut;
property Brush: TFPCustomBrush write SetBrush;
@@ -135,15 +146,22 @@ type
FScaleItems: TScaleItems;
function ColorOrMono(AColor: TChartColor): TChartColor; inline;
function FPColorOrMono(const AColor: TFPColor): TFPColor; inline;
- function GetFontAngle: Double; virtual; abstract;
+// function GetFontAngle: Double; virtual; abstract;
function SimpleTextExtent(const AText: String): TPoint; virtual; abstract;
procedure SimpleTextOut(AX, AY: Integer; const AText: String); virtual; abstract;
+ function HtmlTextExtent(const AText: String): TPoint;
+ procedure HtmlTextOut(AX, AY: Integer; const AText: String);
public
constructor Create;
procedure DrawingBegin(const ABoundingBox: TRect); virtual;
procedure DrawingEnd; virtual;
procedure DrawLineDepth(AX1, AY1, AX2, AY2, ADepth: Integer);
procedure DrawLineDepth(const AP1, AP2: TPoint; ADepth: Integer);
+ function GetFontAngle: Double; virtual; abstract;
+ function GetFontColor: TFPColor; virtual; abstract;
+ function GetFontName: String; virtual; abstract;
+ function GetFontSize: Integer; virtual; abstract;
+ function GetFontStyle: TChartFontStyles; virtual; abstract;
function GetRightToLeft: Boolean;
procedure LineTo(AX, AY: Integer); virtual; abstract;
procedure LineTo(const AP: TPoint);
@@ -161,8 +179,8 @@ type
procedure SetRightToLeft(AValue: Boolean);
procedure SetTransparency(ATransparency: TChartTransparency);
procedure SetXor(AXor: Boolean);
- function TextExtent(const AText: String): TPoint;
- function TextExtent(AText: TStrings): TPoint;
+ function TextExtent(const AText: String; ATextFormat: TChartTextFormat = tfNormal): TPoint;
+ function TextExtent(AText: TStrings; ATextFormat: TChartTextFormat = tfNormal): TPoint;
function TextOut: TChartTextOut;
end;
@@ -173,7 +191,7 @@ type
implementation
uses
- Math, TAGeometry;
+ Math, TAGeometry, TAHtml;
const
LINE_INTERVAL = 2;
@@ -241,13 +259,19 @@ var
begin
a := -FSimpleTextOut.GetFontAngle;
for i := 0 to FText2.Count - 1 do begin
- lineExtent := FSimpleTextOut.SimpleTextExtent(FText2[i]);
+ case FTextFormat of
+ tfNormal: lineExtent := FSimpleTextOut.SimpleTextExtent(FText2[i]);
+ tfHtml : lineExtent := FSimpleTextOut.HtmlTextExtent(FText2[i]);
+ end;
p := FPos;
case FAlignment of
taCenter: p += RotatePointX((FWidth - lineExtent.X) div 2, a);
taRightJustify: p += RotatePointX(FWidth - lineExtent.X, a);
end;
- FSimpleTextOut.SimpleTextOut(p.X, p.Y, FText2[i]);
+ case FTextFormat of
+ tfNormal: FSimpleTextOut.SimpleTextOut(p.X, p.Y, FText2[i]);
+ tfHtml : FSimpleTextOut.HtmlTextOut(p.X, p.Y, FText2[i]);
+ end;
FPos += RotatePoint(Point(0, lineExtent.Y + LINE_INTERVAL), a);
end;
end;
@@ -255,7 +279,10 @@ end;
procedure TChartTextOut.DoTextOutString;
begin
if System.Pos(LineEnding, FText1) = 0 then begin
- FSimpleTextOut.SimpleTextOut(FPos.X, FPos.Y, FText1);
+ case FTextFormat of
+ tfNormal: FSimpleTextOut.SimpleTextOut(FPos.X, FPos.Y, FText1);
+ tfHtml : FSimpleTextOut.HtmlTextOut(FPos.X, FPos.Y, FText1);
+ end;
exit;
end;
FText2 := TStringList.Create;
@@ -291,6 +318,12 @@ begin
Result := Self;
end;
+function TChartTextOut.TextFormat(AFormat: TChartTextFormat): TChartTextOut;
+begin
+ FTextFormat := AFormat;
+ Result := Self;
+end;
+
function TChartTextOut.Width(AWidth: Integer): TChartTextOut;
begin
FWidth := AWidth;
@@ -347,6 +380,34 @@ begin
Result := FRightToLeft;
end;
+function TBasicDrawer.HtmlTextExtent(const AText: String): TPoint;
+var
+ IDrawer: IChartDrawer;
+begin
+ IDrawer := Self as IChartDrawer;
+// GetInterface('IChartDrawer', IDrawer);
+ with THtmlAnalyzer.Create(IDrawer) do
+ try
+ Result := TextExtent(AText);
+ finally
+ Free;
+ end;
+end;
+
+procedure TBasicDrawer.HtmlTextOut(AX, AY: Integer; const AText: String);
+var
+ IDrawer: IChartDrawer;
+begin
+ IDrawer := Self as IChartDrawer;
+// GetInterface('IChartDrawer', IDrawer);
+ with THtmlAnalyzer.Create(IDrawer) do
+ try
+ TextOut(AX, AY, AText);
+ finally
+ Free;
+ end;
+end;
+
procedure TBasicDrawer.LineTo(const AP: TPoint);
begin
LineTo(AP.X, AP.Y)
@@ -411,31 +472,46 @@ begin
FXor := AXor;
end;
-function TBasicDrawer.TextExtent(const AText: String): TPoint;
+function TBasicDrawer.TextExtent(const AText: String;
+ ATextFormat: TChartTextFormat = tfNormal): TPoint;
var
sl: TStrings;
begin
if Pos(LineEnding, AText) = 0 then
- exit(SimpleTextExtent(AText));
+ case ATextFormat of
+ tfNormal: exit(SimpleTextExtent(AText));
+ tfHTML : exit(HtmlTextExtent(AText));
+ end;
+
sl := TStringList.Create;
try
sl.Text := AText;
- Result := TextExtent(sl);
+ Result := TextExtent(sl, ATextFormat);
finally
sl.Free;
end;
end;
-function TBasicDrawer.TextExtent(AText: TStrings): TPoint;
+function TBasicDrawer.TextExtent(AText: TStrings;
+ ATextFormat: TChartTextFormat = tfNormal): TPoint;
var
i: Integer;
begin
Result := Size(0, -LINE_INTERVAL);
- for i := 0 to AText.Count - 1 do
- with SimpleTextExtent(AText[i]) do begin
- Result.X := Max(Result.X, X);
- Result.Y += Y + LINE_INTERVAL;
- end;
+ case ATextFormat of
+ tfNormal:
+ for i := 0 to AText.Count - 1 do
+ with SimpleTextExtent(AText[i]) do begin
+ Result.X := Max(Result.X, X);
+ Result.Y += Y + LINE_INTERVAL;
+ end;
+ tfHtml:
+ for i := 0 to AText.Count - 1 do
+ with HtmlTextExtent(AText[i]) do begin
+ Result.X := Max(Result.X, X);
+ Result.Y += Y + LINE_INTERVAL;
+ end;
+ end;
end;
function TBasicDrawer.TextOut: TChartTextOut;
diff --git a/components/tachart/tatextelements.pas b/components/tachart/tatextelements.pas
index 2f63a87f8b..84c34845ac 100644
--- a/components/tachart/tatextelements.pas
+++ b/components/tachart/tatextelements.pas
@@ -56,6 +56,7 @@ type
FOnGetShape: TChartGetShapeEvent;
FOverlapPolicy: TChartMarksOverlapPolicy;
FShape: TChartLabelShape;
+ FTextFormat: TChartTextFormat;
procedure SetAlignment(AValue: TAlignment);
procedure SetCalloutAngle(AValue: Cardinal);
procedure SetClipped(AValue: Boolean);
@@ -64,6 +65,7 @@ type
procedure SetOverlapPolicy(AValue: TChartMarksOverlapPolicy);
procedure SetRotationCenter(AValue: TChartTextRotationCenter);
procedure SetShape(AValue: TChartLabelShape);
+ procedure SetTextFormat(AValue: TChartTextFormat);
strict protected
FAlignment: TAlignment;
FInsideDir: TDoublePoint;
@@ -107,6 +109,8 @@ type
read FOnGetShape write SetOnGetShape;
property Shape: TChartLabelShape
read FShape write SetShape default clsRectangle;
+ property TextFormat: TChartTextFormat
+ read FTextFormat write SetTextFormat default tfNormal;
published
property Alignment: TAlignment
read FAlignment write SetAlignment;
@@ -157,6 +161,7 @@ type
property OnGetShape;
property Shape;
property Text: TStrings read FText write SetText;
+ property TextFormat;
property Visible default false;
end;
@@ -278,6 +283,7 @@ type
property OverlapPolicy;
property RotationCenter;
property Style default smsNone;
+ property TextFormat;
property YIndex;
end;
@@ -300,6 +306,7 @@ begin
Self.FMargins.Assign(FMargins);
Self.FOverlapPolicy := FOverlapPolicy;
Self.FShape := FShape;
+ Self.FTextFormat := FTextFormat;
Self.FInsideDir := FInsideDir;
end;
inherited Assign(ASource);
@@ -328,7 +335,7 @@ var
i, w: Integer;
begin
ApplyLabelFont(ADrawer);
- ptText := ADrawer.TextExtent(AText);
+ ptText := ADrawer.TextExtent(AText, FTextFormat);
w := ptText.X;
labelPoly := GetLabelPolygon(ADrawer, ptText);
for i := 0 to High(labelPoly) do
@@ -368,7 +375,7 @@ begin
end;
ptText := RotatePoint(P, GetLabelAngle) + ALabelCenter;
- ADrawer.TextOut.Pos(ptText).Alignment(Alignment).Width(w).Text(AText).Done;
+ ADrawer.TextOut.TextFormat(FTextFormat).Pos(ptText).Alignment(Alignment).Width(w).Text(AText).Done;
if not Clipped then
ADrawer.ClippingStart;
end;
@@ -468,7 +475,7 @@ function TChartTextElement.MeasureLabel(
ADrawer: IChartDrawer; const AText: String): TSize;
begin
ApplyLabelFont(ADrawer);
- with GetBoundingBox(ADrawer, ADrawer.TextExtent(AText)) do
+ with GetBoundingBox(ADrawer, ADrawer.TextExtent(AText, FTextFormat)) do
Result := MeasureRotatedRect(Point(Right - Left, Bottom - Top), GetLabelAngle);
end;
@@ -478,7 +485,7 @@ var
R: TRect;
begin
ApplyLabelFont(ADrawer);
- R := Rect(0, 0, 0, ADrawer.TextExtent(AText).y);
+ R := Rect(0, 0, 0, ADrawer.TextExtent(AText, FTextFormat).y);
OffsetRect(R, 0, -(R.Bottom - R.Top) div 2);
if IsMarginRequired then
Margins.ExpandRectScaled(ADrawer, R);
@@ -546,6 +553,14 @@ begin
StyleChanged(Self);
end;
+procedure TChartTextElement.SetTextFormat(AValue: TChartTextFormat);
+begin
+ if FTextFormat = AValue then exit;
+ FTextFormat := AValue;
+ StyleChanged(Self);
+end;
+
+
{ TChartTitle }
procedure TChartTitle.Assign(ASource: TPersistent);