mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-26 22:44:22 +02:00
254 lines
6.6 KiB
ObjectPascal
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.
|
|
|