Graphics32 fill polygon with hatched pattern

Question

I am trying to convert a delphi XE4 application to use the Graphics32 libraries for drawing rather than the standard delphi drawing methods.

One thing I do is draw an icon that contains a small ellipse with diagonal cross hatch pattern. The icon should look like this:

Here is how I do it with standard TCanvas drawing methods:

ACanvas.Brush.Color := shape.pcolor;
ACanvas.Brush.Style := bsdiagCross;
ACanvas.Ellipse(-13, -9, 13, 9);

I can draw an ellipse with Graphics32 doing the following:

var    
  Polygon : TArrayOfFloatPoint;   
begin    
  Polygon := Ellipse(0, 0, 13, 9);
  PolylineFS(Bitmap, Polygon, pcolor, True, UAVPenWidth);

but is there an easy way to replicate the diagonal cross hatching pattern? I assume I can use TBitmapPolygonFiller class but this is to fill using a bitmap. Note that this drawing is to a TPositionedLayer in it's OnPaint event handler if that is relevant.

score 3 · Accepted Answer · answered Jul 27 '17 at 16:41

So far there is no direct pattern support in Graphics32, but there are dozens of ways to create patterns like the one you want to use.

Here's one solution using a sample polygon filler:

First you need to write a sampler class for the hatched pattern. There are several ways to build such a sampler. Below you can find a very simple one:

type
  THatchedPatternSampler = class(TCustomSampler)
  public
    function GetSampleInt(X, Y: Integer): TColor32; override;
  end;

function THatchedPatternSampler.GetSampleInt(X, Y: Integer): TColor32;
begin
  Result := 0;
  if ((X - Y) mod 8 = 0) or ((X + Y) mod 8 = 0) then
    Result := clRed32
end;

You only need to override one method here (GetSampleInt), all other methods can be used from the ancestor class.

Now it gets a little bit convolved. In order to use the sample you must use it on to top of a TSamplerFiller like this:

Sampler := THatchedPatternSampler.Create;
Filler := TSamplerFiller.Create(Sampler);

Once you have this filler you can use it in PolygonFS or even PolylineFS.

Finally the code may look like this:

var
  Polygon: TArrayOfFloatPoint;
  Sampler: THatchedPatternSampler;
  Filler: TSamplerFiller;
begin
  Polygon := Ellipse(128, 128, 120, 100);
  Sampler := THatchedPatternSampler.Create;
  try
    Filler := TSamplerFiller.Create(Sampler);
    try
      PolygonFS(PaintBox32.Buffer, Polygon, Filler);
    finally
      Filler.Free;
    end;
      finally
    Sampler.Free;
  end;

  PolylineFS(PaintBox32.Buffer, Polygon, clRed32, True, 1);
end;

This will draw a rather big ellipse to the center of a bitmap (here: the buffer of a TPaintBox32 instance) and fill it with the hatched sampler code. Finally a solid outline is drawn using the PolylineFS function.

From a performance perspective this isn't the fastest approach as GetSampleInt gets called per pixel. However, it's the easiest to understand what happens.

For a faster alternative you should directly use a filler directly. You can derive directly from TCustomPolygonFiller like this:

type
  THatchedPatternFiller = class(TCustomPolygonFiller)
  private
    procedure FillLine(Dst: PColor32; DstX, DstY, Length: Integer; AlphaValues: PColor32);
  protected
    function GetFillLine: TFillLineEvent; override;
  end;

where the method GetFillLine gets as simple as:

function THatchedPatternFiller.GetFillLine: TFillLineEvent;
begin
  Result := FillLine;
end;

However, the FillLine method will be a bit more complex like this:

procedure THatchedPatternFiller.FillLine(Dst: PColor32; DstX, DstY,
  Length: Integer; AlphaValues: PColor32);
var
  X: Integer;
begin
  for X := DstX to DstX + Length do
  begin
    if ((X - DstY) mod 8 = 0) or ((X + DstY) mod 8 = 0) then
      Dst^ :=clRed32
    else
      Dst^ := 0;

    Inc(Dst);
  end;
end;

Since DstY remains constant you could also refactor the code to improve the performance. Or you could speed up the code using assembler (SSE), but I guess this would be overkill for such a simple function.

score -1 · Answer 2 · answered Jun 28 '18 at 17:28

I tried the above described custom fill, but the results are unexpected. The area between the 2 legs of the U shaped polygon gets filled. Any input on what I'm doing wront would be greatly appreciated.

procedure TForm1.Button1Click(Sender: TObject);
var Filler2: THatchedPatternFiller;
    Polygon: TArrayOfFloatPoint;
begin
  polygon := [floatpoint(100, 10), floatpoint(200, 10), floatpoint(200, 400), floatpoint(300, 400), floatpoint(300, 10), floatpoint(400, 10), floatpoint(400, 500), floatpoint( 100, 500), floatpoint( 100, 10)]; // U shaped polygon
  filler2 := THatchedPatternFiller.Create;
  PolygonFS(PreviewImage.Bitmap, polygon, filler2);   // Wrong, red fill inside U share
  PolygonFS(PreviewImage.Bitmap, polygon, clGreen32); // Works fine, green fill
  Filler2.Free;
end;

Image with wrong fill, the red part should not be visible in the centre and on the right side

Graphics32 fill polygon with hatched pattern

2 Answers2