Delphi - 移动重叠的 TShape

Question

我需要一个自己的三角形，所以我从 TShape 继承了我的三角形类并覆盖了它的 paint 方法。一切都工作得很好，但我需要用鼠标移动这些形状。我为每个形状设置了处理 onMouseDown 事件的方法。移动也正常工作。但是，如果两个形状重叠（实际上是带有一些透明区域的矩形），则顶部形状的透明区域会覆盖其他形状，此时顶部形状会移动而不是下面的形状。这是 Delphi 的正确行为。但对用户来说不直观。我该怎么办？是否有可能不从事件队列中删除事件并将其发送到底层形状，如果可以的话，那就简单了吗？

- uiii

---

在表单上通过移动控件（甚至是图形控件）来制作绘画动画是不好的。如果我是你，我会将场景存储在自定义数据结构中，然后完全手动地绘制表单。这样就没有任何限制，你可以实现任何想要的鼠标接口。 - Andreas Rejbrand

Answer 1

按照我的评论，进行一个“简单的示例重新设计”如下。

unit Unit4;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;

const
  NUM_TRIANGLES = 10;
  COLORS: array[0..12] of integer = (clRed, clGreen, clBlue, clYellow, clFuchsia,
    clLime, clGray, clSilver, clBlack, clMaroon, clNavy, clSkyBlue, clMoneyGreen);

type
  TTriangle = record
    X, Y: integer; // bottom-left corner
    Base, Height: integer;
    Color: TColor;
  end;

  TTriangles = array[0..NUM_TRIANGLES - 1] of TTriangle;

  TForm4 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
    FTriangles: TTriangles;
    FDragOffset: TPoint;
    FTriangleActive: boolean;
    function GetTriangleAt(AX, AY: Integer): Integer;
    function IsMouseDown: boolean;
  public
    { Public declarations }
  end;

var
  Form4: TForm4;

implementation

uses Math;

{$R *.dfm}


procedure TForm4.FormCreate(Sender: TObject);
var
  i: Integer;
begin
  FTriangleActive := false;
  Randomize;
  for i := 0 to NUM_TRIANGLES - 1 do
    with FTriangles[i] do
    begin
      base := 40 + Random(80);
      height := 40 + Random(40);
      X := Random(ClientWidth - base);
      Y := height + Random(ClientHeight - height);
      Color := RandomFrom(COLORS);
    end;
end;

procedure TForm4.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  TriangleIndex: integer;
  TempTriangle: TTriangle;
  i: Integer;
begin
  TriangleIndex := GetTriangleAt(X, Y);
  if TriangleIndex <> -1 then
  begin
    FDragOffset.X := X - FTriangles[TriangleIndex].X;
    FDragOffset.Y := Y - FTriangles[TriangleIndex].Y;
    TempTriangle := FTriangles[TriangleIndex];
    for i := TriangleIndex to NUM_TRIANGLES - 2 do
      FTriangles[i] := FTriangles[i + 1];
    FTriangles[NUM_TRIANGLES - 1] := TempTriangle;
    Invalidate;
  end;
  FTriangleActive := TriangleIndex <> -1;
end;

function TForm4.IsMouseDown: boolean;
begin
  result := GetKeyState(VK_LBUTTON) and $8000 <> 0;
end;

procedure TForm4.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if IsMouseDown and FTriangleActive then
  begin
    FTriangles[high(FTriangles)].X := X - FDragOffset.X;
    FTriangles[high(FTriangles)].Y := Y - FDragOffset.Y;
    Invalidate;
  end;
end;

procedure TForm4.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  FTriangleActive := false;
end;

procedure TForm4.FormPaint(Sender: TObject);
var
  i: Integer;
  Vertices: array of TPoint;
begin
  SetLength(Vertices, 3);
  for i := 0 to NUM_TRIANGLES - 1 do
    with FTriangles[i] do
    begin
      Canvas.Brush.Color := Color;
      Vertices[0] := Point(X, Y);
      Vertices[1] := Point(X + Base, Y);
      Vertices[2] := Point(X + Base div 2, Y - Height);
      Canvas.Polygon(Vertices);
    end;
end;

function TForm4.GetTriangleAt(AX, AY: Integer): Integer;
var
  i: Integer;
begin
  result := -1;
  for i := NUM_TRIANGLES - 1 downto 0 do
    with FTriangles[i] do
      if InRange(AY, Y - Height, Y) and
        InRange(AX, round(X + (Base / 2) * (Y - AY) / Height),
          round(X + Base - (Base / 2) * (Y - AY) / Height)) then
        Exit(i);
end;

end.

别忘了将表单的DoubleBuffered设置为true。

编译好的示例演示：https://privat.rejbrand.se/MovingTriangles.exe

- Andreas Rejbrand

---

我知道你发表这个答案已经有很长时间了，但也许你可以解释一下你对于AX最小/最大计算的InRange函数吗？这真的让我感到困惑，我已经很久没有做数学或几何题了。经过更多的思考，我开始理解了。你通过将给定的AY与潜在较小三角形Base的一半进行比例缩放，即通过将Y-AY（小三角形的高度）除以Height来实现？但是你怎么知道从两侧切割会使得X处于该范围内呢？我画了一些图，发现确实如此，现在我明白了，但是在编程中实现时并不那么清晰。 - Raith

Answer 2

在启动形状移动之前，测试鼠标点击是否在三角形区域内。这需要一些数学计算，但您也可以通过创建临时区域来滥用WinAPI PtInRegion函数，如下所示：

function PtInPolygon(const Pt: TPoint; const Points: array of TPoint): Boolean;
var
  Region: HRGN;
begin
  Region := CreatePolygonRgn(Points[0], Length(Points), WINDING);
  try
    Result := PtInRegion(Region, Pt.X, Pt.Y);
  finally
    DeleteObject(Region);
  end;
end;

procedure TForm1.Shape1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  StartMove: Boolean;
begin
  StartMove := PtInPolygon(Point(X, Y), [Point(100, 0), Point(200, 200),
    Point(0, 200)]);
  ...

- NGLN