delphi - Delphi - 移动重叠的 TShapes

Question

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

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

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)]);
  ...