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

TAChart: Support multi-line mark labels

Browse Source 
git-svn-id: trunk@29183 -
This commit is contained in:
ask 2011-01-24 08:51:05 +00:00
parent d830867f37
commit 1f99cf0ccf
2 changed files with 57 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

55
components/tachart/tadrawutils.pas
View File

@ -21,7 +21,7 @@ unit TADrawUtils;
interface
uses
Classes, Graphics, SysUtils;
Classes, Graphics, SysUtils, Types;
const
Colors: array [1..15] of TColor = (
@ -48,6 +48,9 @@ type
procedure DrawLineDepth(ACanvas: TCanvas; AX1, AY1, AX2, AY2, ADepth: Integer);
procedure DrawLineDepth(ACanvas: TCanvas; const AP1, AP2: TPoint; ADepth: Integer);
function MultiLineTextExtent(ACanvas: TCanvas; const AText: String): TPoint;
procedure MultiLineTextOut(ACanvas: TCanvas; APos: TPoint; const AText: String);
procedure PrepareSimplePen(ACanvas: TCanvas; AColor: TColor);
procedure PrepareXorPen(ACanvas: TCanvas);
@ -56,7 +59,7 @@ function TypicalTextHeight(ACanvas: TCanvas): Integer;
implementation
uses
Types, TAChartUtils;
Math, TAChartUtils;
procedure DrawLineDepth(ACanvas: TCanvas; AX1, AY1, AX2, AY2, ADepth: Integer);
begin
@ -72,6 +75,54 @@ begin
ACanvas.Polygon([AP1, AP1 + d, AP2 + d, AP2]);
end;
const
LINE_INTERVAL = 2;
function MultiLineTextExtent(ACanvas: TCanvas; const AText: String): TPoint;
var
sl: TStrings;
i: Integer;
begin
if Pos(LineEnding, AText) = 0 then
exit(ACanvas.TextExtent(AText));
sl := TStringList.Create;
try
sl.Text := AText;
Result := Size(0, -LINE_INTERVAL);
for i := 0 to sl.Count - 1 do
with ACanvas.TextExtent(sl[i]) do begin
Result.X := Max(Result.X, cx);
Result.Y += cy + LINE_INTERVAL;
end;
finally
sl.Free;
end;
end;
procedure MultiLineTextOut(ACanvas: TCanvas; APos: TPoint; const AText: String);
var
sl: TStrings;
i, h: Integer;
a: Double;
begin
if Pos(LineEnding, AText) = 0 then begin
ACanvas.TextOut(APos.X, APos.Y, AText);
exit;
end;
a := -OrientToRad(ACanvas.Font.Orientation);
sl := TStringList.Create;
try
sl.Text := AText;
for i := 0 to sl.Count - 1 do begin
ACanvas.TextOut(APos.X, APos.Y, sl[i]);
h := ACanvas.TextHeight(sl[i]) + LINE_INTERVAL;
APos += RotatePoint(Point(0, h), a);
end;
finally
sl.Free;
end;
end;
procedure PrepareSimplePen(ACanvas: TCanvas; AColor: TColor);
begin
with ACanvas.Pen do begin

8
components/tachart/tatypes.pas
View File

@ -308,7 +308,7 @@ type
implementation
uses
TACustomSource;
TACustomSource, TADrawUtils;
{ TChartPen }
@ -511,7 +511,7 @@ var
i: Integer;
begin
PutLabelFontTo(ACanvas);
ptText := ACanvas.TextExtent(AText);
ptText := MultiLineTextExtent(ACanvas, AText);
labelPoly := GetLabelPolygon(ptText);
for i := 0 to High(labelPoly) do
labelPoly[i] += ALabelCenter;
@ -537,7 +537,7 @@ begin
end;
ptText := RotatePoint(-ptText div 2, LabelAngle) + ALabelCenter;
ACanvas.TextOut(ptText.X, ptText.Y, AText);
MultiLineTextOut(ACanvas, ptText, AText);
if wasClipping then
ACanvas.Clipping := true;
end;
@ -588,7 +588,7 @@ var
sz: TPoint;
begin
PutLabelFontTo(ACanvas);
sz := ACanvas.TextExtent(AText);
sz := MultiLineTextExtent(ACanvas, AText);
if IsMarginRequired then
sz += Point(MARKS_MARGIN_X, MARKS_MARGIN_Y) * 2;
Result := MeasureRotatedRect(sz, LabelAngle);