lazarus/components/tachart/tadiagramdrawing.pas

{
 *****************************************************************************
  See the file COPYING.modifiedLGPL.txt, included in this distribution,
  for details about the license.
 *****************************************************************************

  Authors: Alexander Klenin

}
unit TADiagramDrawing;

{$MODE ObjFPC}{$H+}

interface

uses
  Classes, FPCanvas,
  TADrawUtils, TADiagram;

type
  TDiaContextDrawer = class(TDiaContext)
  private
    FDrawer: IChartDrawer;
  public
    property Drawer: IChartDrawer read FDrawer write FDrawer;
  end;

  IDiaDrawerDecorator = interface
    ['{A2AB054F-D725-401D-A249-18BF03CFF6FA}']
    procedure Apply(ADrawer: IChartDrawer);
  end;

  TDiaBrushDecorator = class(TDiaDecorator, IDiaDrawerDecorator)
  private
    FBrush: TFPCustomBrush;
  public
    constructor Create(AOwner: TDiaDecoratorList);
    destructor Destroy; override;
    procedure Apply(ADrawer: IChartDrawer);
    property Brush: TFPCustomBrush read FBrush;
  end;

  TDiaFontDecorator = class(TDiaDecorator, IDiaDrawerDecorator)
  private
    FFont: TFPCustomFont;
  public
    constructor Create(AOwner: TDiaDecoratorList);
    destructor Destroy; override;
    procedure Apply(ADrawer: IChartDrawer);
    property Font: TFPCustomFont read FFont;
  end;

  TDiaPenDecorator = class(TDiaDecorator, IDiaDrawerDecorator)
  private
    FPen: TFPCustomPen;
  public
    constructor Create(AOwner: TDiaDecoratorList);
    destructor Destroy; override;
    procedure Apply(ADrawer: IChartDrawer);
    property Pen: TFPCustomPen read FPen;
  end;

implementation

uses
  Math, Types, SysUtils,
  TAGeometry;

function ToImage(const AP: TDiaPoint): TPoint; inline;
begin
  Result := RoundPoint(AP.AsUnits(duPixels));
end;

procedure DrawDiaBox(ASelf: TDiaBox);
var
  id: IChartDrawer;
  d: IDiaDecorator;
begin
  id := (ASelf.Owner.Context as TDiaContextDrawer).Drawer;
  id.PrepareSimplePen($000000);
  id.SetBrushColor($FFFFFF);
  for d in ASelf.Decorators do
    if d is IDiaDrawerDecorator then
      (d as IDiaDrawerDecorator).Apply(id);
  with ASelf do
    id.Polygon([
      ToImage(FTopLeft), ToImage(FTopRight),
      ToImage(FBottomRight), ToImage(FBottomLeft)
    ], 0, 4);
  id.TextOut.Pos(ToImage(ASelf.FTopLeft) + Point(4, 4)).Text(ASelf.Caption).Done;
end;

procedure DrawEndPoint(
  ADrawer: IChartDrawer; AEndPoint: TDiaEndPoint;
  const APos: TPoint; AAngle: Double);
var
  da: Double;
  diag: Integer;
  pt1, pt2: TPoint;
  d: IDiaDecorator;
begin
  ADrawer.SetPenParams(psSolid, $000000);
  ADrawer.SetBrushColor($FFFFFF);
  for d in AEndPoint.Decorators do
    if d is IDiaDrawerDecorator then
      (d as IDiaDrawerDecorator).Apply(ADrawer);
  da := ArcTan2(AEndPoint.Width.Value, AEndPoint.Length.Value);

  diag := -Round(Sqrt(Sqr(AEndPoint.Length.Value) + Sqr(AEndPoint.Width.Value)));
  pt1 := APos + RotatePointX(diag, AAngle - da);
  pt2 := APos + RotatePointX(diag, AAngle + da);
  case AEndPoint.Shape of
    depsClosedArrow: ADrawer.Polygon([pt1, APos, pt2], 0, 3);
    depsOpenArrow: ADrawer.Polyline([pt1, APos, pt2], 0, 3);
  end;
end;

procedure DrawDiaLink(ASelf: TDiaLink);
var
  id: IChartDrawer;
  startPos, endPos, p: TPoint;
  d: IDiaDecorator;
begin
  if (ASelf.Start.Connector = nil) or (ASelf.Finish.Connector = nil) then exit;
  id := (ASelf.Owner.Context as TDiaContextDrawer).Drawer;
  id.PrepareSimplePen($000000);
  for d in ASelf.Decorators do
    if d is IDiaDrawerDecorator then
      (d as IDiaDrawerDecorator).Apply(id);
  startPos := ToImage(ASelf.Start.Connector.ActualPos);
  endPos := ToImage(ASelf.Finish.Connector.ActualPos);
  case ASelf.Routing of
    dlrStraight: begin
      id.Line(startPos, endPos);
      p := startPos;
    end;
    dlrXThenY: begin
      p := Point(endPos.X, startPos.Y);
      id.Polyline([startPos, p, endPos], 0, 3);
    end;
    dlrYThenX: begin
      p := Point(startPos.X, endPos.Y);
      id.Polyline([startPos, p, endPos], 0, 3);
    end;
  end;
  if ASelf.Start.Shape <> depsNone then
    with p - endPos do
      DrawEndPoint(id, ASelf.Start, startPos, ArcTan2(Y, X));
  if ASelf.Finish.Shape <> depsNone then
    with endPos - p do
      DrawEndPoint(id, ASelf.Finish, endPos, ArcTan2(Y, X));
end;

{ TDiaBrushDecorator }

procedure TDiaBrushDecorator.Apply(ADrawer: IChartDrawer);
begin
  ADrawer.Brush := Brush;
end;

constructor TDiaBrushDecorator.Create(AOwner: TDiaDecoratorList);
begin
  inherited Create(AOwner);
  FBrush := TFPCustomBrush.Create;
end;

destructor TDiaBrushDecorator.Destroy;
begin
  FreeAndNil(FBrush);
  inherited;
end;

{ TDiaFontDecorator }

procedure TDiaFontDecorator.Apply(ADrawer: IChartDrawer);
begin
  ADrawer.Font := Font;
end;

constructor TDiaFontDecorator.Create(AOwner: TDiaDecoratorList);
begin
  inherited Create(AOwner);
  FFont := TFPCustomFont.Create;
end;

destructor TDiaFontDecorator.Destroy;
begin
  FreeAndNil(FFont);
  inherited Destroy;
end;

{ TDiaPenDecorator }

procedure TDiaPenDecorator.Apply(ADrawer: IChartDrawer);
begin
  ADrawer.Pen := Pen;
end;

constructor TDiaPenDecorator.Create(AOwner: TDiaDecoratorList);
begin
  inherited Create(AOwner);
  FPen := TFPCustomPen.Create;
  FPen.Mode := pmCopy;
end;

destructor TDiaPenDecorator.Destroy;
begin
  FreeAndNil(FPen);
  inherited;
end;

initialization
  TDiaBox.FInternalDraw := @DrawDiaBox;
  TDiaLink.FInternalDraw := @DrawDiaLink;

end.