lazarus/components/tachart/tadrawerbgra.pas

{
 *****************************************************************************
 *                                                                           *
 *  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 TADrawerBGRA;

{$H+}

interface

uses
  BGRABitmap, BGRABitmapTypes, Classes, FPCanvas, TADrawUtils;

type

  { TBGRABitmapDrawer }
  TBGRABitmapDrawer = class(TBasicDrawer, IChartDrawer)
  strict private
    FBrushColor: TBGRAPixel;
    FBrushStyle: TFPBrushStyle;
    FCanvas: TBGRABitmap;
    FFontColor: TBGRAPixel;
    FFontOrientation: Integer;
    FPenColor: TBGRAPixel;
    FPenWidth: Integer;
    FPrevPoint: TPoint;

    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: TBGRABitmap);
  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
  TAChartUtils, TAGeometry;

function PointsToPointsF(
  APoints: array of TPoint; AStartIndex, ANumPts: Integer): ArrayOfTPointF;
var
  i: Integer;
begin
  Assert(ANumPts >= 0);
  SetLength(Result, ANumPts);
  for i := 0 to ANumPts - 1 do
    with APoints[i + AStartIndex] do
      Result[i] := PointF(X, Y);
end;

{ TBGRABitmapDrawer }

procedure TBGRABitmapDrawer.AddToFontOrientation(ADelta: Integer);
begin
  FFontOrientation += ADelta;
end;

procedure TBGRABitmapDrawer.ClippingStart(const AClipRect: TRect);
begin
  Unused(AClipRect);
end;

procedure TBGRABitmapDrawer.ClippingStart;
begin
  // NA
end;

procedure TBGRABitmapDrawer.ClippingStop;
begin
  // NA
end;

constructor TBGRABitmapDrawer.Create(ACanvas: TBGRABitmap);
begin
  FCanvas := ACanvas;
end;

procedure TBGRABitmapDrawer.Ellipse(AX1, AY1, AX2, AY2: Integer);
var
  cx, cy, rx, ry: Integer;
begin
  BoundingBoxToCenterAndHalfRadius(AX1, AY1, AX2, AY2, cx, cy, rx, ry);
  FCanvas.FillEllipseAntialias(cx, cy, rx, ry, FBrushColor);
  FCanvas.EllipseAntialias(cx, cy, rx, ry, FPenColor, 1.0);
end;

procedure TBGRABitmapDrawer.FillRect(AX1, AY1, AX2, AY2: Integer);
var
  bt: TBGRACustomBitmap;
begin
  if FBrushStyle = bsSolid then
    FCanvas.FillRect(AX1, AY1, AX2, AY2, FBrushColor, dmSet)
  else begin
    bt := FCanvas.CreateBrushTexture(
      FBrushStyle, FBrushColor, BGRAPixelTransparent);
    try
      FCanvas.FillRect(AX1, AY1, AX2, AY2, bt, dmSet)
    finally
      bt.Free;
    end;
  end;
end;

function TBGRABitmapDrawer.GetBrushColor: TChartColor;
begin
  Result := TChartColor(BGRAToColor(FBrushColor));
end;

function TBGRABitmapDrawer.GetFontAngle: Double;
begin
  Result := 0.0;
end;

procedure TBGRABitmapDrawer.Line(AX1, AY1, AX2, AY2: Integer);
begin
  FCanvas.DrawLineAntialias(AX1, AY1, AX2, AY2, FPenColor, FPenWidth);
end;

procedure TBGRABitmapDrawer.Line(const AP1, AP2: TPoint);
begin
  FCanvas.DrawLineAntialias(AP1.X, AP1.Y, AP2.X, AP2.Y, FPenColor, FPenWidth);
end;

procedure TBGRABitmapDrawer.LineTo(AX, AY: Integer);
var
  p: TPoint;
begin
  p := Point(AX, AY);
  Line(FPrevPoint, p);
  FPrevPoint := p;
end;

procedure TBGRABitmapDrawer.MoveTo(AX, AY: Integer);
begin
  FPrevPoint := Point(AX, AY);
end;

procedure TBGRABitmapDrawer.Polygon(
  const APoints: array of TPoint; AStartIndex, ANumPts: Integer);
var
  bt: TBGRACustomBitmap;
begin
  if FBrushStyle = bsSolid then
    FCanvas.DrawPolygonAntialias(
      PointsToPointsF(APoints, AStartIndex, ANumPts), FBrushColor, FPenWidth)
  else begin
    bt := FCanvas.CreateBrushTexture(
      FBrushStyle, FBrushColor, BGRAPixelTransparent);
    try
      FCanvas.DrawPolygonAntialias(
        PointsToPointsF(APoints, AStartIndex, ANumPts), bt, FPenWidth);
    finally
      bt.Free;
    end;
  end;
end;

procedure TBGRABitmapDrawer.Polyline(
  const APoints: array of TPoint; AStartIndex, ANumPts: Integer);
begin
  FCanvas.DrawPolyLineAntialias(
    PointsToPointsF(APoints, AStartIndex, ANumPts), FPenColor, FPenWidth);
end;

procedure TBGRABitmapDrawer.PrepareSimplePen(AColor: TChartColor);
begin
  FPenColor := ColorToBGRA(AColor);
  FCanvas.PenStyle := psSolid;
end;

procedure TBGRABitmapDrawer.RadialPie(
  AX1, AY1, AX2, AY2: Integer; AStartAngle16Deg, AAngleLength16Deg: Integer);
begin
  Unused(AX1, AY1);
  Unused(AX2, AY2);
  Unused(AStartAngle16Deg, AAngleLength16Deg);
end;

procedure TBGRABitmapDrawer.Rectangle(AX1, AY1, AX2, AY2: Integer);
var
  bt: TBGRACustomBitmap;
begin
  if FBrushStyle = bsSolid then
    FCanvas.RectangleAntialias(
      AX1, AY1, AX2, AY2, FPenColor, FPenWidth, FBrushColor)
  else begin
    bt := FCanvas.CreateBrushTexture(
      FBrushStyle, FBrushColor, BGRAPixelTransparent);
    try
      FCanvas.RectangleAntialias(AX1, AY1, AX2, AY2, bt, FPenWidth);
    finally
      bt.Free;
    end;
  end;
end;

procedure TBGRABitmapDrawer.Rectangle(const ARect: TRect);
begin
  with ARect do
    Rectangle(Left, Top, Right, Bottom)
end;

procedure TBGRABitmapDrawer.SetBrush(ABrush: TFPCustomBrush);
begin
  FBrushColor := FPColorToBGRA(ABrush.FPColor);
  FBrushStyle := ABrush.Style;
end;

procedure TBGRABitmapDrawer.SetBrushColor(AColor: TChartColor);
begin
  FBrushColor := ColorToBGRA(AColor);
end;

procedure TBGRABitmapDrawer.SetBrushParams(
  AStyle: TFPBrushStyle; AColor: TChartColor);
begin
  Unused(AStyle);
  FBrushColor := ColorToBGRA(AColor);
  FBrushStyle := AStyle;
end;

procedure TBGRABitmapDrawer.SetFont(AFont: TFPCustomFont);
begin
  FCanvas.FontName := AFont.Name;
  FCanvas.FontHeight := AFont.Size * 96 div 72;
  FFontOrientation := FGetFontOrientationFunc(AFont);
  FFontColor := FPColorToBGRA(AFont.FPColor);
  // TODO: FontStyle
end;

procedure TBGRABitmapDrawer.SetPen(APen: TFPCustomPen);
begin
  FCanvas.PenStyle := APen.Style;
  FPenWidth := APen.Width;
  // TODO: JoinStyle
  FPenColor := FPColorToBGRA(APen.FPColor);
end;

procedure TBGRABitmapDrawer.SetPenParams(
  AStyle: TFPPenStyle; AColor: TChartColor);
begin
  FCanvas.PenStyle := AStyle;
  FPenColor := ColorToBGRA(AColor);
end;

function TBGRABitmapDrawer.SimpleTextExtent(const AText: String): TPoint;
begin
  Result := FCanvas.TextSize(AText);
end;

procedure TBGRABitmapDrawer.SimpleTextOut(AX, AY: Integer; const AText: String);
begin
  FCanvas.TextOutAngle(
    AX, AY, FFontOrientation, AText, FFontColor, taLeftJustify);
end;

end.