Question

好的，我有一些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。当我遇到主要问题时，total blockss的价值也不会上升。

-cubedata只是我使用的一种快速方式，直到立方体类是comblete，它保存了图像的名称，因此当加载地图时，它将拉出该立方体的图像名称。因此立方体[totalblocks]将具有图像cubedata [totalblocks]

Answer 1

问题在于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 update 4中得到修复。所以我认为您使用的是早期版本。我个人正在使用XE2更新3.对于你来说，这是非常幸运的，因为我怀疑很少有像我这样的XE2用户拒绝继续更新3.

解决问题的选项：

应用更新4。
将损坏的代码修复到您编译到项目中的FMX单元版本中。

Answer 2

请勿将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; （默认为true）。
如果设置了所有属性，则设置... [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);

单击一行中的相同位置不会触发OnClick事件

2 个答案: