paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-03 14:39:36 +01:00
Code Issues Packages Projects Releases Wiki Activity

TAChart: Use IChartDrawer to draw chart title and footer

Browse Source 
git-svn-id: trunk@29528 -
This commit is contained in:
ask 2011-02-13 15:49:51 +00:00
parent 29469237ae
commit a4fb8cc245
4 changed files with 119 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

107
components/tachart/tadrawutils.pas
View File

@ -50,6 +50,8 @@ type
procedure Recall;
end;
TChartTextOut = class;
{ IChartDrawer }
IChartDrawer = interface
@ -66,7 +68,8 @@ type
procedure SetFont(AValue: TFPCustomFont);
procedure SetPen(APen: TFPCustomPen);
function TextExtent(const AText: String): TPoint;
procedure TextOut(AX, AY: Integer; const AText: String);
function TextExtent(AText: TStrings): TPoint;
function TextOut: TChartTextOut;
property Brush: TFPCustomBrush write SetBrush;
property Canvas: TCanvas read GetCanvas;
@ -74,6 +77,27 @@ type
property Pen: TFPCustomPen write SetPen;
end;
{ TChartTextOut }
TChartTextOut = class
FAlignment: TAlignment;
FDrawer: IChartDrawer;
FPos: TPoint;
FText1: String;
FText2: TStrings;
FWidth: Integer;
public
constructor Create(ADrawer: IChartDrawer);
public
function Alignment(AAlignment: TAlignment): TChartTextOut;
procedure Done;
function Pos(AX, AY: Integer): TChartTextOut;
function Pos(const APos: TPoint): TChartTextOut;
function Text(const AText: String): TChartTextOut;
function Text(const AText: TStrings): TChartTextOut;
function Width(AWidth: Integer): TChartTextOut;
end;
{ TCanvasDrawer }
TCanvasDrawer = class(TInterfacedObject, IChartDrawer)
@ -95,7 +119,8 @@ type
procedure Rectangle(const ARect: TRect);
procedure SetBrushParams(AStyle: TBrushStyle; AColor: TChartColor);
function TextExtent(const AText: String): TPoint;
procedure TextOut(AX, AY: Integer; const AText: String);
function TextExtent(AText: TStrings): TPoint;
function TextOut: TChartTextOut;
end;
procedure DrawLineDepth(ACanvas: TCanvas; AX1, AY1, AX2, AY2, ADepth: Integer);
@ -103,10 +128,12 @@ procedure DrawLineDepth(ACanvas: TCanvas; const AP1, AP2: TPoint; ADepth: Intege
function MultiLineTextExtent(ACanvas: TCanvas; const AText: String): TPoint;
function MultiLineTextExtent(ACanvas: TCanvas; AText: TStrings): TPoint;
procedure MultiLineTextOut(ACanvas: TCanvas; APos: TPoint; const AText: String);
procedure MultiLineTextOut(
ACanvas: TCanvas; APos: TPoint; AText: TStrings; AAlignment: TAlignment;
AWidth: Integer);
ACanvas: TCanvas; APos: TPoint; const AText: String;
AAlignment: TAlignment; AWidth: Integer);
procedure MultiLineTextOut(
ACanvas: TCanvas; APos: TPoint; AText: TStrings;
AAlignment: TAlignment; AWidth: Integer);
procedure PrepareSimplePen(ACanvas: TCanvas; AColor: TColor);
procedure PrepareXorPen(ACanvas: TCanvas);
@ -162,7 +189,9 @@ begin
end;
end;
procedure MultiLineTextOut(ACanvas: TCanvas; APos: TPoint; const AText: String);
procedure MultiLineTextOut(
ACanvas: TCanvas; APos: TPoint; const AText: String; AAlignment: TAlignment;
AWidth: Integer);
var
sl: TStrings;
begin
@ -173,7 +202,7 @@ begin
sl := TStringList.Create;
try
sl.Text := AText;
MultiLineTextOut(ACanvas, APos, sl, taLeftJustify, 0);
MultiLineTextOut(ACanvas, APos, sl, AAlignment, AWidth);
finally
sl.Free;
end;
@ -228,6 +257,59 @@ begin
Result := ACanvas.TextHeight(TYPICAL_TEXT);
end;
{ TChartTextOut }
function TChartTextOut.Alignment(AAlignment: TAlignment): TChartTextOut;
begin
FAlignment := AAlignment;
Result := Self;
end;
constructor TChartTextOut.Create(ADrawer: IChartDrawer);
begin
FDrawer := ADrawer;
FAlignment := taLeftJustify;
end;
procedure TChartTextOut.Done;
begin
if FText2 = nil then
MultiLineTextOut(FDrawer.Canvas, FPos, FText1, FAlignment, FWidth)
else
MultiLineTextOut(FDrawer.Canvas, FPos, FText2, FAlignment, FWidth);
Free;
end;
function TChartTextOut.Pos(AX, AY: Integer): TChartTextOut;
begin
FPos := Point(AX, AY);
Result := Self;
end;
function TChartTextOut.Pos(const APos: TPoint): TChartTextOut;
begin
FPos := APos;
Result := Self;
end;
function TChartTextOut.Text(const AText: String): TChartTextOut;
begin
FText1 := AText;
Result := Self;
end;
function TChartTextOut.Text(const AText: TStrings): TChartTextOut;
begin
FText2 := AText;
Result := Self;
end;
function TChartTextOut.Width(AWidth: Integer): TChartTextOut;
begin
FWidth := AWidth;
Result := Self;
end;
{ TCanvasDrawer }
constructor TCanvasDrawer.Create(ACanvas: TCanvas);
@ -292,12 +374,17 @@ end;
function TCanvasDrawer.TextExtent(const AText: String): TPoint;
begin
Result := FCanvas.TextExtent(AText);
Result := MultiLineTextExtent(FCanvas, AText);
end;
procedure TCanvasDrawer.TextOut(AX, AY: Integer; const AText: String);
function TCanvasDrawer.TextExtent(AText: TStrings): TPoint;
begin
FCanvas.TextOut(AX, AY, AText);
Result := MultiLineTextExtent(FCanvas, AText);
end;
function TCanvasDrawer.TextOut: TChartTextOut;
begin
Result := TChartTextOut.Create(Self);
end;
{ TPenBrushFontRecall }

24
components/tachart/tagraph.pas
View File

@ -218,7 +218,6 @@ type
procedure Clear(ADrawer: IChartDrawer; const ARect: TRect);
procedure DisplaySeries(ADrawer: IChartDrawer);
procedure DrawBackWall(ACanvas: TCanvas);
procedure DrawTitleFoot(ACanvas: TCanvas);
procedure MouseDown(
Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
@ -629,7 +628,7 @@ end;
procedure TChart.Draw(ADrawer: IChartDrawer; const ARect: TRect);
var
i: Integer;
i, c: Integer;
legendItems: TChartLegendItems = nil;
legendRect: TRect;
begin
@ -648,7 +647,11 @@ begin
if not FIsZoomed then
FLogicalExtent := GetFullExtent;
FCurrentExtent := FLogicalExtent;
DrawTitleFoot(ADrawer.Canvas);
c := (FClipRect.Left + FClipRect.Right) div 2;
FTitle.Draw(ADrawer, 1, c, FClipRect.Top);
FFoot.Draw(ADrawer, -1, c, FClipRect.Bottom);
if Legend.Visible then
PrepareLegend(ADrawer, legendItems, FClipRect, legendRect);
try
@ -734,21 +737,6 @@ begin
DrawLineHoriz(ACanvas, FReticulePos.Y);
end;
procedure TChart.DrawTitleFoot(ACanvas: TCanvas);
var
c: Integer;
pbf: TPenBrushFontRecall;
begin
pbf := TPenBrushFontRecall.Create(ACanvas, [pbfBrush, pbfFont]);
try
c := (FClipRect.Left + FClipRect.Right) div 2;
FTitle.Draw(ACanvas, 1, c, FClipRect.Top);
FFoot.Draw(ACanvas, -1, c, FClipRect.Bottom);
finally
pbf.Free;
end;
end;
procedure TChart.EraseBackground(DC: HDC);
begin
// do not erase, since we will paint over it anyway

3
components/tachart/talegend.pas
View File

@ -204,7 +204,8 @@ end;
procedure TLegendItem.Draw(ADrawer: IChartDrawer; const ARect: TRect);
begin
ADrawer.TextOut(ARect.Right + SYMBOL_TEXT_SPACING, ARect.Top, FText);
ADrawer.TextOut.
Pos(ARect.Right + SYMBOL_TEXT_SPACING, ARect.Top).Text(FText).Done;
end;
{ TLegendItemUserDrawn }

28
components/tachart/tatypes.pas
View File

@ -29,7 +29,7 @@ interface
uses
Classes, SysUtils, Graphics, Controls, FPCanvas, Types,
TAChartUtils;
TAChartUtils, TADrawUtils;
const
MARKS_MARGIN_X = 4;
@ -103,8 +103,8 @@ type
constructor Create(AOwner: TCustomChart);
destructor Destroy; override;
public
procedure Assign(Source: TPersistent); override;
procedure Draw(ACanvas: TCanvas; ADir, AX: Integer; var AY: Integer);
procedure Assign(ASource: TPersistent); override;
procedure Draw(ADrawer: IChartDrawer; ADir, AX: Integer; var AY: Integer);
published
property Alignment: TAlignment
read FAlignment write SetAlignment default taCenter;
@ -311,7 +311,7 @@ type
implementation
uses
TACustomSource, TADrawUtils;
TACustomSource;
{ TChartPen }
@ -383,10 +383,10 @@ end;
{ TChartTitle }
procedure TChartTitle.Assign(Source: TPersistent);
procedure TChartTitle.Assign(ASource: TPersistent);
begin
if Source is TChartTitle then
with TChartTitle(Source) do begin
if ASource is TChartTitle then
with TChartTitle(ASource) do begin
Self.FAlignment := Alignment;
Self.FBrush.Assign(Brush);
Self.FFont.Assign(Font);
@ -394,7 +394,7 @@ begin
Self.FText.Assign(Text);
end;
inherited Assign(Source);
inherited Assign(ASource);
end;
constructor TChartTitle.Create(AOwner: TCustomChart);
@ -423,22 +423,22 @@ begin
end;
procedure TChartTitle.Draw(
ACanvas: TCanvas; ADir, AX: Integer; var AY: Integer);
ADrawer: IChartDrawer; ADir, AX: Integer; var AY: Integer);
var
ptSize, textOrigin: TPoint;
a: Double;
w: Integer;
begin
if not Visible or (Text.Count = 0) then exit;
ACanvas.Brush.Assign(Brush);
ACanvas.Font.Assign(Font);
ADrawer.Brush := Brush;
ADrawer.Font := Font;
a := -OrientToRad(Font.Orientation);
ptSize := MultiLineTextExtent(ACanvas, Text);
ptSize := ADrawer.TextExtent(Text);
textOrigin := RotatePoint(-ptSize div 2, a);
w := ptSize.X;
ptSize := MeasureRotatedRect(ptSize, a);
textOrigin += Point(AX, AY + ptSize.Y div 2 * ADir);
MultiLineTextOut(ACanvas, textOrigin, Text, Alignment, w);
ADrawer.TextOut.Pos(textOrigin).Text(Text).Alignment(Alignment).Width(w).Done;
AY += ADir * (ptSize.Y + Margin);
end;
@ -567,7 +567,7 @@ begin
end;
ptText := RotatePoint(-ptText div 2, LabelAngle) + ALabelCenter;
MultiLineTextOut(ACanvas, ptText, AText);
MultiLineTextOut(ACanvas, ptText, AText, taLeftJustify, 0);
if wasClipping then
ACanvas.Clipping := true;
end;