lazarus/components/tachart/tadraweraggpas.pas
2011-06-26 07:14:37 +00:00

254 lines
6.6 KiB
ObjectPascal

{
*****************************************************************************
* *
* See the file COPYING.modifiedLGPL.txt, included in this distribution, *
* for details about the copyright. *
* *
* This program is distributed in the hope that it will be useful, *
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
* *
*****************************************************************************
Authors: Alexander Klenin
}
unit TADrawerAggPas;
{$H+}
interface
uses
Classes, FPCanvas, Agg_LCL, TAChartUtils, TADrawUtils;
type
{ TAggPasDrawer }
TAggPasDrawer = class(TBasicDrawer, IChartDrawer)
strict private
FCanvas: TAggLCLCanvas;
procedure SetBrush(ABrush: TFPCustomBrush);
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
constructor Create(ACanvas: TAggLCLCanvas);
public
procedure AddToFontOrientation(ADelta: Integer);
procedure ClippingStart;
procedure ClippingStart(const AClipRect: TRect);
procedure ClippingStop;
procedure Ellipse(AX1, AY1, AX2, AY2: Integer);
procedure FillRect(AX1, AY1, AX2, AY2: Integer);
function GetBrushColor: TChartColor;
procedure Line(AX1, AY1, AX2, AY2: Integer);
procedure Line(const AP1, AP2: TPoint);
procedure LineTo(AX, AY: Integer); override;
procedure MoveTo(AX, AY: Integer); override;
procedure Polygon(
const APoints: array of TPoint; AStartIndex, ANumPts: Integer); override;
procedure Polyline(
const APoints: array of TPoint; AStartIndex, ANumPts: Integer);
procedure PrepareSimplePen(AColor: TChartColor);
procedure RadialPie(
AX1, AY1, AX2, AY2: Integer;
AStartAngle16Deg, AAngleLength16Deg: Integer);
procedure Rectangle(const ARect: TRect);
procedure Rectangle(AX1, AY1, AX2, AY2: Integer);
procedure SetBrushColor(AColor: TChartColor);
procedure SetBrushParams(AStyle: TFPBrushStyle; AColor: TChartColor);
procedure SetPenParams(AStyle: TFPPenStyle; AColor: TChartColor);
end;
implementation
uses
Math, TAGeometry;
{ TAggPasDrawer }
procedure TAggPasDrawer.AddToFontOrientation(ADelta: Integer);
begin
with FCanvas.Font do
AggAngle := AggAngle + OrientToRad(ADelta);
end;
procedure TAggPasDrawer.ClippingStart(const AClipRect: TRect);
begin
FCanvas.ClipRect := AClipRect;
FCanvas.Clipping := true;
end;
procedure TAggPasDrawer.ClippingStart;
begin
FCanvas.Clipping := true;
end;
procedure TAggPasDrawer.ClippingStop;
begin
FCanvas.Clipping := false;
end;
constructor TAggPasDrawer.Create(ACanvas: TAggLCLCanvas);
begin
inherited Create;
FCanvas := ACanvas;
end;
procedure TAggPasDrawer.Ellipse(AX1, AY1, AX2, AY2: Integer);
begin
FCanvas.Ellipse(AX1, AY1, AX2, AY2);
end;
procedure TAggPasDrawer.FillRect(AX1, AY1, AX2, AY2: Integer);
begin
FCanvas.FillRect(AX1, AY1, AX2, AY2);
end;
function TAggPasDrawer.GetBrushColor: TChartColor;
begin
Result := FCanvas.Brush.Color;
end;
function TAggPasDrawer.GetFontAngle: Double;
begin
Result := FCanvas.Font.AggAngle;
end;
procedure TAggPasDrawer.Line(AX1, AY1, AX2, AY2: Integer);
begin
FCanvas.Line(AX1, AY1, AX2, AY2);
end;
procedure TAggPasDrawer.Line(const AP1, AP2: TPoint);
begin
FCanvas.Line(AP1, AP2);
end;
procedure TAggPasDrawer.LineTo(AX, AY: Integer);
begin
FCanvas.LineTo(AX, AY);
end;
procedure TAggPasDrawer.MoveTo(AX, AY: Integer);
begin
FCanvas.MoveTo(AX, AY);
end;
procedure TAggPasDrawer.Polygon(
const APoints: array of TPoint; AStartIndex, ANumPts: Integer);
begin
FCanvas.Polygon(APoints, false, AStartIndex, ANumPts);
FCanvas.Polyline(APoints, AStartIndex, ANumPts);
FCanvas.Line(APoints[ANumPts - 1], APoints[0])
end;
procedure TAggPasDrawer.Polyline(
const APoints: array of TPoint; AStartIndex, ANumPts: Integer);
begin
FCanvas.Polyline(APoints, AStartIndex, ANumPts);
end;
procedure TAggPasDrawer.PrepareSimplePen(AColor: TChartColor);
begin
with FCanvas.Pen do begin
Color := AColor;
Style := psSolid;
Mode := pmCopy;
Width := 1;
end;
end;
procedure TAggPasDrawer.RadialPie(
AX1, AY1, AX2, AY2: Integer;
AStartAngle16Deg, AAngleLength16Deg: Integer);
begin
FCanvas.RadialPie(
AX1, AY1, AX2, AY2, AStartAngle16Deg, AAngleLength16Deg);
end;
procedure TAggPasDrawer.Rectangle(AX1, AY1, AX2, AY2: Integer);
begin
FCanvas.Rectangle(AX1, AY1, AX2, AY2);
end;
procedure TAggPasDrawer.Rectangle(const ARect: TRect);
begin
FCanvas.Rectangle(ARect);
end;
procedure TAggPasDrawer.SetBrush(ABrush: TFPCustomBrush);
begin
with FCanvas.Brush do begin
Style := ABrush.Style;
Image := ABrush.Image;
Pattern := ABrush.Pattern;
FPColor := ABrush.FPColor;
end;
end;
procedure TAggPasDrawer.SetBrushColor(AColor: TChartColor);
begin
FCanvas.Brush.Color := AColor;
end;
procedure TAggPasDrawer.SetBrushParams(
AStyle: TFPBrushStyle; AColor: TChartColor);
begin
FCanvas.Brush.Style := AStyle;
FCanvas.Brush.Color := AColor;
end;
procedure TAggPasDrawer.SetFont(AFont: TFPCustomFont);
const
DEFAULT_FONT_SIZE = 10; // Just a random value.
var
f: TAggLCLFont;
fontSize: Integer;
begin
f := FCanvas.Font;
fontSize := IfThen(AFont.Size = 0, DEFAULT_FONT_SIZE, AFont.Size);
// This should be: FCanvas.Font.DoCopyProps(AFont);
f.LoadFromFile(
AFont.Name, f.SizeToAggHeight(fontSize), AFont.Bold, AFont.Italic);
f.FPColor := AFont.FPColor;
f.AggAngle := OrientToRad(-FGetFontOrientationFunc(AFont));
end;
type
TAggLCLPenCrack = class(TAggLCLPen);
procedure TAggPasDrawer.SetPen(APen: TFPCustomPen);
begin
TAggLCLPenCrack(FCanvas.Pen).DoCopyProps(APen);
FCanvas.Pen.FPColor := APen.FPColor;
end;
procedure TAggPasDrawer.SetPenParams(AStyle: TFPPenStyle; AColor: TChartColor);
begin
FCanvas.Pen.Style := AStyle;
FCanvas.Pen.Color := AColor;
end;
function TAggPasDrawer.SimpleTextExtent(const AText: String): TPoint;
begin
Result := FCanvas.TextExtent(AText);
end;
procedure TAggPasDrawer.SimpleTextOut(AX, AY: Integer; const AText: String);
begin
FCanvas.TextOut(AX, AY, AText);
end;
initialization
// Suppress incorrect "TAGeometry is unused" hint
Unused(DoublePoint(0, 0));
end.