解决FireMonkey下的TListBox的Item右键单击后无法选中的bug

最近在使用FireMonkey写一个产品,使用的过程中发现,TListBox的一个小问题,先使用右键对着某个Item节点单击后,再次左键对其单击,竟然无法显示选中状态,实在是郁闷!用着非常不爽!所以就跟了一下源码,做了简单的改动即可修正这个特别郁闷的问题,FMX.ListBox.pas文件具体改动如下:

第一处TCustomListBox.MouseDown

procedure TCustomListBox.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
var
  LItemIndex: Integer;
  P: TPointF;
begin
  FClickEnable := (Button <> TMouseButton.mbLeft) or AniCalculations.LowVelocity or (AniCalculations.TouchTracking = []);
  LItemIndex := ItemIndex;
  if Observers.IsObserving(TObserverMapping.EditLinkID) then
    if not TLinkObservers.EditLinkEdit(Observers) then
      Exit;
  inherited;
  if not FClickEnable then
    Exit;
  ItemDown := ItemByPoint(X, Y);
  if ItemDown <> nil then
  begin
    if Button = TMouseButton.mbLeft then
    begin
      if ItemDown.Index <> ItemIndex then
        TLinkObservers.PositionLinkPosChanging(Observers);
      P := ItemDown.ScreenToLocal(LocalToScreen(TPointF.Create(X, Y)));
      ItemDown.MouseDown(Button, Shift, P.X, P.Y);
      SelectionController.MouseSelectStart(ItemDown, Button, Shift);
      if AllowDrag and (MultiSelectStyle = TMultiSelectstyle.None) and (LItemIndex = ItemDown.Index) then
        PerformInternalDrag
      else
        SelectionController.MouseSelectActive := True;
      if LItemIndex <> ItemIndex then
        TLinkObservers.ListSelectionChanged(Observers);
    end;
  end;
end;

第二处TCustomListBox.MouseUp

procedure TCustomListBox.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
var
  Item: TListBoxItem;
  P: TPointF;
begin
  inherited;
  try
    if (not AniCalculations.Moved) and FClickEnable then
    begin
      Item := ItemByPoint(X, Y);
      if (Item <> nil) and (Item = ItemDown) then
      begin
        if Item.Index <> ItemIndex then
          TLinkObservers.PositionLinkPosChanging(Observers);
        FSelector.MouseSelectFinishing(Item, Button, Shift);
        if Assigned(OnItemClick) then
        try
          OnItemClick(Self, Item);
        except
          on E: Exception do
            Application.HandleException(E);
        end;
        if True then
        if Button = TMouseButton.mbLeft then
          FSelector.MouseSelectFinish(Item, Button, Shift);
        TLinkObservers.ListSelectionChanged(Observers);
        P := Item.ScreenToLocal(LocalToScreen(TPointF.Create(X, Y)));
        Item.MouseUp(Button, Shift, P.X, P.Y);
      end;
    end;
  finally
    FClickEnable := False;
    SelectionController.MouseSelectActive := False;
    ItemDown := nil;
  end;
end;

将改动后的文件,放在自己的工程目录里,并且加到dpr工程文件里重新编译即可!使用的Delphi版本为10.2。大家如果有更好的方法,希望能分享一下,谢谢!

版权所有原创文章,转载请保留或注明出处:http://www.5bug.wang/post/40.html

相关文章