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: https://privat.rejbrand.se/MovingTriangles.exe
与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…