Delphi - 移动重叠的T形 [英] Delphi - moving overlapping TShapes

问题描述

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

Thaks Uiii

解决方案

根据我的评论，一个简单的样本重新设计。

 <$ c $单位Unit4; 
 
接口
 
使用
 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〜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 。

编译示例演示： http://privat.rejbrand.se/MovingTriangles.exe

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?

Thaks Uiii

解决方案

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形的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！