连续单击同一点不会触发 OnClick 事件

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 事件，因此不会添加任何块。知道如何解决这个问题吗？

由于 cmets 而编辑： 到目前为止，这些都是全局变量

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

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

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

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

-cubedata 只是我在多维数据集类完成之前使用的一种快速方法，它保存了图像的名称，因此当加载地图时，它将提取该多维数据集的图像名称。因此 cube[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 在 cmets 中的帮助，我们可以确认该漏洞已在 XE2 更新 4 中得到修复。所以我假设您使用的是早期版本。我个人使用的是 XE2 更新 3。碰巧，这对你来说非常幸运，因为我怀疑很少有 XE2 用户像我一样拒绝从更新 3 继续前进。

解决问题的选项：

• 应用更新 4。
• 在您自己的 FMX 单元版本中修复损坏的代码，并编译到您的项目中。

Answer 2

• 不要设置您的 cube.onclick := nil; 和 back 。这不是必需的。
• 使用全局变量：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);