Мне нужна была собственная форма треугольника, поэтому я унаследовал форму класса треугольника TShape и переопределил метод рисования. Все работает нормально, но мне нужно переместить эти фигуры с помощью мыши. Я устанавливаю метод для каждой формы, обрабатывающей событие onMouseDown. Подвижная работа тоже в порядке. Но если две фигуры перекрываются (фигуры на самом деле являются прямоугольниками с некоторыми прозрачными областями), то прозрачная область верхней формы находится над другой фигурой, тогда верхняя фигура перемещается вместо фигуры внизу. Это правильно, так работает Delphi. Но это не интуитивно понятно для пользователя. Как я могу этого добиться? Есть ли возможность не удалять событие из очереди событий и отправлять его в базовые формы, если да, то это было бы просто?
Delphi - перемещение перекрывающихся TShapes
comment
Рисовать анимацию, перемещая элементы управления (даже графические элементы управления) на форме — это плохо. На вашем месте я бы сохранил сцену в какой-нибудь пользовательской структуре данных, а затем полностью отрисовал бы форму вручную. Тогда вас не остановят никакие ограничения — вы можете реализовать любой интерфейс мыши, который пожелаете.
- person Andreas Rejbrand   schedule 29.08.2011
Ответы (2)
Согласно моему комментарию следует «простой образец редизайна».
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
person
Andreas Rejbrand
schedule
28.08.2011
Я знаю, что прошло много времени с тех пор, как вы опубликовали этот ответ, но, может быть, вы могли бы объяснить свой расчет
InRange
для AX
мин/макс? это сносит мне мозг, я давно не занимался математикой или геометрией. После более пристального взгляда я думаю, что начал понимать. Вы уменьшаете половину потенциального меньшего треугольника Base
с заданным AY
, разделив Y-AY
(высоту маленького треугольника) на Height
? Но откуда вы знаете, что разрезание этого с двух сторон будет означать, что X
находится в этом диапазоне? Я немного нарисовал, и это правда, и теперь я это вижу, но это не так ясно, когда это делается программно.
- person Raith; 10.04.2013
Проверьте, находится ли щелчок мыши в области треугольника, прежде чем начать перемещение фигуры. Это требует некоторой математики, но вы также можете неправильно использовать функцию 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)]);
...
person
NGLN
schedule
28.08.2011