delphi - 如何在不添加相同数量代码的情况下向表单添加更多对象

Question

我一直在做一个小游戏，很有趣。在游戏中，您是一艘小型飞船（一幅图像），向目标（面板）发射激光束（形状）。此时，您一次只能发射一个激光束，因为只有一个激光束（形状）并且只有一个物体（面板）要发射。因此，有了编码，我想知道如何添加更多的激光束和对象，尤其是激光束，因为我不想为每个激光束和每个面板重复该过程。

这是代码。

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, jpeg;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Timer1: TTimer;
    Timer2: TTimer;
    Button1: TButton;
    Shape1: TShape;
    Timer3: TTimer;
    Image1: TImage;
    procedure Timer2Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure Timer3Timer(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
  public
   procedure StartPanelAnimation1;
   procedure DoPanelAnimationStep1;
   function  PanelAnimationComplete1: Boolean;
   procedure Startlazeranimation1;
   procedure DolazeranimationStep1;
   { Public declarations }
  end;

var
  Form1: TForm1;

implementation
 var key : char;
{$R *.dfm}

{ TForm1 }



{ TForm1 }

procedure TForm1.DoPanelAnimationStep1;
begin
Panel1.Top := Panel1.Top+1;
end;

function TForm1.PanelAnimationComplete1: Boolean;
begin
 Result := Panel1.Top=512;
end;

procedure TForm1.StartPanelAnimation1;
begin
  Panel1.Top := 0;
  Timer1.Interval := 1;
  Timer1.Enabled := True;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin
 DoPanelAnimationStep1;
  if PanelAnimationComplete1 then
    StartPanelAnimation1;
   if (shape1.Top < panel1.Top) and (shape1.Left < panel1.Left+104) and (shape1.Left > panel1.Left)   then
   begin
    startpanelanimation1;
   sleep(10);
   end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 button1.Hide;
  key := 'a';
  timer2.Enabled := true;
  StartPanelAnimation1; 
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
 shape1.Visible := false;
 timer3.Enabled := false;
 timer2.Enabled := false;
 end;

procedure TForm1.FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
   begin
image1.Left := image1.Left-10;
end;

 procedure TForm1.FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
    begin
  image1.Left := image1.Left+10;
end;

procedure TForm1.DolazeranimationStep1;
begin
 shape1.Top := shape1.Top-10;
end;


 procedure TForm1.Startlazeranimation1;
 begin
 shape1.Top := image1.Top;
 shape1.Left := image1.Left+55;
 shape1.Visible := true;
  Timer3.Interval := 1;
  Timer3.Enabled := True;
end;

procedure TForm1.Timer3Timer(Sender: TObject);
var k : integer;
begin
 DolazeranimationStep1;
  if (shape1.Top < panel1.Top) and (shape1.Left < panel1.Left+104) and (shape1.Left > panel1.Left) or         (shape1.Top=clientheight) then
   begin
    timer3.Enabled := false;
    shape1.Visible := false;
    for k := 1 to 5 do
    sleep(1);
    begin
    application.ProcessMessages;
    end;
    shape1.Top := 0;
    shape1.Left := 0;
   end;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 shape1.Show;
 startlazeranimation1;
end;

end.

（以上是旧代码）

我已经成功完成了Stijn Sanders的建议。但是现在如果

 if (Shape1.top < panel1.Top) and (shape1.Left < panel1.Left+104) and (shape1.Left > panel1.Left)   then

永远不会测试true，因为shape1永远不会通过panel1，只有单击时创建的形状才能通过面板。

因此，还有另一种方法可以测试形状是否在饰钉上。

Answer 1

并非所有组件都需要在设计时创建。在运行时，例如，使用TTimer及其事件，可以调用TShape.Create(Self);使其具有额外的形状。将对结果值的引用保存在方便的地方，例如（动态）数组，并记住设置MyShape.Parent:=Self;或MyShape.Parent:=Panel1;，以便系统知道何时何地显示此新控件。

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;

const
  MaxRays=100;
  RayStep=8;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
    Rays:array[0..MaxRays-1] of TShape;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
  i:integer;
begin
  for i:=0 to MaxRays-1 do Rays[i]:=nil;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  i:integer;
begin
  i:=0;
  while (i<MaxRays) and (Rays[i]<>nil) do inc(i);
  if i<MaxRays then
   begin
    Rays[i]:=TShape.Create(Self);
    Rays[i].Shape:=stEllipse;
    Rays[i].Pen.Color:=clRed;
    Rays[i].Pen.Style:=psSolid;
    Rays[i].Brush.Color:=clYellow;
    Rays[i].Brush.Style:=bsSolid;
    Rays[i].SetBounds(X-4,Y-20,9,41);
    Rays[i].Parent:=Self;
   end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  i:integer;
begin
  for i:=0 to MaxRays-1 do
    if Rays[i]<>nil then
    begin
      Rays[i].Top:=Rays[i].Top-RayStep;
      if Rays[i].Top<0 then FreeAndNil(Rays[i]);
    end;
end;

end.