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

TAChart: Initial commit for html tags in titles and labels.

Browse Source 
git-svn-id: trunk@55427 -
This commit is contained in:
wp 2017-07-02 21:51:26 +00:00
parent f06f1ef334
commit 8532170a20
13 changed files with 345 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
components/tachart/aggpas/tadraweraggpas.pas
View File

@ -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);

2
components/tachart/tachartaxisutils.pas
View File

@ -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;

6
components/tachart/tachartlazaruspkg.lpk
View File

@ -29,7 +29,7 @@
for details about the copyright.
"/>
<Version Major="1"/>
<Files Count="49">
<Files Count="50">
<Item1>
<Filename Value="tagraph.pas"/>
<HasRegisterProc Value="True"/>
@ -245,6 +245,10 @@
<HasRegisterProc Value="True"/>
<UnitName Value="TAChartCombos"/>
</Item49>
<Item50>
<Filename Value="tahtml.pas"/>
<UnitName Value="TAHtml"/>
</Item50>
</Files>
<LazDoc Paths="$(LazarusDir)\components\tachart\fpdoc"/>
<i18n>

2
components/tachart/tachartlazaruspkg.pas
View File

@ -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

6
components/tachart/tachartutils.pas
View File

@ -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;

29
components/tachart/tadrawerbgra.pas
View File

@ -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);

34
components/tachart/tadrawercanvas.pas
View File

@ -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);

35
components/tachart/tadrawerfpcanvas.pas
View File

@ -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);

30
components/tachart/tadrawerfpvectorial.pas
View File

@ -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;

42
components/tachart/tadraweropengl.pas
View File

@ -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}

30
components/tachart/tadrawersvg.pas
View File

@ -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

114
components/tachart/tadrawutils.pas
View File

@ -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;

23
components/tachart/tatextelements.pas
View File

@ -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);