Delphi - 移动重叠的T形

问题描述

我需要自己的三角形形状，所以我继承了我的三角形类TShape并覆盖绘画方法。一切都很好，但是我需要用鼠标移动这个形状。我为MouseDown事件中的每个形状处理设置了方法。移动工作也很好。但是，如果两个形状重叠（形状实际上是具有一些透明区域的矩形），则顶部的形状透明区域超过另一个形状，则顶部形状移动而不是下面的形状。这是正确的，那就是德尔福如何运作。但是用户不直观。我该如何实现呢？是否有可能从事件队列中删除事件并将其发送到底层形状，如果是，那将很简单？

解决方案

单位Unit4;单位Unit4;单位单位4;

接口

使用
Windows，消息，SysUtils，变体，类，图形，控件，表单，
对话框;

const
NUM_TRIANGLES = 10;
COLORS：integer =（clRed，clGreen，clBlue，clYellow，clFuchsia，
clLime，clGray，clSilver，clBlack，clMaroon，clNavy，clSkyBlue，clMoneyGreen）的数组[0..12]

type
TTriangle = record
X，Y：integer; //左下角
Base，Height：integer;
颜色：TColor;
结束

TTriangles = TTriangle的数组[0..NUM_TRIANGLES - 1];

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
{私有声明}
FTriangles：TTriangles;
FDragOffset：TPoint;
FTriangleActive：boolean;
函数GetTriangleAt（AX，AY：Integer）：整数;
函数IsMouseDown：boolean;
public
{公开声明}
end;

var
Form4：TForm4;

实现

使用数学;

{$ R * .dfm}


程序TForm4.FormCreate（发件人：TObject）;
var
i：整数;
begin
FTriangleActive：= false;
随机化;
for i：= 0 to NUM_TRIANGLES - 1 do
with FTriangles [i] do
begin
base：= 40 + Random（80）;
height：= 40 +随机（40）;
X：= Random（ClientWidth - base）;
Y：= height + Random（ClientHeight - height）;
颜色：= RandomFrom（COLORS）;
结束
结束

程序TForm4.FormMouseDown（Sender：TObject; Button：TMouseButton;
Shift：TShiftState; X，Y：Integer）;
var
TriangleIndex：integer;
TempTriangle：TTriangle;
i：整数;
begin
TriangleIndex：= GetTriangleAt（X，Y）;
如果TriangleIndex<> -1然后
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;
无效;
结束
FTriangleActive：= TriangleIndex<> -1;
结束

函数TForm4.IsMouseDown：boolean;
begin
result：= GetKeyState（VK_LBUTTON）和$ 8000< 0;
结束

procedure TForm4.FormMouseMove（Sender：TObject; Shift：TShiftState; X，
Y：Integer）;
begin
如果IsMouseDown和FTriangleActive然后
begin
FTriangles [high（FTriangles）]。X：= X - FDragOffset.X;
FTriangles [高（FTriangles）]。Y：= Y - FDragOffset.Y;
无效;
结束
结束

procedure TForm4.FormMouseUp（Sender：TObject; Button：TMouseButton;
Shift：TShiftState; X，Y：Integer）;
begin
FTriangleActive：= false;
结束

procedure TForm4.FormPaint（Sender：TObject）;
var
i：整数;
顶点：TPoint数组;
begin
SetLength（Vertices，3）;
for i：= 0 to NUM_TRIANGLES - 1 do
with FTriangles [i] do
begin
Canvas.Brush.Color：= Color;
顶点[0]：=点（X，Y）;
顶点[1]：=点（X + Base，Y）;
顶点[2]：=点（X + Base div 2，Y - Height）;
Canvas.Polygon（Vertices）;
结束
结束

函数TForm4.GetTriangleAt（AX，AY：Integer）：整数;
var
i：整数;
begin
result：= -1;
for i：= NUM​​_TRIANGLES - 1 toto 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））然后
Exit ）;
结束

结束。

不要忘记设置表单的 DoubleBuffered 到 true 。

编译示例演示：

I've needed own triangle shape so, I inherited my triangle class form TShape and override paint method. Everything works fine, but I need to move this shapes with mouse. I set the method for every shape handling onMouseDown event. Moving work also fine. But If two shapes overlaps (shapes are in fact rectangles with some transparent areas), that the top's shape transparent area is over another shape, then the top shape moves instead of the shape below. It's correct, that is how Delphi works. But it's not intuitive for the user. How can I achieve that? Is there possibility to not remove the event from event queue and sent it to underlying shapes, if yes it would be simple?

解决方案

A 'simple sample redesign' per my comment follows.

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.

Don't forget to set the form's DoubleBuffered to true.

Compiled sample demo: http://privat.rejbrand.se/MovingTriangles.exe

这篇关于Delphi - 移动重叠的T形的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！