+ Initial implementation

fcl/image/clipping.pp

@@ -0,0 +1,204 @@
+{$mode objfpc}{$h+}
+unit Clipping;
+
+interface
+
+uses classes;
+
+procedure SortRect (var rect : TRect);
+procedure SortRect (var left,top, right,bottom : integer);
+function PointInside (const x,y:integer; bounds:TRect) : boolean;
+
+procedure CheckRectClipping (ClipRect:TRect; var Rect:Trect);
+procedure CheckRectClipping (ClipRect:TRect; var x1,y1, x2,y2 : integer);
+procedure CheckLineClipping (ClipRect:TRect; var x1,y1, x2,y2 : integer);
+
+implementation
+
+procedure SortRect (var rect : TRect);
+begin
+  with rect do
+    SortRect (left,top, right,bottom);
+end;
+
+procedure SortRect (var left,top, right,bottom : integer);
+var r : integer;
+begin
+  if left > right then
+    begin
+    r := left;
+    left := right;
+    right := r;
+    end;
+  if top > bottom then
+    begin
+    r := top;
+    top := bottom;
+    bottom := r;
+    end;
+end;
+
+function PointInside (const x,y:integer; bounds:TRect) : boolean;
+begin
+  SortRect (bounds);
+  with Bounds do
+    result := (x >= left) and (x <= right) and
+              (y >= bottom) and (y <= top);
+end;
+
+procedure CheckRectClipping (ClipRect:TRect; var Rect:Trect);
+begin
+  with ClipRect do
+    CheckRectClipping (ClipRect, left,top,right,bottom);
+end;
+
+procedure CheckRectClipping (ClipRect:TRect; var x1,y1, x2,y2 : integer);
+  procedure ClearRect;
+  begin
+    x1 := -1;
+    x2 := -1;
+    y1 := -1;
+    y2 := -1;
+  end;
+begin
+  SortRect (ClipRect);
+  SortRect (x1,y1, x2,y2);
+  with ClipRect do
+    begin
+    if ( x1 < Left ) then // left side needs to be clipped
+      x1 := left;
+    if ( x2 > right ) then // right side needs to be clipped
+      x2 := right;
+    if ( y1 < top ) then // top side needs to be clipped
+      y1 := top;
+    if ( y2 > bottom ) then // bottom side needs to be clipped
+      y2 := bottom;
+    if (x1 > x2) or (y1 < y2) then
+      ClearRect;
+    end;
+end;
+
+procedure CheckLineClipping (ClipRect:TRect; var x1,y1, x2,y2 : integer);
+var a,b : single;
+    Calculated : boolean;
+    xdiff,n : integer;
+  procedure CalcLine;
+    begin
+    if not Calculated then
+      begin
+      xdiff := (x1-x2);
+      a := (y1-y2) / xdiff;
+      b := (x1*y2 - x2*y1) / xdiff;
+      Calculated := true;
+      end;
+    end;
+  procedure ClearLine;
+    begin
+    x1 := -1;
+    y1 := -1;
+    x2 := -1;
+    y2 := -1;
+    end;
+begin
+  Calculated := false;
+  SortRect (ClipRect);
+  xdiff := (x1-x2);
+  with ClipRect do
+    if xdiff = 0 then
+      begin  // vertical line
+      if y1 > bottom then
+        y1 := bottom
+      else if y1 < top then
+        y1 := top;
+      if y2 > bottom then
+        y2 := bottom
+      else if y2 < top then
+        y2 := top;
+      end
+    else if (y1-y2) = 0 then
+      begin  // horizontal line
+      if x1 < left then
+        x1 := left
+      else if x1 > right then
+        x1 := right;
+      if x2 < left then
+        x2 := left
+      else if x2 > right then
+        x2 := right;
+      end
+    else
+      if ( (y1 < top) and (y2 < top) ) or
+         ( (y1 > bottom) and (y2 > bottom) ) or
+         ( (x1 > right) and (x2 > right) ) or
+         ( (x1 < left) and (x2 < left) ) then
+        ClearLine // completely outside ClipRect
+      else
+        begin
+        if (y1 < top) or (y2 < top) then
+          begin
+          CalcLine;
+          n := round ((top - b) / a);
+          if (n >= left) and (n <= right) then
+            if (y1 < top) then
+              begin
+              x1 := n;
+              y1 := top;
+              end
+            else
+              begin
+              x2 := n;
+              y2 := top;
+              end;
+          end;
+        if (y1 > bottom) or (y2 > bottom) then
+          begin
+          CalcLine;
+          n := round ((bottom - b) / a);
+          if (n >= left) and (n <= right) then
+            if (y1 > bottom) then
+              begin
+              x1 := n;
+              y1 := bottom;
+              end
+            else
+              begin
+              x2 := n;
+              y2 := bottom;
+              end;
+          end;
+        if (x1 < left) or (x2 < left) then
+          begin
+          CalcLine;
+          n := round ((left * a) + b);
+          if (n <= bottom) and (n >= top) then
+            if (x1 < left) then
+              begin
+              x1 := left;
+              y1 := n;
+              end
+            else
+              begin
+              x2 := left;
+              y2 := n;
+              end;
+          end;
+        if (x1 > right) or (x2 > right) then
+          begin
+          CalcLine;
+          n := round ((right * a) + b);
+          if (n <= bottom) and (n >= top) then
+            if (x1 > right) then
+              begin
+              x1 := right;
+              y1 := n;
+              end
+            else
+              begin
+              x2 := right;
+              y2 := n;
+              end;
+          end;
+        end;
+end;
+
+end.

fcl/image/fpbrush.inc

@@ -0,0 +1,30 @@
+{ TFPCustomBrush }
+
+procedure TFPCustomBrush.SetStyle (AValue : TFPBrushStyle);
+begin
+  FStyle := AValue
+end;
+
+procedure TFPCustomBrush.SetImage (AValue : TFPCustomImage);
+begin
+  FImage := AValue;
+end;
+
+procedure TFPCustomBrush.DoCopyProps (From:TFPCanvasHelper);
+begin
+  with From as TFPCustomBrush do
+    begin
+    self.Style := Style;
+    self.Image := Image;
+    end;
+  inherited;
+end;
+
+function TFPCustomBrush.CopyBrush : TFPCustomBrush;
+begin
+  result := TFPCustomBrush(self.ClassType.Create);
+  result.DoCopyProps (self);
+end;
+
+
+

fcl/image/fpcanvas.inc

@@ -0,0 +1,546 @@
+{ TFPCustomCanvas }
+
+constructor TFPCustomCanvas.Create;
+begin
+  inherited create;
+  FClipRect := Rect(-1,-1,-1,-1);
+  FClipping := false;
+  FRemovingHelpers := false;
+  FHelpers := TList.Create;
+  FDefaultFont := CreateDefaultFont;
+  FDefaultPen := CreateDefaultPen;
+  FDefaultBrush := CreateDefaultBrush;
+end;
+
+destructor TFPCustomCanvas.Destroy;
+begin
+  FRemovingHelpers := True;
+  FDefaultFont.Free;
+  FDefaultBrush.Free;
+  FDefaultPen.Free;
+  RemoveHelpers;
+  FHelpers.Free;
+  FRemovingHelpers := False;
+  inherited;
+end;
+
+procedure TFPCustomCanvas.CheckHelper (AHelper:TFPCanvasHelper);
+var r : integer;
+begin
+  if AHelper = FPen then
+    FPen := nil
+  else if AHelper = FFont then
+    FFont := nil
+  else if AHelper = FBrush then
+    FBrush := nil;
+  if not FRemovingHelpers then
+    begin
+    if AHelper = FDefaultFont then
+      FDefaultFont := CreateDefaultFont
+    else if AHelper = FDefaultPen then
+      FDefaultPen := CreateDefaultPen
+    else if AHelper = FDefaultBrush then
+      FDefaultBrush := CreateDefaultBrush;
+    end;
+  r := FHelpers.IndexOf (AHelper);
+  if (r >= 0) then
+    FHelpers.delete (r);
+end;
+
+procedure TFPCustomCanvas.RemoveHelpers;
+var r : integer;
+    OldState : boolean;
+begin
+  for r := FHelpers.count-1 downto 0 do
+    with TFPCanvasHelper(FHelpers[r]) do
+      if FCanvas = self then
+        if FFixedCanvas then
+          DeallocateResources
+        else
+          FCanvas := nil;
+  FHelpers.Clear;
+end;
+
+procedure TFPCustomCanvas.AddHelper (AHelper : TFPCanvasHelper);
+var r : integer;
+begin
+  r := FHelpers.IndexOf (AHelper);
+  if r < 0 then
+    FHelpers.Add (AHelper);
+end;
+
+function TFPCustomCanvas.CreateDefaultFont : TFPCustomFont;
+begin
+  result := DoCreateDefaultFont;
+  if not assigned (result) then
+    raise TFPCanvasException.CreateFmt (ErrCouldNotCreate, [EPen])
+  else
+    begin
+    result.AllocateResources (self);
+    FHelpers.Add (result);
+    end;
+end;
+
+function TFPCustomCanvas.CreateDefaultPen : TFPCustomPen;
+begin
+  result := DoCreateDefaultPen;
+  if not assigned (result) then
+    raise TFPCanvasException.CreateFmt (ErrCouldNotCreate, [EPen])
+  else
+    begin
+    result.AllocateResources (self);
+    FHelpers.Add (result);
+    end;
+end;
+
+function TFPCustomCanvas.CreateDefaultBrush : TFPCustomBrush;
+begin
+  result := DoCreateDefaultBrush;
+  if not assigned (result) then
+    raise TFPCanvasException.CreateFmt (ErrCouldNotCreate, [EPen])
+  else
+    begin
+    result.AllocateResources (self);
+    FHelpers.Add (result);
+    end;
+end;
+
+function TFPCustomCanvas.CreateFont : TFPCustomFont;
+begin
+  result := DoCreateDefaultFont;
+end;
+
+function TFPCustomCanvas.CreatePen : TFPCustomPen;
+begin
+  result := DoCreateDefaultPen;
+end;
+
+function TFPCustomCanvas.CreateBrush : TFPCustomBrush;
+begin
+  result := DoCreateDefaultBrush;
+end;
+
+function TFPCustomCanvas.AllowFont (AFont : TFPCustomFont) : boolean;
+begin
+  if AFont is TFPCustomDrawFont then
+    result := true
+  else
+    result := DoAllowFont (AFont);
+end;
+
+procedure TFPCustomCanvas.SetFont (AValue:TFPCustomFont);
+begin
+  if (AValue <> FFont) and AllowFont(AValue) then
+    begin
+    AValue.AllocateResources (self);
+    FFont := AValue;
+    AddHelper (AValue);
+    end;
+end;
+
+function TFPCustomCanvas.GetFont : TFPCustomFont;
+begin
+  if assigned (FFont) then
+    result := FFont
+  else
+    result := FDefaultFont;
+end;
+
+function TFPCustomCanvas.DoAllowFont (AFont : TFPCustomFont) : boolean;
+begin
+  result := false;
+end;
+
+function TFPCustomCanvas.AllowBrush (ABrush : TFPCustomBrush) : boolean;
+begin
+  if ABrush is TFPCustomDrawBrush then
+    result := true
+  else
+    result := DoAllowBrush (ABrush);
+end;
+
+procedure TFPCustomCanvas.SetBrush (AValue:TFPCustomBrush);
+begin
+  if (AValue <> FBrush) and AllowBrush(AValue) then
+    begin
+    AValue.AllocateResources (self);
+    FBrush := AValue;
+    AddHelper (AValue);
+    end;
+end;
+
+function TFPCustomCanvas.GetBrush : TFPCustomBrush;
+begin
+  if assigned (FBrush) then
+    result := FBrush
+  else
+    result := FDefaultBrush
+end;
+
+function TFPCustomCanvas.DoAllowBrush (ABrush : TFPCustomBrush) : boolean;
+begin
+  result := false;
+end;
+
+function TFPCustomCanvas.AllowPen (APen : TFPCustomPen) : boolean;
+begin
+  if APen is TFPCustomDrawPen then
+    result := true
+  else
+    result := DoAllowPen (APen);
+end;
+
+procedure TFPCustomCanvas.SetPen (AValue:TFPCustomPen);
+begin
+  if (AValue <> FPen) and AllowPen (AValue) then
+    begin
+    AValue.AllocateResources (self);
+    FPen := AValue;
+    AddHelper (AValue);
+    end;
+end;
+
+function TFPCustomCanvas.GetPen : TFPCustomPen;
+begin
+  if assigned (FPen) then
+    result := FPen
+  else
+    result := FDefaultPen;
+end;
+
+function TFPCustomCanvas.DoAllowPen (APen : TFPCustomPen) : boolean;
+begin
+  result := false;
+end;
+
+procedure TFPCustomCanvas.DoLockCanvas;
+begin
+end;
+
+procedure TFPCustomCanvas.DoUnlockCanvas;
+begin
+end;
+
+procedure TFPCustomCanvas.LockCanvas;
+begin
+  if FLocks = 0 then
+    DoLockCanvas;
+  inc (FLocks);
+end;
+
+procedure TFPCustomCanvas.UnlockCanvas;
+begin
+  if FLocks > 0 then
+    begin
+    dec (FLocks);
+    if FLocks = 0 then
+      DoUnlockCanvas;
+    end
+  else
+    raise TFPCanvasException.Create (ErrNoLock);
+end;
+
+procedure TFPCustomCanvas.TextOut (x,y:integer;text:string);
+begin
+  if Font is TFPCustomDrawFont then
+    TFPCustomDrawFont(Font).DrawText(x,y, text)
+  else
+    DoTextOut (x,y, text);
+end;
+
+procedure TFPCustomCanvas.GetTextSize (text:string; var w,h:integer);
+begin
+  if Font is TFPCustomDrawFont then
+    TFPCustomDrawFont(Font).GetTextSize (text, w, h)
+  else
+    DoGetTextSize (Text, w, h);
+end;
+
+function TFPCustomCanvas.GetTextHeight (text:string) : integer;
+begin
+  if Font is TFPCustomDrawFont then
+    result := TFPCustomDrawFont(Font).GetTextHeight (text)
+  else
+    result := DoGetTextHeight (Text);
+end;
+
+function TFPCustomCanvas.GetTextWidth (text:string) : integer;
+begin
+  if Font is TFPCustomDrawFont then
+    result := TFPCustomDrawFont(Font).GetTextWidth (text)
+  else
+    result := DoGetTextWidth (Text);
+end;
+
+procedure TFPCustomCanvas.DoMoveTo (x,y:integer);
+begin
+end;
+
+procedure TFPCustomCanvas.DoLineTo (x,y:integer);
+begin
+  DoLine (FCurrent.X,FCurrent.y, x,y);
+end;
+
+procedure TFPCustomCanvas.MoveTo (x,y:integer);
+begin
+  FCurrent.x := x;
+  FCurrent.y := y;
+  DoMoveTo (x,y);
+end;
+
+procedure TFPCustomCanvas.MoveTo (p:TPoint);
+begin
+  FCurrent := p;
+  DoMoveTo (p.x,p.y);
+end;
+
+procedure TFPCustomCanvas.LineTo (x,y:integer);
+begin
+  if Pen.Style <> psClear then
+    if Pen is TFPCustomDrawPen then
+      TFPCustomDrawPen(Pen).DrawLine (FCurrent.x, FCurrent.y, x, y)
+    else
+      DoLineTo (x,y);
+  FCurrent.x := x;
+  FCurrent.y := y;
+end;
+
+procedure TFPCustomCanvas.LineTo (p:TPoint);
+begin
+  LineTo (p.x, p.y);
+end;
+
+procedure TFPCustomCanvas.Line (x1,y1,x2,y2:integer);
+begin
+  if Pen.Style <> psClear then
+    if Pen is TFPCustomDrawPen then
+      TFPCustomDrawPen(Pen).DrawLine (x1,y1, x2,y2)
+    else
+      DoLine (x1,y1, x2,y2);
+  FCurrent.x := x2;
+  FCurrent.y := y2;
+end;
+
+procedure TFPCustomCanvas.Line (p1,p2:TPoint);
+begin
+  Line (p1.x,p1.y,p2.x,p2.y);
+end;
+
+procedure TFPCustomCanvas.Line (points:TRect);
+begin
+  with points do
+    Line (left,top, right,bottom);
+end;
+
+procedure TFPCustomCanvas.Polyline (points:array of TPoint);
+begin
+  if Pen.Style <> psClear then
+   if Pen is TFPCustomDrawPen then
+     TFPCustomDrawPen(Pen).Polyline (points,false)
+   else
+     DoPolyline (points);
+  FCurrent := points[high(points)];
+end;
+
+procedure TFPCustomCanvas.Clear;
+var r : TRect;
+begin
+  if Brush.Style <> bsClear then
+    begin
+    if Brush is TFPCustomDrawBrush then
+      TFPCustomDrawBrush(Brush).Rectangle(0,0, width, height)
+    else
+      begin
+      r := Rect(0,0, width, height);
+      DoRectangleFill (r);
+      end;
+    end;
+end;
+
+procedure TFPCustomCanvas.DoRectangleAndFill (Bounds:TRect);
+begin
+  DoRectangleFill (Bounds);
+  DoRectangle (Bounds);
+end;
+
+procedure TFPCustomCanvas.DoEllipseAndFill (Bounds:TRect);
+begin
+  DoEllipseFill (Bounds);
+  DoEllipse (Bounds);
+end;
+
+procedure TFPCustomCanvas.DoPolygonAndFill (points:array of TPoint);
+begin
+  DoPolygonFill (points);
+  DoPolygon (points);
+end;
+
+procedure TFPCustomCanvas.Ellipse (Bounds:TRect);
+var p,b,dp,db,pb : boolean;
+begin
+  p := Pen.style <> psClear;
+  b := Brush.style <> bsClear;
+  if p and (Pen is TFPCustomDrawPen) then
+      begin
+      p := false;
+      dp := true;
+      end;
+  if b and (Brush is TFPCustomDrawBrush) then
+      begin
+      b := false;
+      db := true;
+      end;
+  if p and b then
+    begin
+    p := false;
+    b := false;
+    pb := true;
+    end;
+  if pb then
+    DoEllipseAndFill (bounds)
+  else
+    begin
+    if p then
+      DoEllipse (bounds)
+    else
+      with bounds do
+        TFPCustomDrawPen(Pen).Ellipse (left,top,right,bottom);
+    if b then
+      DoEllipseFill (bounds)
+    else
+      with bounds do
+        TFPCustomDrawBrush(Brush).Ellipse (left,top,right,bottom);
+    end;
+end;
+
+procedure TFPCustomCanvas.Ellipse (left,top,right,bottom:integer);
+var b : TRect;
+begin
+  Ellipse (Rect(left,top,right,bottom));
+end;
+
+procedure TFPCustomCanvas.Rectangle (left,top,right,bottom:integer);
+begin
+  Rectangle (Rect(left,top,right,bottom));
+end;
+
+procedure TFPCustomCanvas.Rectangle (Bounds:TRect);
+var p,b,dp,db,pb : boolean;
+begin
+  p := Pen.style <> psClear;
+  b := Brush.style <> bsClear;
+  if p and (pen is TFPCustomDrawPen) then
+      begin
+      p := false;
+      dp := true;
+      end;
+  if b and (brush is TFPCustomDrawBrush) then
+      begin
+      b := false;
+      db := true;
+      end;
+  if p and b then
+    begin
+    p := false;
+    b := false;
+    pb := true;
+    end;
+  if pb then
+    DoRectangleAndFill (bounds)
+  else
+    begin
+    if p then
+      DoRectangle (bounds)
+    else
+      with bounds do
+        TFPCustomDrawPen(Pen).Rectangle (left,top,right,bottom);
+    if b then
+      DoRectangleFill (bounds)
+    else
+      with bounds do
+        TFPCustomDrawBrush(Brush).Rectangle (left,top,right,bottom);
+    end;
+end;
+
+procedure TFPCustomCanvas.FloodFill (x,y:integer);
+begin
+  if Brush.Style <> bsClear then
+    begin
+    if Brush is TFPCustomDrawBrush then
+      TFPCustomDrawBrush (Brush).FloodFill (x,y)
+    else
+      DoFloodFill (x,y); 
+    end;
+end;
+
+procedure TFPCustomCanvas.Polygon (points:array of TPoint);
+var p,b,dp,db,pb : boolean;
+begin
+  p := Pen.style <> psClear;
+  b := Brush.style <> bsClear;
+  if p and (pen is TFPCustomDrawPen) then
+      begin
+      p := false;
+      dp := true;
+      end;
+  if b and (brush is TFPCustomDrawBrush) then
+      begin
+      b := false;
+      db := true;
+      end;
+  if p and b then
+    begin
+    p := false;
+    b := false;
+    pb := true;
+    end;
+  if pb then
+    DoPolygonAndFill (points)
+  else
+    begin
+    if p then
+      DoPolygon (points)
+    else
+      TFPCustomDrawPen(Pen).Polyline (points, true);
+    if b then
+      DoPolygonFill (points)
+    else
+      TFPCustomDrawBrush(Brush).Polygon (points);
+    end;
+end;
+
+procedure TFPCustomCanvas.CopyRect (x,y:integer; canvas:TFPCustomCanvas; SourceRect:TRect);
+var xx,r,t : integer;
+begin
+  SortRect (SourceRect);
+  with SourceRect do
+    for r := left to right do
+      begin
+      xx := r - left + x; 
+      for t := bottom to top do
+        colors[xx,(t - bottom + y)] := canvas.colors[r,t];
+      end;
+end;
+
+procedure TFPCustomCanvas.Draw (x,y:integer; image:TFPCustomImage);
+var xx,xi,yi,xm,ym,r,t : integer;
+begin
+  xm := x + image.width-1;
+  if xm >= width then
+    xm := width - 1;
+  ym := y + image.height-1;
+  if ym >= height then
+    ym := height - 1;
+  xi := x;
+  yi := y;
+  if clipping then
+    CheckRectClipping (ClipRect, xi,yi, xm,ym);
+  for r := xi to xm do
+    begin
+    xx := r - x;
+    for t := yi to ym do
+      colors [r,t] := image.colors[xx,t-y];
+    end;
+end;
+
+

fcl/image/fpcanvas.pp

@@ -0,0 +1,296 @@
+{$mode objfpc}{$h+}
+unit FPCanvas;
+
+interface
+
+uses sysutils, classes, FPImage;
+
+type
+
+  TFPCanvasException = class (Exception);
+  TFPPenException = class (TFPCanvasException);
+  TFPBrushException = class (TFPCanvasException);
+  TFPFontException = class (TFPCanvasException);
+
+  TFPCustomCanvas = class;
+
+  TFPCanvasHelper = class
+  private
+    FColor : TFPColor;
+    FAllocated,
+    FFixedCanvas : boolean;
+    FCanvas : TFPCustomCanvas;
+    FFlags : word;
+    function GetAllocated : boolean;
+    procedure NotifyCanvas;
+  protected
+    // flags 0-15 are reserved for FPCustomCanvas
+    procedure SetFlags (index:integer; AValue:boolean);
+    function GetFlags (index:integer) : boolean;
+    procedure CheckAllocated (ValueNeeded:boolean);
+    procedure SetFixedCanvas (AValue : boolean);
+    procedure DoAllocateResources; virtual;
+    procedure DoDeAllocateResources; virtual;
+    procedure DoCopyProps (From:TFPCanvasHelper); virtual;
+    procedure SetColor (AValue:TFPColor); virtual;
+  public
+    constructor Create; virtual;
+    destructor destroy; override;
+    // prepare helper for use
+    procedure AllocateResources (ACanvas : TFPCustomCanvas);
+    // free all resource used bby this helper
+    procedure DeallocateResources;
+    property Allocated : boolean read GetAllocated;
+    // properties cannot be changed when allocated
+    property FixedCanvas : boolean read FFixedCanvas;
+    // Canvas for which the helper is allocated
+    property Canvas : TFPCustomCanvas read FCanvas;
+    // color of the helper
+    property Color : TFPColor read FColor Write SetColor;
+  end;
+
+  TFPCustomFont = class (TFPCanvasHelper)
+  private
+    FName : string;
+    FSize : integer;
+  protected
+    procedure DoCopyProps (From:TFPCanvasHelper); override;
+    procedure SetName (AValue:string); virtual;
+    procedure SetSize (AValue:integer); virtual;
+  public
+    function CopyFont : TFPCustomFont;
+    // Creates a copy of the font with all properties the same, but not allocated
+    procedure GetTextSize (text:string; var w,h:integer);
+    function GetTextHeight (text:string) : integer;
+    function GetTextWidth (text:string) : integer;
+    property Name : string read FName write SetName;
+    property Size : integer read FSize write SetSize;
+    property Bold : boolean index 5 read GetFlags write SetFlags;
+    property Italic : boolean index 6 read GetFlags write SetFlags;
+    property Underline : boolean index 7 read GetFlags write SetFlags;
+    property StrikeTrough : boolean index 8 read GetFlags write SetFlags;
+  end;
+  TFPCustomFontClass = class of TFPCustomFont;
+
+  TFPPenStyle = (psClear, psSolid, psDash, psDot, psDashDot, psDashDotDot, psPattern);
+  TFPPenStyleSet = set of TFPPenStyle;
+  TFPPenMode = (pmCopy, pmAnd, pmOr, pmXor);
+
+  TFPCustomPen = class (TFPCanvasHelper)
+  private
+    FStyle : TFPPenStyle;
+    FWidth : byte;
+    FMode : TFPPenMode;
+    FPattern : longword;
+  protected
+    procedure DoCopyProps (From:TFPCanvasHelper); override;
+    procedure SetMode (AValue : TFPPenMode); virtual;
+    procedure SetWidth (AValue : byte); virtual;
+    procedure SetStyle (AValue : TFPPenStyle); virtual;
+    procedure SetPattern (AValue : longword); virtual;
+  public
+    function CopyPen : TFPCustomPen;
+    // Creates a copy of the font with all properties the same, but not allocated
+    property Style : TFPPenStyle read FStyle write SetStyle;
+    property Width : byte read FWidth write SetWidth;
+    property Mode : TFPPenMode read FMode write SetMode;
+    property Pattern : longword read FPattern write SetPattern;
+  end;
+  TFPCustomPenClass = class of TFPCustomPen;
+
+  TFPBrushStyle = (bsClear, bsSolid, bsDiagonal, bsFDiagonal, bsCross,bsDiagCross,
+                   bsHorizontal, bsVertical, bsImage, bsPattern);
+
+  TFPCustomBrush = class (TFPCanvasHelper)
+  private
+    FStyle : TFPBrushStyle;
+    FImage : TFPCustomImage;
+  protected
+    procedure SetStyle (AValue : TFPBrushStyle); virtual;
+    procedure SetImage (AValue : TFPCustomImage); virtual;
+    procedure DoCopyProps (From:TFPCanvasHelper); override;
+  public
+    function CopyBrush : TFPCustomBrush;
+    property Style : TFPBrushStyle read FStyle write SetStyle;
+    property Image : TFPCustomImage read FImage write SetImage;
+  end;
+  TFPCustomBrushClass = class of TFPCustomBrush;
+
+  TFPCustomCanvas = class
+  private
+    FClipping,
+    FRemovingHelpers : boolean;
+    FDefaultFont,
+    FFont : TFPCustomFont;
+    FDefaultBrush,
+    FBrush : TFPCustomBrush;
+    FDefaultPen,
+    FPen : TFPCustomPen;
+    FCurrent : TPoint;
+    FClipRect : TRect;
+    FHelpers : TList;
+    FLocks : integer;
+    function AllowFont (AFont : TFPCustomFont) : boolean;
+    function AllowBrush (ABrush : TFPCustomBrush) : boolean;
+    function AllowPen (APen : TFPCustomPen) : boolean;
+    function CreateDefaultFont : TFPCustomFont;
+    function CreateDefaultPen : TFPCustomPen;
+    function CreateDefaultBrush : TFPCustomBrush;
+    procedure RemoveHelpers;
+    function GetFont : TFPCustomFont;
+    function GetBrush : TFPCustomBrush;
+    function GetPen : TFPCustomPen;
+  protected
+    function DoCreateDefaultFont : TFPCustomFont; virtual; abstract;
+    function DoCreateDefaultPen : TFPCustomPen; virtual; abstract;
+    function DoCreateDefaultBrush : TFPCustomBrush; virtual; abstract;
+    procedure SetFont (AValue:TFPCustomFont); virtual;
+    procedure SetBrush (AValue:TFPCustomBrush); virtual;
+    procedure SetPen (AValue:TFPCustomPen); virtual;
+    function  DoAllowFont (AFont : TFPCustomFont) : boolean; virtual;
+    function  DoAllowPen (APen : TFPCustomPen) : boolean; virtual;
+    function  DoAllowBrush (ABrush : TFPCustomBrush) : boolean; virtual;
+    procedure SetColor (x,y:integer; Value:TFPColor); Virtual; abstract;
+    function  GetColor (x,y:integer) : TFPColor; Virtual; abstract;    procedure SetHeight (AValue : integer); virtual; abstract;
+    function  GetHeight : integer; virtual; abstract;
+    procedure SetWidth (AValue : integer); virtual; abstract;
+    function  GetWidth : integer; virtual; abstract;
+    procedure DoLockCanvas; virtual;
+    procedure DoUnlockCanvas; virtual;
+    procedure DoTextOut (x,y:integer;text:string); virtual; abstract;
+    procedure DoGetTextSize (text:string; var w,h:integer); virtual; abstract;
+    function  DoGetTextHeight (text:string) : integer; virtual; abstract;
+    function  DoGetTextWidth (text:string) : integer; virtual; abstract;
+    procedure DoRectangle (Bounds:TRect); virtual; abstract;
+    procedure DoRectangleFill (Bounds:TRect); virtual; abstract;
+    procedure DoRectangleAndFill (Bounds:TRect); virtual;
+    procedure DoEllipseFill (Bounds:TRect); virtual; abstract;
+    procedure DoEllipse (Bounds:TRect); virtual; abstract;
+    procedure DoEllipseAndFill (Bounds:TRect); virtual;
+    procedure DoPolygonFill (points:array of TPoint); virtual; abstract;
+    procedure DoPolygon (points:array of TPoint); virtual; abstract;
+    procedure DoPolygonAndFill (points:array of TPoint); virtual;
+    procedure DoPolyline (points:array of TPoint); virtual; abstract;
+    procedure DoFloodFill (x,y:integer); virtual; abstract;
+    procedure DoMoveTo (x,y:integer); virtual;
+    procedure DoLineTo (x,y:integer); virtual;
+    procedure DoLine (x1,y1,x2,y2:integer); virtual; abstract;
+    procedure DoCopyRect (x,y:integer; canvas:TFPCustomCanvas; SourceRect:TRect); virtual; abstract;
+    procedure DoDraw (x,y:integer; image:TFPCustomImage); virtual; abstract;
+    procedure CheckHelper (AHelper:TFPCanvasHelper); virtual;
+    procedure AddHelper (AHelper:TFPCanvasHelper);
+  public
+    constructor create;
+    destructor destroy; override;
+    procedure LockCanvas;
+    procedure UnlockCanvas;
+    function CreateFont : TFPCustomFont;
+    function CreatePen : TFPCustomPen;
+    function CreateBrush : TFPCustomBrush;
+    // using font
+    procedure TextOut (x,y:integer;text:string);
+    procedure GetTextSize (text:string; var w,h:integer);
+    function GetTextHeight (text:string) : integer;
+    function GetTextWidth (text:string) : integer;
+    // using pen and brush
+    procedure Ellipse (Bounds:TRect);
+    procedure Ellipse (left,top,right,bottom:integer);
+    procedure Polygon (points:array of TPoint);
+    procedure Polyline (points:array of TPoint);
+    procedure Rectangle (Bounds:TRect);
+    procedure Rectangle (left,top,right,bottom:integer);
+    // using brush
+    procedure FloodFill (x,y:integer);
+    procedure Clear;
+    // using pen
+    procedure MoveTo (x,y:integer);
+    procedure MoveTo (p:TPoint);
+    procedure LineTo (x,y:integer);
+    procedure LineTo (p:TPoint);
+    procedure Line (x1,y1,x2,y2:integer);
+    procedure Line (p1,p2:TPoint);
+    procedure Line (points:TRect);
+    // other procedures
+    procedure CopyRect (x,y:integer; canvas:TFPCustomCanvas; SourceRect:TRect);
+    procedure Draw (x,y:integer; image:TFPCustomImage);
+    // properties
+    property Font : TFPCustomFont read GetFont write SetFont;
+    property Pen : TFPCustomPen read GetPen write SetPen;
+    property Brush : TFPCustomBrush read GetBrush write SetBrush;
+    property Colors [x,y:integer] : TFPColor read GetColor write SetColor;
+    property ClipRect : TRect read FClipRect write FClipRect;
+    property Clipping : boolean read FClipping write FClipping;
+    property PenPos : TPoint read FCurrent write FCurrent;
+    property Height : integer read GetHeight write SetHeight;
+    property Width : integer read GetWidth write SetWidth;
+  end;
+
+  TFPCustomDrawFont = class (TFPCustomFont)
+  private
+    procedure DrawText (x,y:integer; text:string);
+    procedure GetTextSize (text:string; var w,h:integer);
+    function GetTextHeight (text:string) : integer;
+    function GetTextWidth (text:string) : integer;
+  protected
+    procedure DoDrawText (x,y:integer; text:string); virtual; abstract;
+    procedure DoGetTextSize (text:string; var w,h:integer); virtual; abstract;
+    function DoGetTextHeight (text:string) : integer; virtual; abstract;
+    function DoGetTextWidth (text:string) : integer; virtual; abstract;
+  end;
+
+  TFPEmptyFont = class (TFPCustomFont)
+  end;
+
+  TFPCustomDrawPen = class (TFPCustomPen)
+  private
+    procedure DrawLine (x1,y1,x2,y2:integer);
+    procedure Polyline (points:array of TPoint; close:boolean);
+    procedure Ellipse (left,top, right,bottom:integer);
+    procedure Rectangle (left,top, right,bottom:integer);
+  protected
+    procedure DoDrawLine (x1,y1,x2,y2:integer); virtual; abstract;
+    procedure DoPolyline (points:array of TPoint; close:boolean); virtual; abstract;
+    procedure DoEllipse (left,top, right,bottom:integer); virtual; abstract;
+    procedure DoRectangle (left,top, right,bottom:integer); virtual; abstract;
+  end;
+
+  TFPEmptyPen = class (TFPCustomPen)
+  end;
+
+  TFPCustomDrawBrush = class (TFPCustomBrush)
+  private
+    procedure Rectangle (left,top, right,bottom:integer);
+    procedure FloodFill (x,y:integer);
+    procedure Ellipse (left,top, right,bottom:integer);
+    procedure Polygon (points:array of TPoint);
+  public
+    procedure DoRectangle (left,top, right,bottom:integer); virtual; abstract;
+    procedure DoEllipse (left,top, right,bottom:integer); virtual; abstract;
+    procedure DoFloodFill (x,y:integer); virtual; abstract;
+    procedure DoPolygon (points:array of TPoint); virtual; abstract;
+  end;
+
+  TFPEmptyBrush = class (TFPCustomBrush)
+  end;
+
+implementation
+
+uses clipping;
+
+const
+  EFont = 'Font';
+  EPen = 'Pen';
+  EBrush = 'Brush';
+  ErrAllocation = '%s %s be allocated.';
+  ErrAlloc : array [boolean] of string = ('may not','must');
+  ErrCouldNotCreate = 'Could not create a %s.';
+  ErrNoLock = 'Canvas not locked.';
+
+{$i FPHelper.inc}
+{$i FPFont.inc}
+{$i FPPen.inc}
+{$i FPBrush.inc}
+{$i FPCanvas.inc}
+{$i FPCDrawH.inc}
+
+end.

fcl/image/fpcdrawh.inc

@@ -0,0 +1,65 @@
+{ TFPCustomDrawPen }
+
+procedure TFPCustomDrawPen.DrawLine (x1,y1,x2,y2:integer);
+begin
+  DoDrawLine (x1,y1,x2,y2);
+end;
+
+procedure TFPCustomDrawPen.Polyline (points:array of TPoint; close:boolean);
+begin
+  DoPolyLine (points, false);
+end;
+
+procedure TFPCustomDrawPen.Ellipse (left,top, right,bottom:integer);
+begin
+  DoEllipse (left,top,right,bottom);
+end;
+
+procedure TFPCustomDrawPen.Rectangle (left,top, right,bottom:integer);
+begin
+  DoRectangle (left,top,right,bottom);
+end;
+
+{ TFPCustomDrawBrush }
+
+procedure TFPCustomDrawBrush.Rectangle (left,top,right,bottom:integer);
+begin
+  DoRectangle (left,top,right,bottom);
+end;
+
+procedure TFPCustomDrawBrush.FloodFill (x,y:integer);
+begin
+  DoFloodFill (x,y);
+end;
+
+procedure TFPCustomDrawBrush.Ellipse (left,top, right,bottom:integer);
+begin
+  DoEllipse (left,top,right,bottom);
+end;
+
+procedure TFPCustomDrawBrush.Polygon (points:array of TPoint);
+begin
+  DoPolygon (points);
+end;
+
+{ TFPCustomDrawFont }
+
+procedure TFPCustomDrawFont.DrawText (x,y:integer; text:string);
+begin
+  DoDrawText (x,y, text);
+end;
+
+procedure TFPCustomDrawFont.GetTextSize (text:string; var w,h:integer);
+begin
+  DoGetTextSize (text, w,h);
+end;
+
+function TFPCustomDrawFont.GetTextHeight (text:string) : integer;
+begin
+  result := DoGetTextHeight (Text);
+end;
+
+function TFPCustomDrawFont.GetTextWidth (text:string) : integer;
+begin
+  result := DoGetTextWidth (Text);
+end;

fcl/image/fpfont.inc

@@ -0,0 +1,53 @@
+{ FPCustomFont }
+
+procedure TFPCustomFont.SetName (AValue:string);
+begin
+  FName := AValue;
+end;
+
+procedure TFPCustomFont.SetSize (AValue:integer);
+begin
+  FSize := AValue;
+end;
+
+procedure TFPCustomFont.DoCopyProps (From:TFPCanvasHelper);
+begin
+  with from as TFPCustomFont do
+    begin
+    self.FName := FName;
+    self.FSize := FSize;
+    self.FColor := FColor;
+    self.FFlags := FFlags;
+    end;
+end;
+
+function TFPCustomFont.CopyFont : TFPCustomFont;
+begin
+  result := TFPCustomFont(self.ClassType.Create);
+  result.DoCopyProps (self);
+end;
+
+procedure TFPCustomFont.GetTextSize (text:string; var w,h:integer);
+begin
+  if inheritsFrom (TFPCustomDrawFont) then
+    TFPCustomDrawFont(self).DoGetTextSize (text,w,h)
+  else
+    FCanvas.DoGetTextSize (text, w,h);
+end;
+
+function TFPCustomFont.GetTextHeight (text:string) : integer;
+begin
+  if inheritsFrom (TFPCustomDrawFont) then
+    result := TFPCustomDrawFont(self).DoGetTextHeight (text)
+  else
+    result := FCanvas.GetTextHeight (text);
+end;
+
+function TFPCustomFont.GetTextWidth (text:string) : integer;
+begin
+  if inheritsFrom (TFPCustomDrawFont) then
+    result := TFPCustomDrawFont(self).DoGetTextWidth (text)
+  else
+    result := FCanvas.GetTextWidth (text);
+end;
+

fcl/image/fphelper.inc

@@ -0,0 +1,100 @@
+{ TFPCanvasHelper }
+
+constructor TFPCanvasHelper.Create;
+begin
+  inherited create;
+  FCanvas := nil;
+  FFixedCanvas := false;
+  FAllocated := false;
+end;
+
+destructor TFPCanvasHelper.destroy;
+begin
+  if Allocated then
+    DeAllocateResources;
+  inherited;
+end;
+
+procedure TFPCanvasHelper.SetFixedCanvas (AValue : boolean);
+begin
+  FFixedCanvas := AValue;
+end;
+
+procedure TFPCanvasHelper.NotifyCanvas;
+begin
+  FCanvas.CheckHelper (self);
+end;
+
+procedure TFPCanvasHelper.CheckAllocated (ValueNeeded:boolean);
+begin
+  if (Allocated <> ValueNeeded) then
+    Raise TFPFontException.CreateFmt (ErrAllocation, [EFont, ErrAlloc[ValueNeeded]]);
+end;
+
+procedure TFPCanvasHelper.SetColor (AValue:TFPColor);
+begin
+  FColor := AValue;
+end;
+
+procedure TFPCanvasHelper.SetFlags (index:integer; AValue:boolean);
+begin
+  if AValue then
+    FFlags := FFlags or (1 shl index)
+  else
+    FFlags := FFlags and not (1 shl index);
+end;
+
+function TFPCanvasHelper.GetFlags (index:integer) : boolean;
+begin
+  result := (FFlags and (1 shl index)) <> 0;
+end;
+
+function TFPCanvasHelper.GetAllocated : boolean;
+begin
+  if FFixedCanvas then
+    result := assigned(FCanvas)
+  else
+    result := FAllocated;
+end;
+
+procedure TFPCanvasHelper.AllocateResources (ACanvas : TFPCustomCanvas);
+begin
+  if FFixedCanvas and FAllocated then
+    DeallocateResources;
+  try
+    FCanvas := ACanvas;
+    DoAllocateResources;
+    FAllocated := True;
+  except
+    FCanvas := nil;
+    FAllocated := False;
+  end;
+end;
+
+procedure TFPCanvasHelper.DeallocateResources;
+begin
+  if FAllocated then
+    try
+      DoDeallocateResources;
+    finally
+      FAllocated := false;
+      NotifyCanvas;
+      FCanvas := nil;
+    end;
+end;
+
+procedure TFPCanvasHelper.DoCopyProps (From:TFPCanvasHelper);
+begin
+  FCanvas := nil;
+  color := from.color;
+end;
+
+procedure TFPCanvasHelper.DoAllocateResources;
+begin
+end;
+
+procedure TFPCanvasHelper.DoDeallocateResources;
+begin
+end;
+
+

fcl/image/fpimgcanv.pp

@@ -0,0 +1,72 @@
+{$mode objfpc}{$h+}
+unit FPImgCanv;
+
+interface
+
+uses FPPixlCanv, FPImage, classes;
+
+type
+  TFPImageCanvas = class (TFPPixelCanvas)
+  private
+    FImage : TFPCustomImage;
+  protected
+    procedure SetColor (x,y:integer; AValue:TFPColor); override;
+    function  GetColor (x,y:integer) : TFPColor; override;
+    procedure SetHeight (AValue : integer); override;
+    function  GetHeight : integer; override;
+    procedure SetWidth (AValue : integer); override;
+    function  GetWidth : integer; override;
+  public
+    constructor create (AnImage : TFPCustomImage);
+    destructor destroy; override;
+    property Image : TFPCustomImage read FImage write FImage;
+  end;
+
+implementation
+
+constructor TFPImageCanvas.create (AnImage : TFPCustomImage);
+begin
+  inherited Create;
+  FImage := AnImage;
+end;
+
+destructor TFPImageCanvas.destroy;
+begin
+  inherited destroy;
+end;
+
+procedure TFPImageCanvas.SetColor (x,y:integer; AValue:TFPColor);
+begin
+  if (x >= 0) and (x < width) and (y >= 0) and (y < height) then
+    FImage.Colors[x,y] := AValue;
+end;
+
+function  TFPImageCanvas.GetColor (x,y:integer) : TFPColor;
+begin
+  if (x >= 0) and (x < width) and (y >= 0) and (y < height) then
+    result := FImage.Colors[x,y]
+  else
+    result := colTransparent;
+end;
+
+procedure TFPImageCanvas.SetHeight (AValue : integer);
+begin
+  FImage.Height := AValue;
+end;
+
+function  TFPImageCanvas.GetHeight : integer;
+begin
+  result := FImage.Height;
+end;
+
+procedure TFPImageCanvas.SetWidth (AValue : integer);
+begin
+  FImage.Width := AValue;
+end;
+
+function  TFPImageCanvas.GetWidth : integer;
+begin
+  result := FImage.Width;
+end;
+
+end.

fcl/image/fppen.inc

@@ -0,0 +1,44 @@
+{ TFPCustomPen }
+
+procedure TFPCustomPen.SetMode (AValue : TFPPenMode);
+begin
+  FMode := AValue;
+end;
+
+procedure TFPCustomPen.SetWidth (AValue : byte);
+begin
+  if AValue < 1 then
+    FWidth := 1
+  else
+    FWidth := AValue;
+end;
+
+procedure TFPCustomPen.SetStyle (AValue : TFPPenStyle);
+begin
+  FStyle := AValue;
+end;
+
+procedure TFPCustomPen.SetPattern (AValue : longword);
+begin
+  FPattern := AValue;
+end;
+
+procedure TFPCustomPen.DoCopyProps (From:TFPCanvasHelper);
+begin
+  with From as TFPCustomPen do
+    begin
+    self.Style := Style;
+    self.Width := Width;
+    self.Mode := Mode;
+    self.pattern := pattern;
+    end;
+  inherited;
+end;
+
+function TFPCustomPen.CopyPen : TFPCustomPen;
+begin
+  result := TFPCustomPen(self.ClassType.Create);
+  result.DoCopyProps (self);
+end;
+
+

fcl/image/fppixlcanv.pp

@@ -0,0 +1,242 @@
+{$mode objfpc}{$h+}
+unit FPPixlCanv;
+
+interface
+
+uses classes, FPImage, FPCanvas, PixTools;
+
+type
+
+  { need still to be implemented :
+    GetColor / SetColor
+    Get/Set Width/Height
+  }
+
+  PixelCanvasException = class (TFPCanvasException);
+
+  TFPPixelCanvas = class (TFPCustomCanvas)
+  protected
+    function DoCreateDefaultFont : TFPCustomFont; override;
+    function DoCreateDefaultPen : TFPCustomPen; override;
+    function DoCreateDefaultBrush : TFPCustomBrush; override;
+    procedure DoTextOut (x,y:integer;text:string); override;
+    procedure DoGetTextSize (text:string; var w,h:integer); override;
+    function  DoGetTextHeight (text:string) : integer; override;
+    function  DoGetTextWidth (text:string) : integer; override;
+    procedure DoRectangle (Bounds:TRect); override;
+    procedure DoRectangleFill (Bounds:TRect); override;
+    procedure DoEllipseFill (Bounds:TRect); override;
+    procedure DoEllipse (Bounds:TRect); override;
+    procedure DoPolygonFill (points:array of TPoint); override;
+    procedure DoPolygon (points:array of TPoint); override;
+    procedure DoPolyline (points:array of TPoint); override;
+    procedure DoFloodFill (x,y:integer); override;
+    procedure DoLine (x1,y1,x2,y2:integer); override;
+  end;
+
+implementation
+
+uses Clipping;
+
+const
+  ErrNotAvailable = 'Not availlable';
+
+procedure NotImplemented;
+begin
+  raise PixelCanvasException.Create(ErrNotAvailable);
+end;
+
+function TFPPixelCanvas.DoCreateDefaultFont : TFPCustomFont;
+begin
+  result := TFPEmptyFont.Create;
+  with result do
+    begin
+    Size := 10;
+    Color := colBlack;
+    end;
+end;
+
+function TFPPixelCanvas.DoCreateDefaultPen : TFPCustomPen;
+begin
+  result := TFPEmptyPen.Create;
+  with result do
+    begin
+    Color := colBlack;
+    width := 1;
+    pattern := 0;
+    Style := psSolid;
+    Mode := pmCopy;
+    end;
+end;
+
+function TFPPixelCanvas.DoCreateDefaultBrush : TFPCustomBrush;
+begin
+  result := TFPEmptyBrush.Create;
+  with result do
+    begin
+    Style := bsClear;
+    end;
+end;
+
+procedure TFPPixelCanvas.DoTextOut (x,y:integer;text:string);
+begin
+  NotImplemented;
+end;
+
+procedure TFPPixelCanvas.DoGetTextSize (text:string; var w,h:integer);
+begin
+  NotImplemented;
+end;
+
+function  TFPPixelCanvas.DoGetTextHeight (text:string) : integer;
+begin
+  result := -1;
+  NotImplemented;
+end;
+
+function  TFPPixelCanvas.DoGetTextWidth (text:string) : integer;
+begin
+  result := -1;
+  NotImplemented;
+end;
+
+procedure TFPPixelCanvas.DoRectangle (Bounds:TRect);
+begin
+  if clipping then
+    CheckRectClipping (ClipRect, Bounds);
+  with Bounds do
+    begin
+    DoLine (left,top,left,bottom);
+    DoLine (left,bottom,right,bottom);
+    DoLine (right,bottom,right,top);
+    DoLine (right,top,left,top);
+    end;
+end;
+
+procedure TFPPixelCanvas.DoRectangleFill (Bounds:TRect);
+begin
+  writeln ('Rectangle Fill, sorting bounds');
+  SortRect (bounds);
+  writeln ('Checking clipping');
+  if clipping then
+    CheckRectClipping (ClipRect, Bounds);
+  writeln ('Choosing what to do');
+  with bounds do
+    case Brush.style of  //TODO: patterns and image
+      bsSolid : FillRectangleColor (self, left,top, right,bottom);
+      bsPattern : ;
+      bsImage : ;
+      bsDiagonal : ;
+      bsFDiagonal : ;
+      bsCross : ;
+      bsDiagCross : ;
+      bsHorizontal : ;
+      bsVertical : ;
+    end;
+  writeln ('Rectangle finished');
+end;
+
+procedure TFPPixelCanvas.DoEllipseFill (Bounds:TRect);
+begin  //TODO
+end;
+
+procedure TFPPixelCanvas.DoEllipse (Bounds:TRect);
+begin  //TODO
+end;
+
+procedure TFPPixelCanvas.DoPolygonFill (points:array of TPoint);
+begin  //TODO: how to find a point inside the polygon ?
+end;
+
+procedure TFPPixelCanvas.DoPolygon (points:array of TPoint);
+var i,a, r : integer;
+    p : TPoint;
+begin
+  i := low(points);
+  a := high(points);
+  p := points[i];
+  for r := i+1 to a do
+    begin
+    DoLine (p.x, p.y, points[r].x, points[r].y);
+    p := points[r];
+    end;
+  DoLine (p.x,p.y, points[i].x,points[i].y);
+end;
+
+procedure TFPPixelCanvas.DoPolyline (points:array of TPoint);
+var i,a, r : integer;
+    p : TPoint;
+begin
+  i := low(points);
+  a := high(points);
+  p := points[i];
+  for r := i+1 to a do
+    begin
+    DoLine (p.x, p.y, points[r].x, points[r].y);
+    p := points[r];
+    end;
+end;
+
+procedure TFPPixelCanvas.DoFloodFill (x,y:integer);
+begin    //TODO
+end;
+
+const
+  PenPatterns : array[psDash..psDashDotDot] of word =
+    ($EEEE, $AAAA, $E4E4, $EAEA);
+
+procedure TFPPixelCanvas.DoLine (x1,y1,x2,y2:integer);
+
+  procedure DrawOneLine (xx1,yy1, xx2,yy2:integer);
+  begin
+    if Clipping then
+      CheckLineClipping (ClipRect, xx1,yy1, xx2,yy2);
+    DrawSolidLine (self, xx1,yy1, xx2,yy2);
+  end;
+
+  procedure SolidThickLine;
+  var w1, w2, r : integer;
+      MoreHor : boolean;
+  begin
+    // determine lines above and under
+    w1 := pen.width div 2;
+    w2 := w1;
+    if w1+w2 = pen.width then
+      dec (w1);
+    // determine slanting
+    MoreHor := (abs(x2-x1) < abs(y2-y1));
+    if MoreHor then
+      begin  // add lines left/right
+      for r := 1 to w1 do
+        DrawOneLine (x1-r,y1, x2-r,y2);
+      for r := 1 to w2 do
+        DrawOneLine (x1+r,y1, x2+r,y2);
+      end
+    else
+      begin  // add lines above/under
+      for r := 1 to w1 do
+        DrawOneLine (x1,y1-r, x2,y2-r);
+      for r := 1 to w2 do
+        DrawOneLine (x1,y1+r, x2,y2+r);
+      end;
+  end;
+
+begin
+  if Clipping then
+    CheckLineClipping (ClipRect, x1,y1, x2,y2);
+  case Pen.style of
+    psSolid :
+      begin
+      DrawSolidLine (self, x1,y1, x2,y2);
+      if pen.width > 1 then
+        SolidThickLine;
+      end;
+    psPattern: ;
+      // DrawPatternLine (self, x1,y1, x2,y2, pattern);
+      // Patterned lines have width always at 1
+    psDash, psDot, psDashDot, psDashDotDot : ;
+      //DrawPatternLine (self, x1,y1, x2,y2, PenPattern[Style]);
+  end;
+end;
+
+end.

fcl/image/pixtools.pp

@@ -0,0 +1,185 @@
+{$mode objfpc}{$h+}
+unit PixTools;
+
+interface
+
+uses classes, FPCanvas, clipping, FPimage;
+
+procedure DrawSolidPolyline (Canv : TFPCustomCanvas; points:array of TPoint; close:boolean);
+procedure DrawSolidLine (Canv : TFPCustomCanvas; x1,y1, x2,y2:integer);
+procedure FillRectangleColor (Canv:TFPCustomCanvas; x1,y1, x2,y2:integer);
+procedure DrawPatternLine (Canv:TFPCustomCanvas; x1,y1, x2,y2:integer; pattern:word);
+
+implementation
+
+procedure FillRectangleColor (Canv:TFPCustomCanvas; x1,y1, x2,y2:integer);
+var x,y : integer;
+    c : TFPColor;
+begin
+  writeln ('FillREctangleColor, sorting rec');
+  SortRect (x1,y1, x2,y2);
+  with Canv do
+    begin
+    writeln ('FillRectangleColor(',x1,',',y1,', ',x2,',',y2);
+    c := brush.color;
+    for x := x1 to x2 do
+      for y := y1 to y2 do
+        colors[x,y] := c;
+    end;
+end;
+
+procedure DrawSolidPolyLine (Canv : TFPCustomCanvas; points:array of TPoint; close:boolean);
+var i,a, r : integer;
+    p : TPoint;
+begin
+  i := low(points);
+  a := high(points);
+  p := points[i];
+  with Canv do
+    begin
+    for r := i+1 to a do
+      begin
+      Line (p.x, p.y, points[r].x, points[r].y);
+      p := points[r];
+      end;
+    if close then
+      Line (p.x,p.y, points[i].x,points[i].y);
+    end;
+end;
+
+type
+  TPutPixelProc = procedure (Canv:TFPCustomCanvas; x,y:integer; color:TFPColor);
+
+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 DrawSolidLine (Canv : TFPCustomCanvas; x1,y1, x2,y2:integer);
+var PutPixelProc : TPutPixelProc;
+  procedure HorizontalLine (x1,x2,y:integer);
+    var x : integer;
+        c : TFPColor;
+    begin
+      c := Canv.pen.color;
+      for x := x1 to x2 do
+        PutPixelProc (Canv, x,y, c);
+    end;
+  procedure VerticalLine (x,y1,y2:integer);
+    var y : integer;
+        c : TFPColor;
+    begin
+      c := Canv.pen.color;
+      for y := y1 to y2 do
+        PutPixelProc (Canv, x,y, c);
+    end;
+  procedure SlopedLine;
+    var npixels,xinc1,yinc1,xinc2,yinc2,dx,dy,d,dinc1,dinc2 : integer;
+    procedure initialize;
+      begin // precalculations
+      dx := abs(x2-x1);
+      dy := abs(y2-y1);
+      if dx > dy then  // determining independent variable
+        begin  // x is independent
+        npixels := dx + 1;
+        d := (2 * dy) - dx;
+        dinc1 := dy * 2;
+        dinc2:= (dy - dx) * 2;
+        xinc1 := 1;
+        xinc2 := 1;
+        yinc1 := 0;
+        yinc2 := 1;
+        end
+      else
+        begin  // y is independent
+        npixels := dy + 1;
+        d := (2 * dx) - dy;
+        dinc1 := dx * 2;
+        dinc2:= (dx - dy) * 2;
+        xinc1 := 0;
+        xinc2 := 1;
+        yinc1 := 1;
+        yinc2 := 1;
+        end;
+      // going into the correct direction
+      if x1 > x2 then
+        begin
+        xinc1 := - xinc1;
+        xinc2 := - xinc2;
+        end;
+      if y1 > y2 then
+        begin
+        yinc1 := - yinc1;
+        yinc2 := - yinc2;
+        end;
+      end;
+    var r,x,y : integer;
+        c : TFPColor;
+    begin
+    initialize;
+    x := x1;
+    y := y1;
+    c := canv.pen.color;
+    for r := 1 to nPixels do
+      begin
+      PutPixelProc (Canv, x,y, c);
+      if d < 0 then
+        begin
+        d := d + dinc1;
+        x := x + xinc1;
+        y := y + yinc1;
+        end
+      else
+        begin
+        d := d + dinc2;
+        x := x + xinc2;
+        y := y + yinc2;
+        end;
+      end;
+    end;
+begin
+  with canv.pen do
+    case mode of
+      pmAnd : PutPixelProc := @PutPixelAnd;
+      pmOr : PutPixelProc := @PutPixelOr;
+      pmXor : PutPixelProc := @PutPixelXor;
+      else PutPixelProc := @PutPixelCopy;
+    end;
+  if x1 = x2 then  // vertical line
+    if y1 < y2 then
+      VerticalLine (x1, y1, y2)
+    else
+      VerticalLine (x1, y2, y1)
+  else if y1 = y2 then
+    if x1 < x2 then
+      HorizontalLine (x1, x2, y1)
+    else
+      HorizontalLine (x2, x1, y1)
+  else  // sloped line
+    SlopedLine;
+end;
+
+procedure DrawPatternLine (Canv:TFPCustomCanvas; x1,y1, x2,y2:integer; pattern:word);
+begin
+end;
+
+end.