+ implementation of ellipses (drawing, filling, pattern drawing)

fcl/image/Ellipses.pp

@@ -0,0 +1,704 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2003 by the Free Pascal development team
+
+    Drawing of ellipses and arcs, and filling ellipses and pies.
+    
+    See the file COPYING.FPC, 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.
+
+ **********************************************************************}
+{$mode objfpc}
+unit Ellipses;
+
+interface
+
+uses classes, FPImage, FPCanvas;
+
+procedure DrawSolidEllipse (Canv:TFPCustomCanvas; const Bounds:TRect; c:TFPColor);
+procedure DrawSolidEllipse (Canv:TFPCustomCanvas; const Bounds:TRect; Width:integer; c:TFPColor);
+procedure DrawPatternEllipse (Canv:TFPCustomCanvas; const Bounds:TRect; Pattern:TPenPattern; c:TFPColor);
+procedure FillEllipseColor (Canv:TFPCustomCanvas; const Bounds:TRect; c:TFPColor);
+procedure FillEllipsePattern (Canv:TFPCustomCanvas; const Bounds:TRect; Pattern:TBrushPattern; c:TFPColor);
+procedure FillEllipseHashHorizontal (Canv:TFPCustomCanvas; const Bounds:TRect; width:integer; const c:TFPColor);
+procedure FillEllipseHashVertical (Canv:TFPCustomCanvas; const Bounds:TRect; width:integer; const c:TFPColor);
+procedure FillEllipseHashDiagonal (Canv:TFPCustomCanvas; const Bounds:TRect; width:integer; const c:TFPColor);
+procedure FillEllipseHashBackDiagonal (Canv:TFPCustomCanvas; const Bounds:TRect; width:integer; const c:TFPColor);
+procedure FillEllipseHashDiagCross (Canv:TFPCustomCanvas; const Bounds:TRect; width:integer; const c:TFPColor);
+procedure FillEllipseHashCross (Canv:TFPCustomCanvas; const Bounds:TRect; width:integer; const c:TFPColor);
+procedure FillEllipseImage (Canv:TFPCustomCanvas; const Bounds:TRect; const Image:TFPCustomImage);
+procedure FillEllipseImageRel (Canv:TFPCustomCanvas; const Bounds:TRect; const Image:TFPCustomImage);
+
+type
+
+  PEllipseInfoData = ^TEllipseInfoData;
+  TEllipseInfoData = record
+    x, ytopmax, ytopmin, ybotmax, ybotmin : integer;
+    OnlyTop : boolean;
+  end;
+
+  TEllipseInfo = class
+  private
+    fcx, fcy, frx,fry,
+    fa1, fa2, frot : real;
+    fx1,fy1, fx2,fy2 : integer;
+    InfoList : TList;
+    procedure FreeList;
+    procedure ClearList;
+    function FindXIndex (x:integer) : integer;
+    procedure PrepareCalculation (var np:integer; var delta:real);
+    function NewInfoRec (anX:integer) : PEllipseInfoData;
+    procedure CalculateCircular (const b:TRect; var x,y,rx,ry:real);
+  public
+    constructor create;
+    destructor destroy; override;
+    function GetInfoForX (x:integer; var ytopmax,ytopmin,ybotmax,ybotmin:integer):boolean;
+    function GetInfoForX (x:integer; var Info:PEllipseInfoData):boolean;
+    procedure GatherEllipseInfo (const bounds:TRect);
+    procedure GatherArcInfo (const bounds:TRect; alpha1,alpha2:real);
+    property cx : real read fcx; // center point
+    property cy : real read fcy;
+    property rhor : real read frx; // radius
+    property rver : real read fry;
+    { only usable when created with GatherArcInfo }
+    property a1 : real read fa1;    // angle 1 and point on ellipse
+    property x1 : integer read fx1;
+    property y1 : integer read fy1;
+    property a2 : real read fa2;    // angle 2 and point on ellipse
+    property x2 : integer read fx2;
+    property y2 : integer read fy2;
+  end;
+
+implementation
+
+constructor TEllipseInfo.Create;
+begin
+  inherited;
+  InfoList := TList.Create;
+end;
+
+destructor TEllipseInfo.Destroy;
+begin
+  FreeList;
+  inherited;
+end;
+
+procedure TEllipseInfo.ClearList;
+var r : integer;
+    d : PEllipseInfoData;
+begin
+  if assigned (InfoList) then
+    begin
+    for r := 0 to infolist.count-1 do
+      begin
+      d := PEllipseInfoData(InfoList[r]);
+      dispose (d);
+      end;
+    InfoList.clear;
+    end;
+end;
+
+procedure TEllipseInfo.FreeList;
+begin
+  if assigned (InfoList) then
+    begin
+    ClearList;
+    InfoList.Free;
+    InfoList := nil;
+    end;
+end;
+
+function TEllipseInfo.GetInfoForX (x:integer; var ytopmax,ytopmin,ybotmax,ybotmin:integer):boolean;
+var r : PEllipseInfoData;
+begin
+  result := GetInfoForX (x, r);
+  if assigned(r) then
+    begin
+    ytopmax := ytopmax;
+    ytopmin := ytopmin;
+    ybotmax := ybotmax;
+    ybotmin := ybotmin;
+    end;
+end;
+
+function TEllipseInfo.FindXIndex (x : integer) : integer;
+begin
+  result := InfoList.Count;
+  repeat
+    dec (result);
+  until (result < 0) or (x = PEllipseInfoData(InfoList[result])^.x);
+end;
+
+function TEllipseInfo.GetInfoForX (x:integer; var Info:PEllipseInfoData):boolean;
+var r : integer;
+begin
+  r := FindXIndex (x);
+  result := (r >= 0);
+  if result then
+    Info := PEllipseInfoData(InfoList[r])
+end;
+
+procedure TEllipseInfo.PrepareCalculation (var np:integer; var delta:real);
+begin
+  np := round(1.5708 * sqrt(sqr(frx)+sqr(fry)) );
+  // number of pixel in quarter circel to calculate without gaps in drawing
+  delta := pi / (2 * np);
+end;
+
+function TEllipseInfo.NewInfoRec (anX:integer) : PEllipseInfoData;
+begin
+  new (result);
+  result^.x := anX;
+  infolist.Add (result);
+  with result^ do
+    begin
+    ytopmax := -1;
+    ytopmin := maxint;
+    ybotmax := -1;
+    ybotmin := maxint;
+    end;
+end;
+
+procedure TEllipseInfo.CalculateCircular (const b:TRect; var x,y,rx,ry:real);
+begin
+  with b do
+    begin
+    x := (right+left) / 2;
+    y := (top+bottom) / 2;
+    rx := abs(right-left) / 2;
+    ry := abs(bottom-top) / 2;
+    end;
+end;
+
+procedure TEllipseInfo.GatherEllipseInfo (const bounds:TRect);
+var infoP, infoM : PEllipseInfoData;
+    halfnumber,
+    r, NumberPixels, xtemp,yt,yb : integer;
+    pPy, pMy, x,y, rx,ry, xd,yd,ra, rdelta : real;
+begin
+  ClearList;
+  CalculateCircular (bounds, x,y,rx,ry);
+  with bounds do
+  fcx := x;
+  fcy := y;
+  frx := rx;
+  fry := ry;
+  if (rx < 0.5) and (ry < 0.5) then
+    with NewInfoRec (round(x))^ do
+      begin
+      ytopmax := round(y);
+      ytopmin := ytopmax;
+      ybotmax := ytopmax;
+      ybotmin := ytopmax;
+      end
+  else
+    begin
+    PrepareCalculation (NumberPixels, rdelta);
+    halfnumber := NumberPixels div 2;
+    pPy := maxint;
+    pMy := maxint;
+    ra := 0;
+    infoP := NewInfoRec (round(x + rx));
+    infoM := NewInfoRec (round(x - rx));
+    for r := 0 to NumberPixels do
+      begin
+      xd := rx * cos(ra);
+      yd := ry * sin(ra);
+      // take all 4 quarters
+      yt := round(y - yd);
+      yb := round(y + yd);
+      xtemp := round (x + xd);
+      // quarter 1 and 4 at the same x line
+      if infoP^.x <> xtemp then                  // has correct record ?
+        begin
+        with infoP^ do                           // ensure single width
+          begin
+          if r < halfnumber then
+            begin
+            if ytopmin = yt then
+              begin
+              inc (ytopmin);
+              dec (ybotmax);
+              end;
+            end
+          else
+            begin
+            if (ytopmax = pPy) and (ytopmax <> ytopmin) then
+              begin
+              dec (ytopmax);
+              inc (ybotmin);
+              end;
+            end;
+          pPy := ytopmin;
+          end;
+        if not GetInfoForX (xtemp, infoP) then  // record exists already ?
+          infoP := NewInfoRec (xtemp);          // create a new recod
+        end;
+      // lower y is top, min is lowest
+      with InfoP^ do
+        begin
+        if yt < ytopmin then
+          ytopmin := yt;
+        if yb < ybotmin then
+          ybotmin := yb;
+        if yt > ytopmax then
+          ytopmax := yt;
+        if yb > ybotmax then
+          ybotmax := yb;
+        end;
+      // quarter 2 and 3 on the same x line
+      xtemp := round(x - xd);
+      if infoM^.x <> xtemp then                  // has correct record ?
+        begin
+        with infoM^ do             // ensure single width
+          begin
+          if r < halfnumber then
+            begin
+            if ytopmin = yt then
+              begin
+              inc (ytopmin);
+              dec (ybotmax);
+              end;
+            end
+          else
+            begin
+            if (ytopmax = pMy) and (ytopmax <> ytopmin) then
+              begin
+              dec (ytopmax);
+              inc (ybotmin);
+              end;
+            end;
+          pMy := ytopmin;
+          end;
+        if not GetInfoForX (xtemp, infoM) then  // record exists already ?
+          infoM := NewInfoRec (xtemp);          // create a new recod
+        end;
+      // lower y is top, min is lowest
+      with InfoM^ do
+        begin
+        if yt < ytopmin then
+          ytopmin := yt;
+        if yb < ybotmin then
+          ybotmin := yb;
+        if yt > ytopmax then
+          ytopmax := yt;
+        if yb > ybotmax then
+          ybotmax := yb;
+        end;
+      ra := ra + rdelta;
+      end;
+    end;
+end;
+
+procedure TEllipseInfo.GatherArcInfo (const bounds:TRect; alpha1,alpha2:real);
+var stAngle,endAngle:real;
+
+  procedure CheckAngles;
+  begin
+    if a1 < a2 then
+      begin
+      stAngle := a1;
+      endAngle := a2;
+      end
+    else
+      begin
+      stAngle := a2;
+      endAngle := a1;
+      end;
+  end;
+
+begin
+end;
+
+{ The drawing routines }
+
+type
+  TPutPixelProc = procedure (Canv:TFPCustomCanvas; x,y:integer; color:TFPColor);
+  TLinePoints = array[0..PatternBitCount-1] of boolean;
+  PLinePoints = ^TLinePoints;
+
+procedure PatternToPoints (const APattern:TPenPattern; LinePoints:PLinePoints);
+var r : integer;
+    i : longword;
+begin
+  i := 1;
+  for r := PatternBitCount-1 downto 1 do
+    begin
+    LinePoints^[r] := (APattern and i) <> 0;
+    i := i shl 1;
+    end;
+  LinePoints^[0] := (APattern and i) <> 0;
+end;
+
+procedure PutPixelCopy(Canv:TFPCustomCanvas; x,y:integer; color:TFPColor);
+begin
+  with Canv do
+    Colors[x,y] := color;
+end;
+
+procedure PutPixelXor(Canv:TFPCustomCanvas; x,y:integer; color:TFPColor);
+begin
+  with Canv do
+    Colors[x,y] := Colors[x,y] xor color;
+end;
+
+procedure PutPixelOr(Canv:TFPCustomCanvas; x,y:integer; color:TFPColor);
+begin
+  with Canv do
+    Colors[x,y] := Colors[x,y] or color;
+end;
+
+procedure PutPixelAnd(Canv:TFPCustomCanvas; x,y:integer; color:TFPColor);
+begin
+  with Canv do
+    Colors[x,y] := Colors[x,y] and color;
+end;
+
+procedure DrawSolidEllipse (Canv:TFPCustomCanvas; const Bounds:TRect; c:TFPColor);
+var info : TEllipseInfo;
+    r, y : integer;
+    MyPutPix : TPutPixelProc;
+begin
+  with canv.pen do
+    case mode of
+      pmAnd : MyPutPix := @PutPixelAnd;
+      pmOr : MyPutPix := @PutPixelOr;
+      pmXor : MyPutPix := @PutPixelXor;
+      else MyPutPix := @PutPixelCopy;
+    end;
+  info := TEllipseInfo.Create;
+  with Canv, info do
+    try
+      GatherEllipseInfo (bounds);
+      for r := 0 to InfoList.count-1 do
+        with PEllipseInfoData(InfoList[r])^ do
+          begin
+          for y := ytopmin to ytopmax do
+            MyPutPix (Canv, x,y, c);
+          for y := ybotmin to ybotmax do
+            MyPutPix (Canv, x,y, c);
+          end;
+    finally
+      info.Free;
+    end;
+end;
+
+procedure DrawSolidEllipse (Canv:TFPCustomCanvas; const Bounds:TRect; Width:integer; c:TFPColor);
+var infoOut, infoIn : TEllipseInfo;
+    r, y : integer;
+    id : PEllipseInfoData;
+    MyPutPix : TPutPixelProc;
+begin
+  with canv.pen do
+    case mode of
+      pmAnd : MyPutPix := @PutPixelAnd;
+      pmOr : MyPutPix := @PutPixelOr;
+      pmXor : MyPutPix := @PutPixelXor;
+      else MyPutPix := @PutPixelCopy;
+    end;
+  infoIn := TEllipseInfo.Create;
+  infoOut := TEllipseInfo.Create;
+  dec (width);
+  try
+    infoOut.GatherEllipseInfo(bounds);
+    with bounds do
+      infoIn.GatherEllipseInfo (Rect(left+width,top+width,right-width,bottom-width));
+    with Canv do
+      for r := 0 to infoOut.infolist.count-1 do
+        with PEllipseInfoData (infoOut.infolist[r])^ do
+          begin
+          if infoIn.GetInfoForX (x, id) then
+            begin
+            for y := ytopmin to id^.ytopmax do
+              MyPutPix (canv, x,y, c);
+            for y := id^.ybotmin to ybotmax do
+              MyPutPix (canv, x,y, c);
+            end
+          else
+            begin // no inner circle found: draw all points between top and bottom
+            for y := ytopmin to ybotmax do
+              MyPutPix (canv, x,y, c);
+            end;
+          end;
+    finally
+      infoOut.Free;
+      infoIn.Free;
+    end;
+end;
+
+procedure DrawPatternEllipse (Canv:TFPCustomCanvas; const Bounds:TRect; Pattern:TPenPattern; c:TFPColor);
+var info : TEllipseInfo;
+    xx, y : integer;
+    LinePoints : TLinePoints;
+    MyPutPix : TPutPixelProc;
+    id : PEllipseInfoData;
+    CountDown, CountUp, half : integer;
+begin
+  with canv.pen do
+    case mode of
+      pmAnd : MyPutPix := @PutPixelAnd;
+      pmOr : MyPutPix := @PutPixelOr;
+      pmXor : MyPutPix := @PutPixelXor;
+      else MyPutPix := @PutPixelCopy;
+    end;
+  PatternToPoints (pattern, @LinePoints);
+  info := TEllipseInfo.Create;
+  with Canv, info do
+    try
+      GatherEllipseInfo (bounds);
+      CountUp := 0;
+      CountDown := PatternBitCount - 1;
+      half := round (cx);
+      for xx := bounds.left to half do
+        if GetInfoForX (xx, id) then
+          begin
+          with id^ do
+            begin
+            for y := ytopmax downto ytopmin do
+              begin
+              if LinePoints[CountUp mod PatternBitCount] then
+                MyPutPix (Canv, xx,y, c);
+              inc (CountUp);
+              end;
+            for y := ybotmin to ybotmax do
+              begin
+              if LinePoints[PatternBitCount - (CountDown mod PatternBitCount) - 1] then
+                MyPutPix (Canv, xx,y, c);
+              inc (CountDown);
+              end;
+            end;
+          end;
+      for xx := half+1 to bounds.right do
+        if GetInfoForX (xx, id) then
+          begin
+          with id^ do
+            begin
+            for y := ytopmin to ytopmax do
+              begin
+              if LinePoints[CountUp mod PatternBitCount] then
+                MyPutPix (Canv, xx,y, c);
+              inc (CountUp);
+              end;
+            for y := ybotmax downto ybotmin do
+              begin
+              if LinePoints[Patternbitcount - (CountDown mod PatternBitCount) - 1] then
+                MyPutPix (Canv, xx,y, c);
+              inc (CountDown);
+              end;
+            end;
+          end;
+    finally
+      info.Free;
+    end;
+end;
+
+procedure FillEllipseColor (Canv:TFPCustomCanvas; const Bounds:TRect; c:TFPColor);
+var info : TEllipseInfo;
+    r, y : integer;
+    id : PEllipseInfoData;
+begin
+  info := TEllipseInfo.Create;
+  try
+    info.GatherEllipseInfo(bounds);
+    with Canv do
+      for r := 0 to info.infolist.count-1 do
+        with PEllipseInfoData (info.infolist[r])^ do
+          for y := ytopmin to ybotmax do
+            colors[x,y] := c;
+  finally
+    info.Free;
+  end;
+end;
+
+procedure FillEllipsePattern (Canv:TFPCustomCanvas; const Bounds:TRect; Pattern:TBrushPattern; c:TFPColor);
+begin
+end;
+
+procedure FillEllipseHashHorizontal (Canv:TFPCustomCanvas; const Bounds:TRect; width:integer; const c:TFPColor);
+var info : TEllipseInfo;
+    r, y : integer;
+    id : PEllipseInfoData;
+begin
+  info := TEllipseInfo.Create;
+  try
+    info.GatherEllipseInfo(bounds);
+    for r := 0 to info.infolist.count-1 do
+      with PEllipseInfoData (info.infolist[r])^ do
+        for y := ytopmin to ybotmax do
+          if (y mod width) = 0 then
+            canv.colors[x,y] := c;
+  finally
+    info.Free;
+  end;
+end;
+
+procedure FillEllipseHashVertical (Canv:TFPCustomCanvas; const Bounds:TRect; width:integer; const c:TFPColor);
+var info : TEllipseInfo;
+    r, y : integer;
+    id : PEllipseInfoData;
+begin
+  info := TEllipseInfo.Create;
+  try
+    info.GatherEllipseInfo(bounds);
+    for r := 0 to info.infolist.count-1 do
+      with PEllipseInfoData (info.infolist[r])^ do
+        if (x mod width) = 0 then
+          for y := ytopmin to ybotmax do
+            canv.colors[x,y] := c;
+  finally
+    info.Free;
+  end;
+end;
+
+procedure FillEllipseHashDiagonal (Canv:TFPCustomCanvas; const Bounds:TRect; width:integer; const c:TFPColor);
+var info : TEllipseInfo;
+    r, y : integer;
+    id : PEllipseInfoData;
+    w : integer;
+begin
+  info := TEllipseInfo.Create;
+  try
+    info.GatherEllipseInfo(bounds);
+    for r := 0 to info.infolist.count-1 do
+      with PEllipseInfoData (info.infolist[r])^ do
+        begin
+        w := width - 1 - (x mod width);
+        for y := ytopmin to ybotmax do
+          if (y mod width) = w then
+            canv.colors[x,y] := c;
+        end;
+  finally
+    info.Free;
+  end;
+end;
+
+procedure FillEllipseHashBackDiagonal (Canv:TFPCustomCanvas; const Bounds:TRect; width:integer; const c:TFPColor);
+var info : TEllipseInfo;
+    r, y : integer;
+    id : PEllipseInfoData;
+    w : integer;
+begin
+  info := TEllipseInfo.Create;
+  try
+    info.GatherEllipseInfo(bounds);
+    for r := 0 to info.infolist.count-1 do
+      with PEllipseInfoData (info.infolist[r])^ do
+        begin
+        w := (x mod width);
+        for y := ytopmin to ybotmax do
+          if (y mod width) = w then
+            canv.colors[x,y] := c;
+        end;
+  finally
+    info.Free;
+  end;
+end;
+
+procedure FillEllipseHashDiagCross (Canv:TFPCustomCanvas; const Bounds:TRect; width:integer; const c:TFPColor);
+var info : TEllipseInfo;
+    r, y : integer;
+    id : PEllipseInfoData;
+    wy,w1,w2 : integer;
+begin
+  info := TEllipseInfo.Create;
+  try
+    info.GatherEllipseInfo(bounds);
+    for r := 0 to info.infolist.count-1 do
+      with PEllipseInfoData (info.infolist[r])^ do
+        begin
+        w1 := (x mod width);
+        w2 := width - 1 - (x mod width);
+        for y := ytopmin to ybotmax do
+          begin
+          wy := y mod width;
+          if (wy = w1) or (wy = w2) then
+            canv.colors[x,y] := c;
+          end;
+        end;
+  finally
+    info.Free;
+  end;
+end;
+
+procedure FillEllipseHashCross (Canv:TFPCustomCanvas; const Bounds:TRect; width:integer; const c:TFPColor);
+var info : TEllipseInfo;
+    r, y : integer;
+    id : PEllipseInfoData;
+begin
+  info := TEllipseInfo.Create;
+  try
+    info.GatherEllipseInfo(bounds);
+    for r := 0 to info.infolist.count-1 do
+      with PEllipseInfoData (info.infolist[r])^ do
+        if (x mod width) = 0 then
+          for y := ytopmin to ybotmax do
+            canv.colors[x,y] := c
+        else
+          for y := ytopmin to ybotmax do
+            if (y mod width) = 0 then
+              canv.colors[x,y] := c;
+  finally
+    info.Free;
+  end;
+end;
+
+procedure FillEllipseImage (Canv:TFPCustomCanvas; const Bounds:TRect; const Image:TFPCustomImage);
+var info : TEllipseInfo;
+    r, y : integer;
+    id : PEllipseInfoData;
+    w : integer;
+begin
+  info := TEllipseInfo.Create;
+  try
+    info.GatherEllipseInfo(bounds);
+    for r := 0 to info.infolist.count-1 do
+      with PEllipseInfoData (info.infolist[r])^ do
+        begin
+        w := (x mod image.width);
+        for y := ytopmin to ybotmax do
+          canv.colors[x,y] := Image.colors[w, (y mod image.height)];
+        end;
+  finally
+    info.Free;
+  end;
+end;
+
+procedure FillEllipseImageRel (Canv:TFPCustomCanvas; const Bounds:TRect; const Image:TFPCustomImage);
+var info : TEllipseInfo;
+    r, y : integer;
+    id : PEllipseInfoData;
+    xo,yo, xi,yi : integer;
+begin
+  info := TEllipseInfo.Create;
+  try
+    with info do
+      begin
+      GatherEllipseInfo(bounds);
+      xo := round(cx) - (image.width div 2);
+      yo := round(cy) - (image.height div 2);
+      end;
+    for r := 0 to info.infolist.count-1 do
+      with PEllipseInfoData (info.infolist[r])^ do
+        begin
+        xi := (x - xo) mod image.width;
+        if xi < 0 then
+          inc (xi, image.width);
+        for y := ytopmin to ybotmax do
+          begin
+          yi := (y - yo) mod image.height;
+          if yi < 0 then
+            inc (yi, image.height);
+          canv.colors[x,y] := Image.colors[xi, yi];
+          end;
+        end;
+  finally
+    info.Free;
+  end;
+end;
+
+end.

fcl/image/drawing.pp

@@ -3,8 +3,7 @@ program Drawing;
 
 uses classes, sysutils,
      FPImage, FPCanvas, FPImgCanv,
-     FPWritePNG, FPReadPNG,
+     FPWritePNG, FPReadPNG;
-     ftfont;
 
 const
   MyColor : TFPColor = (Red: $7FFF; Green: $0000; Blue: $FFFF; Alpha: alphaOpaque);
@@ -14,10 +13,8 @@ var canvas : TFPcustomCAnvas;
     ci, image : TFPCustomImage;
     writer : TFPCustomImageWriter;
     reader : TFPCustomImageReader;
-    ff : string;
-    afont : TFreeTypeFont;
 begin
-  image := TFPMemoryImage.Create (16,16);
+  image := TFPMemoryImage.Create (100,100);
   ci := TFPMemoryImage.Create (20,20);
   Canvas := TFPImageCanvas.Create (image);
   Writer := TFPWriterPNG.Create;
@@ -25,89 +22,54 @@ begin
   with TFPWriterPNG(Writer) do
     begin
     indexed := false;
-    wordsized := true;
+    wordsized := false;
     UseAlpha := false;
     GrayScale := false;
     end;
   try
-    if paramcount > 0 then
-      ff := paramstr(1)
-    else
-      ff := 'arial';
     ci.LoadFromFile ('test.png', reader);
     with Canvas as TFPImageCanvas do
       begin
-      height := 30;
-      width := 60;
-      with brush do
-        begin
-        color := colBlue;
-        style := bsSolid;
-        end;
-      rectangle(0,0, 20,29);
-      with pen do
-        begin
-        color := colLtGray;
-        end;
-      Line (0,18, 59,18);
-      afont := TFreeTypeFont.Create;
-      with afont do
-        begin
-        name := ff;
-        fontindex := 0;
-        size := 12;
-        color := colWhite;
-        AntiAliased := True;
-        resolution := 96;
-        end;
-      font := afont;
-      writeln ('Outputting texts');
-      // TextOut (20,30, 'Font: '+font.name);
-      font.color := colLtGray;
-      //TextOut (40,80, 'Meer van dit, veel meer...');
-      writeln (Gettextwidth('correct?'));
-      writeln (Gettextheight('correct?'));
-      TextOut (5,17, 'correct?');
-      with colors[6,7] do
-        writeln ('color 6,7 = ',red,',',green,',',blue);
-      aFont.antialiased := False;
-      afont.angle := -0.523598;
-      font.color := colLtGray;
-      //TextOut (40,100, 'Meer van dit, veel meer...');
-      font.color := colRed;
-      font.size := 24;
-      aFont.Angle := PI / 2.4;
-      font.color := colGreen;
-      //TextOut (100,240, 'HOERA !');
-      font.size := 26;
-      aFont.Angle := aFont.Angle + (pi / 90);
-      font.color := colBlue;
-      //TextOut (250,240, 'HOERA !');
-      font.size := 28;
-      aFont.Angle := aFont.Angle + (pi / 90);
-      font.color := colRed;
-      //TextOut (400,240, 'HOERA !');
-      writeln ('Text written');
-{      brush.color := colYellow;
-      brush.Style := bsSolid;
-      rectangle (60,0, 130,40);
-
-      pen.color := colSilver;
       pen.mode := pmCopy;
       pen.style := psSolid;
       pen.width := 1;
-      brush.color := MyColor;
+      pen.color := colred;
-      pen.color := colBlue;
+      with pen.color do
-      Rectangle (0,160, 120,200);
+        red := red div 4;
+      Ellipse (10,10, 90,90);
 
-      brush.style := bsDiagCross;
+      pen.style := psDashDot;
-      brush.color := colGreen;
+      pen.color := colred;
       HashWidth := 10;
+      Ellipse (10,10, 90,90);
+
+      with pen.color do
+        begin
+        red := red div 2;
+        green := red div 4;
+        blue := green;
+        end;
+      pen.style := psSolid;
+      RelativeBrushImage := true;
+      brush.image := ci;
+      brush.style := bsimage;
+      with brush.color do
+        green := green div 2;
+      Ellipse (11,11, 89,89);
+
+      brush.style := bsSolid;
+      brush.color := MyColor;
+      pen.style := psSolid;
+      pen.width := 3;
       pen.color := colSilver;
-      Rectangle (150,50, 250,150);
+      ellipse (30,35, 70,65);
+
+      pen.width := 1;
+      pen.color := colCyan;
+      ellipseC (50,50, 1,1);
 
       writeln ('Saving to inspect !');
-}      end;
+      end;
     image.SaveToFile ('DrawTest.png', writer);
   finally
     Canvas.Free;

fcl/image/fpcanvas.inc

@@ -438,11 +438,15 @@ begin
 end;
 
 procedure TFPCustomCanvas.Ellipse (left,top,right,bottom:integer);
-var b : TRect;
 begin
   Ellipse (Rect(left,top,right,bottom));
 end;
 
+procedure TFPCustomCanvas.EllipseC (x,y:integer; rx,ry:longword);
+begin
+  Ellipse (Rect(x-rx,y-ry,x+rx,y+ry));
+end;
+
 procedure TFPCustomCanvas.Rectangle (left,top,right,bottom:integer);
 begin
   Rectangle (Rect(left,top,right,bottom));

fcl/image/fpcanvas.pp

@@ -219,6 +219,7 @@ type
     // using pen and brush
     procedure Ellipse (Const Bounds:TRect);
     procedure Ellipse (left,top,right,bottom:integer);
+    procedure EllipseC (x,y:integer; rx,ry:longword);
     procedure Polygon (Const points:array of TPoint);
     procedure Polyline (Const points:array of TPoint);
     procedure Rectangle (Const Bounds:TRect);

fcl/image/fppixlcanv.pp

@@ -18,7 +18,7 @@ unit FPPixlCanv;
 
 interface
 
-uses classes, FPImage, FPCanvas, PixTools;
+uses classes, FPImage, FPCanvas, PixTools, ellipses;
 
 type
 
@@ -223,23 +223,41 @@ begin
 end;
 
 procedure TFPPixelCanvas.DoEllipseFill (const Bounds:TRect);
-begin  //TODO
+begin
+  case Brush.style of
+    bsSolid : FillEllipseColor (self, Bounds, brush.color);
+    bsPattern : FillEllipsePattern (self, Bounds, brush.pattern, brush.color);
+    bsImage :
+      if assigned (brush.image) then
+        if FRelativeBI then
+          FillEllipseImageRel (self, Bounds, brush.image)
+        else
+          FillEllipseImage (self, Bounds, brush.image)
+      else
+        raise PixelCanvasException.Create (sErrNoImage);
+    bsDiagonal : FillEllipseHashDiagonal (self, Bounds, FHashWidth, brush.color);
+    bsFDiagonal : FillEllipseHashBackDiagonal (self, Bounds, FHashWidth, brush.color);
+    bsCross : FillEllipseHashCross (self, Bounds, FHashWidth, brush.color);
+    bsDiagCross : FillEllipseHashDiagCross (self, Bounds, FHashWidth, brush.color);
+    bsHorizontal : FillEllipseHashHorizontal (self, Bounds, FHashWidth, brush.color);
+    bsVertical : FillEllipseHashVertical (self, Bounds, FHashWidth, brush.color);
+  end;
 end;
 
 procedure TFPPixelCanvas.DoEllipse (const Bounds:TRect);
-var
+begin
-  Cx,Cy,Rx,Ry,phi:Integer;
+  with pen do
-begin  //TODO: how to find center points and radius from bounds ?
+    case style of
-  with Bounds do
+      psSolid :
-    begin
+        if pen.width > 1 then
-      Cx:=(Right+Left) shr 2;
+          DrawSolidEllipse (self, Bounds, width, color)
-      Cy:=(Bottom+Top) shr 2;
+        else
-      Rx:=Abs(Right-Left) shr 2;
+          DrawSolidEllipse (self, Bounds, color);
-      Ry:=Abs(Bottom-Top) shr 2;
+      psPattern:
+        DrawPatternEllipse (self, Bounds, pattern, color);
+      psDash, psDot, psDashDot, psDashDotDot :
+        DrawPatternEllipse (self, Bounds, PenPatterns[Style], color);
     end;
-  MoveTo(Cx+Rx,Cy);
-  for phi:=1 to 360 do
-    LineTo(Cx+Round(Rx*Cos(phi*Pi/180)),Cy+Round(Ry*Sin(phi*Pi/180)));
 end;
 
 procedure TFPPixelCanvas.DoPolygonFill (const points:array of TPoint);

fcl/image/pixtools.pp

@@ -61,7 +61,7 @@ procedure FillFloodImageRel (Canv:TFPCustomCanvas; x,y :integer; const Image:TFP
 
 implementation
 
-uses clipping;
+uses clipping, ellipses;
 
 procedure FillRectangleColor (Canv:TFPCustomCanvas; x1,y1, x2,y2:integer);
 begin
@@ -981,7 +981,7 @@ end;
 
 procedure SetFloodHashDiag(Canv:TFPCustomCanvas; x,y:integer; data:pointer);
 var r : PFloodHashRec;
-    w : 0..PatternBitCount-1;
+    w : integer;
 begin
   r := PFloodHashRec(data);
   w := r^.width;