unit shapes;

interface

uses Windows, SysUtils, Classes, Graphics, Types;

type
  TRPen = record
    Color: TColor;
    Width: integer;
    Style: TPenStyle;
  end;

type
  TRBrush = record
    Color: TColor;
    Style: TBrushStyle;
  end;

Type
  TFShape = class
  private
    procedure SetStyle(CanvasOut: TCanvas);
  public
    PenF: TRPen;
    BrushF: TRBrush;
    PointStart: TPoint;
    Locked: Boolean;
    DrawIt: Boolean;
    procedure Draw(CanvasOut: TCanvas); virtual; abstract;
    procedure Move(X, Y: integer); virtual; abstract;
    procedure AddPoint(X, Y: integer; CanvasOut: TCanvas); virtual; abstract;
    procedure DrawObject(X, Y: integer; CanvasOut: TCanvas); virtual; abstract;
    constructor Create(const Source: TCanvas); virtual;
  end;

type
  TPoints = array of TPoint;

Type
  TFFreeHand = class(TFShape)
  private
    Points: TPoints;
    procedure DrawLastLine(CanvasOut: TCanvas);
  public
    procedure Move(X, Y: integer); override;
    procedure AddPoint(X, Y: integer; CanvasOut: TCanvas); override;
    procedure Draw(CanvasOut: TCanvas); override;
  end;

Type
  TFStandartShape = class(TFShape)
  public
    PointEnd: TPoint;
    procedure Draw(CanvasOut: TCanvas); override;
    procedure Move(X, Y: integer); override;
  end;

type
  TFline = class(TFStandartShape)
  public
    procedure DrawObject(X, Y: integer; CanvasOut: TCanvas); override;
  end;

type
  TFRect = class(TFStandartShape)
  public
    procedure DrawObject(X, Y: integer; CanvasOut: TCanvas); override;
  end;

type
  TFEllipse = class(TFStandartShape)
  public
    procedure DrawObject(X, Y: integer; CanvasOut: TCanvas); override;
  end;

type
  TFRoundRect = class(TFStandartShape)
  public
    Corners: integer;
    procedure DrawObject(X, Y: integer; CanvasOut: TCanvas); override;

  end;

type
  TFShapeList = class
  private
    List: array of TFShape;
    function GetCount: integer;
    function GetItem(Index: integer): TFShape;
    procedure PutItem(Index: integer; Item: TFShape);
  public
    property Count: integer read GetCount;
    property Items[Index: integer]: TFShape read GetItem write PutItem;
    function Add(Sender: TFShape): integer;
    procedure Delete(Index: integer);
    procedure Swap(Index1, Index2: integer);
    procedure DrawAll(CanvasOut: TCanvas);
  end;

implementation

{ TFShapeList }

function TFShapeList.GetCount: integer;
begin
  Result := Length(List);
end;

function TFShapeList.GetItem(Index: integer): TFShape;
begin
  if (Index < 0) or (Index > Count - 1) then
  begin
    Raise Exception.Create('Array out of range Error');
    exit;
  end;
  Result := List[Index];
end;

procedure TFShapeList.PutItem(Index: integer; Item: TFShape);
begin
  if (Index < 0) or (Index > Count - 1) then
  begin
    Raise Exception.Create('Array out of range Error');
    exit;
  end;
  List[Index] := Item;
end;

procedure TFShapeList.Swap(Index1, Index2: integer);
var
  tmp: TFShape;
begin
  if (Index1 < 0) or (Index2 < 0) or (Index1 > Count - 1) or
    (Index2 > Count - 1) then
  begin
    Raise Exception.Create('Array out of range Error');
    exit;
  end;
  tmp := List[Index1];
  List[Index1] := List[Index2];
  List[Index2] := tmp;
end;

procedure TFShapeList.Delete(Index: integer);
var
  i: integer;
begin
  if (Index < 0) or (Index > Count - 1) then
  begin
    Raise Exception.Create('Array out of range Error');
    exit;
  end;
  List[Index].Free;
  for i := Index to High(List) - 1 do
    List[i] := List[i + 1];
  SetLength(List, Length(List) - 1);
end;

function TFShapeList.Add(Sender: TFShape): integer;
begin
  SetLength(List, Length(List) + 1);
  List[ High(List)] := Sender;
  Result := Count - 1;
end;

procedure TFShapeList.DrawAll(CanvasOut: TCanvas);
var
  p: TFShape;
begin
  for p in List do
    p.Draw(CanvasOut)
end;

{ TFShape }

constructor TFShape.Create;
begin
  inherited Create;
  PenF.Color := clBlack;
  PenF.Width := 1;
  PenF.Style := psSolid;
  BrushF.Color := clWhite;
  BrushF.Style := bsSolid;
  Locked := false;
end;

procedure TFShape.SetStyle(CanvasOut: TCanvas);
begin
  with CanvasOut do
  begin
    Pen.Color := PenF.Color;
    Pen.Width := PenF.Width;
    Pen.Style := PenF.Style;
    Brush.Color := BrushF.Color;
    Brush.Style := BrushF.Style;
  end;
end;

{ TFFreeHand }
procedure TFFreeHand.AddPoint(X, Y: integer; CanvasOut: TCanvas);
begin
  SetLength(Points, Length(Points) + 1);
  Points[ High(Points)] := Point(X, Y);
  DrawLastLine(CanvasOut);
end;

procedure TFFreeHand.DrawLastLine(CanvasOut: TCanvas);
begin
  with CanvasOut do
  begin
    SetStyle(CanvasOut);
    if Length(Points) = 1 then
      MoveTo(PointStart.X, PointStart.Y);
    LineTo(Points[Length(Points) - 1].X, Points[Length(Points) - 1].Y);
  end;
end;

procedure TFFreeHand.Draw(CanvasOut: TCanvas);
var
  p: TPoint;
begin
  if not DrawIt then
    exit;
  with CanvasOut do
  begin
    SetStyle;
    if (PointStart.X = Points[0].X) and (PointStart.Y = Points[0].Y) and
      (PenF.Width = 1) then
      Pixels[Points[0].X, Points[0].Y] := PenF.Color;
    MoveTo(PointStart.X, PointStart.Y);
    for p in Points do
      LineTo(p.X, p.Y);
  end;
end;

procedure TFFreeHand.Move(X, Y: integer);
var
  p: TPoint;
begin
  if Locked then
    exit;
  Inc(PointStart.X, X);
  Inc(PointStart.Y, Y);
  for p in Points do
  begin
    Inc(p.X, X);
    Inc(p.Y, Y);
  end;
end;

{ TFLine }
procedure TFline.DrawObject(X, Y: integer; CanvasOut: TCanvas);
begin
  SetStyle(CanvasOut);
  with CanvasOut do
  begin
    MoveTo(PointStart.X, PointStart.Y);
    LineTo(X, Y);
  end;
end;

{ TFRect }
procedure TFRect.DrawObject(X, Y: integer; Load: Boolean = false);
begin
  SetStyle(CanvasOut);
  CanvasOut.Rectangle(PointStart.X, PointStart.Y, X, Y);
end;

{ TFEllipse }
procedure TFEllipse.DrawObject(X, Y: integer; Load: Boolean = false);
begin
  SetStyle(CanvasOut);
  CanvasOut.Ellipse(PointStart.X, PointStart.Y, X, Y);
end;

{ TFRoundRect }
procedure TFRoundRect.DrawObject(X, Y: integer; Load: Boolean = false);
begin
  SetStyle(CanvasOut);
  CanvasOut.RoundRect(PointStart.X, PointStart.Y, X, Y, Corners, Corners);
end;

end.