Virtual canvas

Jam jam jam

Ever wanted to simplify polygon creation? Perhaps add functions like line, circle and rectangle?
Well I decided to slap together a simple bare-bones virtual canvas that basically draws into an array of TPoints.
Just for fun i also included functions to rotate the resulting point buffer (which is cool but not that useful).

Also, I added two modes of drawing: the first plots everything, the second stores each drawing operation as a list of instructions.
The plan is that if you want to draw the result to a TCanvas, then we can use the native TCanvas methods to render it more correctly.

Have fun!

 

  unit vcanvas;

  interface

  uses  System.SysUtils, System.Classes, Vcl.Graphics, System.Math,
        System.Types,System.Generics.Collections;

  const
  CNT_VCAN_PLOT = 1;
  CNT_VCAN_LINE = 2;
  CNT_VCAN_POLY = 3;
  CNT_VCAN_RECT = 4;

  type

  TVirtualCanvasOpCode = Record
    coCode:   Integer;
    coV1:     Real;
    coV2:     Real;
    coData:   Array of TPoint;
    Constructor Create(const aInstr:Integer;
                const aValues:Array of TPoint);overload;

    constructor Create(const aInstr:Integer;
                const v1:real;
                const aValues:Array of TPoint);overload;

    Constructor Create(const aInstr:Integer;
                const V1,V2:Real;
                const aValues:Array of TPoint);overload;
  End;

  TVirtualCanvas = Class(TObject)
  private
    FStack:     TList<TPoint>;
    FInstr:     TList<TVirtualCanvasOpCode>;
    FOverlap:   Boolean;
    FOps:       Boolean;
  protected
    procedure   AddItem(const aLeft,aTop:Integer);overload;
    procedure   AddItem(const aItem:TPoint);overload;
  public
    Property    UseOps:Boolean read FOps write FOps default false;
    Property    Overlapping:boolean read FOverlap write FOverlap default true;
    Property    Items:TList<TPoint> read FStack;
    Procedure   Plot(const aLeft,aTop:Integer);overload;
    Procedure   Plot(const aPoint:TPoint);overload;
    Procedure   Line(const x1,y1,x2,y2:Integer);overload;
    procedure   Line(const aStart,aStop:TPoint);overload;
    Procedure   Rectangle(const cx,cy,wd,hd:Integer;const aAngle:Integer=0);
    Procedure   DrawTo(Const aCanvas:TCanvas);
    Procedure   Polygon(const aPoints:Array of TPoint);

    Procedure   Circle(cx,cy,radius:Integer);

    function    Bounds:TRect;
    function    FindCenter:TPoint;

    Procedure   Rotate(angle:integer);
    Procedure   Scale(factor:Real);

    Constructor Create;virtual;
    Destructor  Destroy;Override;
  End;

  implementation

  //##########################################################################
  //  TVirtualCanvasOpCode
  //##########################################################################

  Constructor TVirtualCanvasOpCode.Create(const aInstr:Integer;
              const aValues:Array of TPoint);
  var
    x:  Integer;
    mLen: Integer;
  Begin
    coCode:=aInstr;
    coV1:=0.0;
    coV2:=0.0;
    mLen:=length(aValues);
    setLength(coData,mLen);
    for x:=0 to mLen-1 do
    coData[x]:=aValues[x];
  end;

  constructor TVirtualCanvasOpCode.Create(const aInstr:Integer;
              const v1:real;
              const aValues:Array of TPoint);
  var
    x:  Integer;
    mLen: Integer;
  Begin
    coCode:=aInstr;
    coV1:=v1;
    coV2:=0.0;
    mLen:=length(aValues);
    setLength(coData,mLen);
    for x:=0 to mLen-1 do
    coData[x]:=aValues[x];
  end;

  Constructor TVirtualCanvasOpCode.Create(const aInstr:Integer;
              const V1,V2:Real;
              const aValues:Array of TPoint);
  var
    x:  Integer;
    mLen: Integer;
  Begin
    coCode:=aInstr;
    coV1:=V1;
    coV2:=V2;
    mLen:=length(aValues);
    setLength(coData,mLen);
    for x:=0 to mLen-1 do
    coData[x]:=aValues[x];
  end;

  //##########################################################################
  //  TVirtualCanvas
  //##########################################################################

  Constructor TVirtualCanvas.Create;
  Begin
    inherited;
    FStack:=TList<TPoint>.Create;
    FInstr:=TList<TVirtualCanvasOpCode>.Create;
  end;

  Destructor  TVirtualCanvas.Destroy;
  Begin
    FStack.free;
    FInstr.Free;
    inherited;
  end;

  function TVirtualCanvas.Bounds:TRect;
  var
    pt : TPoint;
  begin
    if FStack.Count>0 then
    Begin
      pt:=FStack[0];
      Result.Left := pt.X;
      Result.Top := pt.Y;
      Result.Right := pt.X;
      Result.Bottom := pt.Y;
      for pt in FStack do
      Begin
        if pt.X<Result.Left then
        Result.Left := pt.X else
        if pt.X>Result.Right then
        Result.Right := pt.X;

        if pt.Y<Result.Top then
        Result.Top := pt.Y else
        if pt.Y>Result.Bottom then
        Result.Bottom := pt.Y;
      end;
    end;
  end;

  function TVirtualCanvas.FindCenter:TPoint;
  var
    mBounds:  TRect;
  Begin
    if FStack.Count>0 then
    result:=Bounds.CenterPoint else
    result:=TPoint.Create(-1,-1);
  end;

  procedure TVirtualCanvas.Scale(factor:Real);
  var
     i : Integer;
     dx, dy : Real;
     mItem: TPoint;
     mCenter: TPoint;
  begin
    mCenter:=FindCenter;
    dx := mCenter.X * (1.0-factor);
    dy := mCenter.Y * (1.0-factor);
    for i := 0to FStack.Count-1 do
    begin
      FStack.Items[i]:=TPoint.Create(Round( FStack[i].X * factor + dx ),
      Round( FStack[i].Y * factor + dy ));
    end;
  end;

  Procedure TVirtualCanvas.Rotate(angle: integer);
  var
   i : Integer;
   c, s, dx, dy : Real;
   mCenter: TPoint;
  begin
    if FStack.Count>0 then
    Begin
      angle:=EnsureRange(angle,0,360);
      mCenter:=FindCenter;
      c := cos(angle * PI / 180);
      s := sin(angle * PI / 180);
      for i := 0 to FStack.Count-1 do
      begin
        dx := FStack[i].X - mCenter.X;
        dy := FStack[i].Y - mCenter.Y;
        FStack.Items[i]:=TPoint.Create(Round(mCenter.X + dx*c - dy*s),
        Round(mCenter.Y + dx*s + dy*c));
      end;
    end;
  end;

  Procedure TVirtualCanvas.DrawTo(Const aCanvas:TCanvas);
  var
    x:      Integer;
    mInstr: TVirtualCanvasOpCode;
  Begin
    if assigned(aCanvas) then
    Begin
      if not FOps then
      Begin
        for x:=0 to FStack.Count-1 do
        aCanvas.Pixels[FStack[x].X,FStack[x].Y]:=aCanvas.Pen.Color;
      end else
      Begin
        for x:=0 to FInstr.Count-1 do
        Begin
          mInstr:=FInstr[x];
          case mInstr.coCode of
          CNT_VCAN_PLOT:
            Begin
              aCanvas.Pixels[mInstr.coData[0].X,mInstr.coData[0].Y]:=aCanvas.Pen.Color;
            end;
          CNT_VCAN_LINE:
            Begin
              aCanvas.MoveTo(mInstr.coData[0].X,mInstr.coData[0].Y);
              aCanvas.LineTo(mInstr.coData[1].X,mInstr.coData[1].Y);
            end;
          CNT_VCAN_POLY:
            Begin
              aCanvas.Polygon(mInstr.coData);
            end;
          CNT_VCAN_RECT:
            Begin
              //VCL has no rotated rectangle
              aCanvas.Polygon(mInstr.coData);
            end;
          end;
        end;
      end;
    end;
  end;

  procedure TVirtualCanvas.AddItem(const aLeft,aTop:Integer);
  var
    mPoint: TPoint;
    mIndex: Integer;
  Begin
    if not FOverlap then
    Begin
      (* Only add point if not already in stack *)
      mPoint:=TPoint.Create(aLeft,aTop);
      mIndex:=FStack.IndexOf(mPoint);
      if mIndex<0 then
      FStack.Add(TPoint.Create(aleft,atop));
    end else
    FStack.Add(TPoint.Create(aleft,atop));
  end;

  procedure TVirtualCanvas.AddItem(const aItem:TPoint);
  var
    mIndex: Integer;
  Begin
    if not FOverlap then
    Begin
      (* Only add point if not already in stack *)
      mIndex:=FStack.IndexOf(aItem);
      if mIndex<0 then
      FStack.Add(aItem);
    end else
    FStack.Add(aItem);
  end;

  Procedure TVirtualCanvas.Plot(const aLeft,aTop:Integer);
  Begin
    if not FOps then
    AddItem(aLeft,aTop) else
    FInstr.Add(TVirtualCanvasOPCode.Create(CNT_VCAN_PLOT,
    [TPoint.Create(aLeft,aTop)]));
  end;

  Procedure TVirtualCanvas.Plot(const aPoint:TPoint);
  Begin
    if not FOps then
    AddItem(aPoint) else
    FInstr.Add(TVirtualCanvasOPCode.Create(CNT_VCAN_PLOT,[aPoint]));
  end;

  Procedure TVirtualCanvas.Line(const x1,y1,x2,y2:Integer);
  var
    Lpixel, LMaxAxisLength: integer;
    LRatio: Real;
    dx,dy:Integer;
  begin
    if not FOps then
    Begin
      LMaxAxisLength := Max(abs(x1 - x2), abs(y1 - y2));
      for Lpixel := 0 to LMaxAxisLength do
      begin
        LRatio := Lpixel / LMaxAxisLength;
        dx:=x1 + Round((x2 - x1) * LRatio);
        dy:=y1 + Round((y2 - y1) * LRatio);
        AddItem(dx,dy);
      end;
    end else
    FInstr.Add(TVirtualCanvasOPCode.Create(CNT_VCAN_LINE,
    [TPoint.Create(x1,y1),TPoint.Create(x2,y2)]));
  end;

  procedure TVirtualCanvas.Line(const aStart,aStop:TPoint);
  Begin
    if not FOps then
    Line(aStart.X,aStart.Y,aStop.X,aStop.Y) else
    FInstr.Add(TVirtualCanvasOPCode.Create(CNT_VCAN_LINE,
    [aStart,aStop]));
  end;

  Procedure TVirtualCanvas.Circle(cx: Integer; cy: Integer; radius: Integer);
  var
    xpos,ypos: Integer;
    Pix, Pixels: Integer;
    x: Real;
  begin
    if radius>0 then
    Begin
      Pixels := Round( 2 * Radius * PI);
      for pix := 0 to Pixels-1 do
      begin
        x := 360 * pix / Pixels;
        xpos:=(round(cx + sin(x*pi/180)*radius));
        ypos:=(round(cy + cos(x*pi/180)*radius));
        self.AddItem(xpos,ypos);
      end;
    end;
  end;

  Procedure TVirtualCanvas.Polygon(const aPoints:Array of TPoint);
  var
    mLen: Integer;
    mIndex: Integer;
  Begin
    mLen:=length(aPoints);
    if mLen>0 then
    Begin
      if not FOps then
      Begin
        case mLen of
        1:  AddItem(aPoints[0]);
        2:  Line(aPoints[0],aPoints[1]);
        else
          begin
            for mIndex:=1 to mLen-1 do
            Line(aPoints[mIndex-1],aPoints[mIndex]);
            Line(aPoints[mLen-1],aPoints[0]);
          end;
        end;
      end else
      FInstr.Add(TVirtualCanvasOPCode.Create(CNT_VCAN_POLY,aPoints));
    end;
  end;

  Procedure TVirtualCanvas.Rectangle(const cx,cy,wd,hd:Integer;
            const aAngle:Integer=0);
  var
    x1,y1,x2,y2,x3,y3,x4,y4:integer;
    radius,theta2:real;
    mAngle: Real;
  begin
    if (wd>0) and(hd>0) then
    Begin
      mAngle:=EnsureRange(aAngle,0,360) * PI / 180;
      radius:=sqrt(sqr(wd/2)+sqr(hd/2));
      theta2:=arctan(hd/wd);

      x1:=round(cx-radius*cos(theta2+mAngle));
      y1:=round(cy-radius*sin(theta2+mAngle));
      x2:=round(cx+radius*cos(theta2-mAngle));
      y2:=round(cy-radius*sin(theta2-mAngle));
      x3:=round(cx+radius*cos(theta2+mAngle));
      y3:=round(cy+radius*sin(theta2+mAngle));
      x4:=round(cx-radius*cos(theta2-mAngle));
      y4:=round(cy+radius*sin(theta2-mAngle));

      if not FOps then
      polygon([TPoint.Create(x1,y1),
        TPoint.Create(x2,y2),
        TPoint.Create(x3,y3),
        TPoint.Create(x4,y4)]) else
      Begin
        FInstr.Add(TVirtualCanvasOpCode.Create(CNT_VCAN_RECT,aAngle,
        [TPoint.Create(x1,y1),
        TPoint.Create(x2,y2),
        TPoint.Create(x3,y3),
        TPoint.Create(x4,y4)]));
      end;
    end;
  end;

  end.