-1

好的，我有几个 这样TCubes的OnClick

 procedure TForm2.cubeClick(sender: TObject);
begin
  handleCubeClick(Sender);
end;

然后 HandleCubeClick 像这样

Procedure TForm2.HandleCubeClick(Sender: TObject);
var
cube:TCube;
oldCubeClick: TNotifyEvent;
begin

  try
    cube:= Sender as TCube;
      //save old hadler
        oldCubeClick := cube.OnClick;
      //clear it to disale
        cube.onclick := nil;
    if setblocks then
    begin
      label4.Text := 'cubed clicked';
      totalblocks := totalblocks +1 ;
      CreateCube[totalblocks]:=tcube.Create(self);
      CreateCube[totalblocks].Visible := true;
      CreateCube[totalblocks].Name := 'cubename'+inttostr(totalblocks);
      CreateCube[totalblocks].Position.x := cube.Position.X;
      CreateCube[totalblocks].Position.Y := cube.Position.y;
      CreateCube[totalblocks].Position.Z := cube.Position.Z -1;
      CreateCube[totalblocks].Material.Texture.CreateFromFile(gamedir+'\pics\'+blocktype);
      CubeData[totalblocks] := blocktype;
      CreateCube[totalblocks].Material.Lighting := false;
      CreateCube[totalblocks].Material.Modulation := TTextureMode.tmReplace;
      CreateCube[totalblocks].Parent := viewport3d1;
      CreateCube[totalblocks].OnClick := cubeClick;
      CreateCube[totalblocks].OnMouseDown := mousedown;
      label4.Text := 'cube made: '+inttostr(totalblocks);
    end;
  finally
    //Reset handler again to enable
    cube.OnClick := OldCubeclick;
  end;
end;

所以当我左键单击一个立方体时，它应该在它上面创建另一个立方体。如果我右键单击它将通过 OnMouseDown 删除多维数据集

procedure TForm2.mouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single; RayPos, RayDir: TVector3D);
var
  cube: Tcube;
begin
  if button = Tmousebutton.mbRight then
    begin
    cube := Sender as Tcube;
    cube.Destroy;
    end;
viewport3d1.Repaint;
end;

问题是，如果我单击其中一个立方体上的相同位置，它永远不会触发 OnClick 事件，因此不会添加任何块。知道如何解决这个问题吗？

因评论而编辑：截至目前，这些都是全局变量

  SetBlocks : boolean;
  totalblocks : integer;
  CreateCube : array[1..10000] of tcube;
  cubeData : array[1..10000] of string;

Setblocks - 一旦用户单击其中一个图像，设置为 true，即设置块上的图像类型。我已经检查过了，当主要问题发生时，setblocks 仍然是真的。

 procedure TForm2.Image1Click(Sender: TObject);
begin
 updateblocktype('Lava.bmp');
 setblocks := true;
end;

Totalblocks - 只是游戏中的总块数，当前用于创建数组中的下一个立方体。从 1 开始，每次创建块时添加 1。当我遇到主要问题时，totalblocks 的值也不会上升。

-cubedata 只是我在多维数据集类完成之前使用的一种快速方法，它保存了图像的名称，因此当加载地图时，它将提取该多维数据集的图像名称。因此 cube[totalblocks] 将具有图像 cubedata[totalblocks]

4

2 回答 2

4

问题在于 XE2 FMX 框架，它对鼠标单击和双击的处理似乎被破坏了。如果您单击的频率高于鼠标双击间隔，则 FMX 框架会将未来对特定立方体的所有单击视为双击。

源代码相当具有启发性。触发您的事件的代码在这里：

procedure TControl3D.MouseUp3D(Button: TMouseButton; Shift: TShiftState; X, Y: Single; RayPos, RayDir: TVector3D);
begin
  if FAutoCapture then
    ReleaseCapture;
  if FPressed and not(FDoubleClick) and (FIsMouseOver) then
  begin
    FPressed := False;
    Click;
  end;
  if Assigned(FOnMouseUp) then
    FOnMouseUp(Self, Button, Shift, X, Y, RayPos, RayDir);
end;

你的问题是，FDoubleClick这True意味着Click没有开火。

当您单击得足够快时，框架会确定您正在执行双击。这发生在TControl3D.MouseDown3D：

if (ssDouble in Shift) then
begin
  DblClick;
  FDoubleClick := True;
end

FDoubleClick但是在设置为的单元中没有任何代码False。所以看起来一旦你双击了一个控件，你就再也不能点击它了！所有未来的点击都将被解释为双击。

因此，作为这种情况的快速演示，将新多维数据集和事件处理程序都连接OnClick起来OnDblClick。这是解决您的问题的一个相当粗略的工作。我怀疑，但尚未验证，FMX 框架的更新版本将解决这个问题。您正在使用质量低于最新版本的初始版本。

感谢 Sertac 在评论中的帮助，我们可以确认该漏洞已在 XE2 更新 4 中修复。所以我假设您使用的是早期版本。我个人正在使用 XE2 更新 3。碰巧，这对您来说非常幸运，因为我怀疑很少有 XE2 用户像我一样拒绝从更新 3 继续前进。

解决问题的选项：

  • 应用更新 4。
  • 修复您自己版本的 FMX 单元中您编译到项目中的损坏代码。
于 2013-09-13T13:42:22.777 回答
0
  • 不要设置你的cube.onclick := nil;和返回。这不是必需的。
  • 使用全局 Var ：noEvent
  • 测试totalblocks.
    仅在设置cube.onclick := nil;和时发生fast clicks。然后可能会发生这种情况，totalblocks value立即从例如 110 更改为 21022000，然后 CreateCube[21022000]:=tcube.Create(self);引发异常。

例如 ：

....
countnoEvent : integer;
noEvent      : Boolean;

implementation
....

procedure TForm1.Cube1Click(Sender: TObject);
begin
  HandleCubeClick(Sender);
end;

Procedure TForm1.HandleCubeClick(Sender: TObject);
var
  cube:TCube;
begin
  if noEvent then exit;
     noEvent:=true;

  cube:= Sender as TCube;
  try
  ....
      label4.Text := 'cubed clicked';
      inc(totalblocks);
      if totalblocks > 600 then begin
        label4.Text := 'max reached : 600 :'+intToStr(totalblocks);
        exit;
      end;
      CreateCube[totalblocks]:=tcube.Create(self);
      CreateCube[totalblocks].Visible := false;
      ....
      CreateCube[totalblocks].Visible := true;
      label4.Text := 'cube made: '+inttostr(totalblocks);
    end;
  finally
    noEvent:=false;
  end;
end;

首先设置 CreateCube[totalblocks].Visible := false; （默认为真）。
如果设置了所有属性，则设置 ...[totalblocks].Visible := true;

你可以测试一下

  var
  cube:TCube;
  begin
  if noEvent then begin
     inc(countnoEvent);
     exit;
  end;
  ....

      label4.Text := 'cube made: '+inttostr(totalblocks);
      label5.Text := 'noEvent blocked: '+inttostr(countnoEvent);

countnoEvent永远都是0。
这意味着没有贯穿

  if noEvent then begin
     inc(countnoEvent);
于 2013-09-08T21:31:58.087 回答