Delphi - オーバーラップするTShapesを移動する

Question

私は自分の三角形が必要でしたので、私は三角形のフォームTShapeを継承し、ペイント方法をオーバーライドしました。すべて正常に動作しますが、マウスでこのシェイプを移動する必要があります。 onMouseDownイベントを処理するすべてのシェイプのメソッドを設定しました。移動作業もうまくいきます。しかし、2つの図形が重なり合っている場合（図形は実際には一部の透明領域で長方形になっています）、上部の図形の透明領域が別の図形の上にある場合、上部の図形は下の図形の代わりに移動します。デルファイの仕組みは正しいです。しかし、それはユーザーにとって直感的ではありません。それをどうすれば実現できますか？イベントキューからイベントを削除しないで、下にあるシェイプに送信する可能性はありますか？はいの場合は単純でしょうか？

Answer 1

シェイプの移動を開始する前に、マウスクリックが三角形領域内にあるかどうかをテストします。それはいくつかの数学が必要ですが、以下のように、あなたはまた、一時的な領域を形成することにより、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)]); 
    ... 

Answer 2

A「簡単なサンプルの再設計」は、以下。

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. 

は、フォームのDoubleBufferedtrueに設定することを忘れないでください。

コンパイルしたサンプルのデモ：http://privat.rejbrand.se/MovingTriangles.exe