From 8532170a20f9fc94c2b210d4ca80eddefd1cfdbf Mon Sep 17 00:00:00 2001 From: wp Date: Sun, 2 Jul 2017 21:51:26 +0000 Subject: [PATCH] TAChart: Initial commit for html tags in titles and labels. git-svn-id: trunk@55427 - --- components/tachart/aggpas/tadraweraggpas.pas | 32 ++++++ components/tachart/tachartaxisutils.pas | 2 + components/tachart/tachartlazaruspkg.lpk | 6 +- components/tachart/tachartlazaruspkg.pas | 2 +- components/tachart/tachartutils.pas | 6 + components/tachart/tadrawerbgra.pas | 29 ++++- components/tachart/tadrawercanvas.pas | 34 +++++- components/tachart/tadrawerfpcanvas.pas | 35 +++++- components/tachart/tadrawerfpvectorial.pas | 30 ++++- components/tachart/tadraweropengl.pas | 42 +++++-- components/tachart/tadrawersvg.pas | 30 ++++- components/tachart/tadrawutils.pas | 114 +++++++++++++++---- components/tachart/tatextelements.pas | 23 +++- 13 files changed, 345 insertions(+), 40 deletions(-) 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);