Delphi 图形32使用阴影填充图案填充多边形

我正在尝试将delphi XE4应用程序转换为使用Graphics32库进行绘图，而不是使用标准的delphi绘图方法

我做的一件事是画一个图标，其中包含一个带有对角交叉图案的小椭圆。图标应如下所示：

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

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;

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

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;

以下是我如何使用标准的

TCanvas

绘图方法进行此操作：

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

我可以使用图形32绘制椭圆，并执行以下操作：

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

---

但是有没有一种简单的方法来复制对角线交叉图案填充图案？我假设我可以使用

tbitmappylogonfiller

类，但这是使用位图填充的。请注意，如果相关的话，此绘图是在它的

OnPaint

事件处理程序中的

TPositionedLayer

。

到目前为止，Graphics32中没有直接的模式支持，但是有几十种方法可以创建您想要使用的模式

下面是一个使用示例多边形填充的解决方案：

首先，您需要为阴影图案编写一个采样器类。有几种方法可以构建这样的采样器。下面是一个非常简单的例子：

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;

在这里，您只需要重写一个方法（GetSampleInt），所有其他方法都可以从祖先类中使用

现在有点纠结了。为了使用样本，您必须将其置于样本填充器顶部，如下所示：

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

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;

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

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;

一旦你有了这个填充符，你就可以在PolygonFS甚至多段线中使用它了

最后，代码可能如下所示：

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

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;

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

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;

这将在位图的中心绘制一个相当大的椭圆（这里是TPaintBox32实例的缓冲区），并用阴影填充的采样器代码填充它。最后，使用PolylineFS函数绘制实体轮廓

从性能角度来看，这并不是最快的方法，因为GetSampleInt是按像素调用的。然而，最容易理解发生了什么

为了更快的选择，你应该直接使用填充物。您可以直接从TCustomPolygonFiller派生如下：

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

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;

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

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;

其中GetFillLine方法变得非常简单：

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

但是，FillLine方法将更加复杂，如下所示：

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

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;

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

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;

---

由于DstY保持不变，您还可以重构代码以提高性能。或者，您可以使用汇编程序（SSE）来加速代码，但我想对于这样一个简单的函数来说，这可能有些过分。

我尝试了上述自定义填充，但结果出乎意料。U形多边形的两条腿之间的区域将被填充。任何关于我所做工作的意见都将不胜感激

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;