Delphi - moving overlapping TShapes

I need my own triangle shape, so I inherited a triangle shape from TShape and redefine it. Everything works fine, but I need to move these shapes with the mouse. I set a method for each form processing in the MouseDown event. The movement is also beautiful. But if the two shapes overlap (the shapes are actually rectangles with some transparent areas), then the transparent area of ​​the upper shape is above the other shape, then the upper shape moves instead of the shape below. That's right, this is how Delphi works. But this is not intuitive for the user. How can i achieve this? Is it possible not to remove the event from the event queue and send it to the base shapes, if so, would it be easy?

+6
source share
2 answers

A “simple redesign sample” follows for my comment.

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. 

Remember to set the DoubleBuffered form to true .

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

+9
source

Check if the mouse click is in the triangle before initiating the movement of the figure. This requires some math, but you can also abuse the WinAPI PtInRegion function by creating a time domain as follows:

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

Source: https://habr.com/ru/post/896091/


All Articles