Delphi Graphics32在图层上绘制透明椭圆答案

【问题标题】：Delphi Graphics32 draw transparent ellipse on a layerDelphi Graphics32在图层上绘制透明椭圆
【发布时间】：2015-04-18 16:44:07
【问题描述】：

我希望能够在 ImgView32 的透明层上绘制一个空的椭圆。知道怎么做吗？到目前为止，我能想到的是：

 BL := TBitmapLayer.Create(ImgView.Layers);
    BL.Bitmap.DrawMode := dmTransparent;
    BL.Bitmap.SetSize(imwidth,imheight);
    BL.Bitmap.Canvas.Pen.Width := penwidth;
    BL.Bitmap.Canvas.Pen.Color := pencolor;
    BL.Location := GR32.FloatRect(0, 0, imwidth, imheight);
    BL.Scaled := False;
    BL.OnMouseDown := LayerMouseDown;
    BL.OnMouseUp := LayerMouseUp;
    BL.OnMouseMove := LayerMouseMove;
    BL.OnPaint := LayerOnPaint;

...
BL.Bitmap.Canvas.Pen.Color := clBlue;
BL.Bitmap.Canvas.MoveTo(FStartPoint.X, FStartPoint.Y);
BL.Bitmap.Canvas.Ellipse(FStartPoint.X, FStartPoint.Y,FEndPoint.X, FEndPoint.Y);

起点和终点在鼠标事件中获取。

我实际上是在尝试绘制一个动态椭圆（在鼠标事件上）。所以涉及到onMouseDown(LayerMouseDown)、onMouseUp(LayerMouseUp)和OnMouseMove(LayerMouseMove)事件。作为参考，请检查此question，它处理动态绘制一条线。我也想做同样的事情，但是用椭圆而不是直线。

所以我有 AddCircleToLayer 过程而不是 AddLineToLayer 事件现在看起来像这样：

procedure TForm5.SwapBuffers32;
begin
    TransparentBlt(
      BL.Bitmap.Canvas.Handle, 0, 0, BL.Bitmap.Width, BL.Bitmap.Height,
      bm32.Canvas.Handle, 0, 0, bm32.Width, bm32.Height, clWhite);
end;

procedure TForm5.ImgViewResize(Sender: TObject);
begin
  OffsX := (ImgView.ClientWidth - imwidth) div 2;
  OffsY := (ImgView.ClientHeight - imheight) div 2;
  BL.Location := GR32.FloatRect(OffsX, OffsY, imwidth+OffsX, imheight+OffsY);
end;

procedure TForm5.LayerMouseDown(Sender: TObject; Buttons: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  FStartPoint := Point(X-OffsX, Y-OffsY);
  FDrawingLine := true;
end;

procedure TForm5.LayerMouseMove(Sender: TObject; Shift: TShiftState; X,  Y: Integer);
begin
  if FDrawingLine then
  begin
    SwapBuffers32;
      if RadioGroup1.ItemIndex=0 then
      begin
        BL.Bitmap.Canvas.Pen.Color := pencolor;
        BL.Bitmap.Canvas.MoveTo(FStartPoint.X, FStartPoint.Y);
        BL.Bitmap.Canvas.LineTo(X-OffsX, Y-OffsY);
      end
      else
      begin
        BL.Bitmap.Canvas.Pen.Color := pencolor;
        BL.Bitmap.Canvas.MoveTo(FStartPoint.X, FStartPoint.Y);
        SwapBuffers32;
        BL.Bitmap.Canvas.Ellipse(FStartPoint.X, FStartPoint.Y,X-OffsX, Y-OffsY);
      end;
  end;
end;

procedure TForm5.LayerMouseUp(Sender: TObject; Buttons: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
      if RadioGroup1.ItemIndex=0 then
      begin
        FDrawingLine := false;
        FEndPoint := Point(X-OffsX, Y-OffsY);
        AddLineToLayer;
        SwapBuffers32;
      end
      else
      begin
        FDrawingLine := false;
        FEndPoint := Point(X-OffsX, Y-OffsY);
        AddCircleToLayer;
        SwapBuffers32;
      end
end;

procedure TForm5.LayerOnPaint(Sender: TObject; Buffer: TBitmap32);
begin
  SwapBuffers32;
end;

procedure TForm5.AddLineToLayer;
begin
  bm32.Canvas.Pen.Color := pencolor;
  bm32.Canvas.Pen.Width := penwidth;
  bm32.Canvas.MoveTo(FStartPoint.X, FStartPoint.Y);
  bm32.Canvas.LineTo(FEndPoint.X, FEndPoint.Y);
end;

procedure TForm5.AddCircleToLayer;
begin
  bm32.Canvas.Pen.Color := pencolor;
  bm32.Canvas.Pen.Width := penwidth;
  bm32.Canvas.MoveTo(FStartPoint.X, FStartPoint.Y);
  bm32.Canvas.Ellipse(FStartPoint.X, FStartPoint.Y,FEndPoint.X, FEndPoint.Y);
  SwapBuffers32;
end;

但是当我使用这段代码时，圆圈（椭圆）被白色填充（就像这张图片一样）直到我开始绘制下一个椭圆（所以 onMouseMove 和 onMouseUp 椭圆被填充）。只有当我再做一次 onMouseDown 时，前一个圆圈才会被清空，但新的椭圆也被白色填充（就像这张图片一样）

此外，如果您尝试一个接一个地做更多的椭圆，并且在旧的顶部之上，您会注意到会有 onMouseMove 椭圆的痕迹，如下图所示：

所以这段代码一定有我遗漏的东西。

请帮我解决这个问题。

【问题讨论】：

其实答案很简单...在绘制椭圆之前将brush.Color设置为0...它使椭圆为空。非常简单:)
将 Brush.Color 设置为 0 实际上会将其设置为黑色。不过，将 Brush.Style 设置为 bsClear 应该可以解决问题。
你试过Brush.Style := bsClear吗？

标签： delphi delphi-xe graphics32

【解决方案1】：

如果您使用的是行李箱中最新的 GR32 代码，您也可以使用此代码 sn-p 来定义椭圆

Points := Ellipse(Center.X, Center.Y, Radius.X, Radius.Y);

甚至更简单

Points := Ellipse(Center, Radius);

Points 定义为

Points: TArrayOfFloatPoint;

这会生成一个椭圆的多边形，其中心为Center，独立的 x 和 y 相关半径由Radius 定义。

获得多边形后，您可以使用任何矢量渲染器对其进行渲染。例如，您可以使用内置的 VPR 渲染器与

PolygonFS(Bitmap, Points, SomeColor32);

渲染一个填充的椭圆。

但是，如果您只想渲染帧，您可以使用它

PolylineFS(Bitmap, Points, AnotherColor32, True, PenWidth);

这个参数是

Bitmap = 渲染到的 TBitmap32 实例
Points = 多边形点（如上定义）
AnotherColor32 = 颜色，用于渲染
True = 闭合多边形（否则您的椭圆将在起点和终点之间有间隙
PenWidth = 框架宽度

如果你喜欢，你也可以在一个调用中渲染它

PolylineFS(Bitmap, Ellipse(Center, Radius), AnotherColor32, True, PenWidth);

为了获得任意（旋转的）椭圆，您需要在渲染之前转换多边形。你可以使用

TransformPolygon(Points, Transformation);

为此，它获取TTransformation 实例作为第二个参数。这可以包括所有常见的操作，如旋转、倾斜、缩放和平移。

如果你使用它，你也可以从一个更简单的圆开始作为多边形输入，然后缩放圆以产生一个椭圆。

上面的代码需要在你的项目中包含单元 GR32_VectorUtils、GR32_Polygons，比如

uses
  GR32_VectorUtils, GR32_Polygons;

优点是您不依赖 GDI 进行渲染，因此您可以从 GR32 的可用渲染器中选择渲染器。有些包括类似 ClearType 的效果，并提高了 LCD 屏幕的可见性。更不用说抗锯齿质量和控制渲染伽玛的能力了。

【讨论】：

CWBudde 始终感谢您的意见。再次感谢您提供真正的 Graphics32 方法。请详细说明如何选择可用的渲染器。例如，如果我想让框架更平滑？控制伽玛、抗锯齿和清除类型怎么样？我相信其他人也会从中受益。
CWBudde，也请看一下这个问题：stackoverflow.com/questions/28623999/…。我可以在那里使用你的输入......

【解决方案2】：

所以在绘制圆/椭圆时，将画笔颜色设置为 0，如：

procedure TForm5.AddCircleToLayer;
begin
  bm32.Canvas.Pen.Color := pencolor;
  bm32.Canvas.Pen.Width := penwidth;
  bm32.Canvas.Brush.Color := 0; // this here does the magic
  bm32.Canvas.MoveTo(FStartPoint.X, FStartPoint.Y);
  bm32.Canvas.Ellipse(FStartPoint.X, FStartPoint.Y,FEndPoint.X, FEndPoint.Y);
  SwapBuffers32;
end;

在 LayerMouseMove 事件中也这样做

【讨论】：