热轨不';拖动时无法在虚拟TListView中工作

热轨不';拖动时无法在虚拟TListView中工作,listview,delphi,debugging,delphi-2009,Listview,Delphi,Debugging,Delphi 2009,如果我使用虚拟TListView并尝试拖动项目(Accept:=True始终),则“热跟踪”系统看起来已损坏。在win 7中,热点项目保持在选定项目附近,而在win 8.1中,热点项目保持固定在随机位置。 我记录下这一行为是为了更好地理解我的意思: 这是重现问题的最小代码: .dfm object Form1: TForm1 Left = 0 Top = 0 Caption = 'Form1' ClientHeight = 378 ClientWidth = 398

如果我使用虚拟
TListView
并尝试拖动项目(
Accept:=True
始终),则“热跟踪”系统看起来已损坏。在win 7中,热点项目保持在选定项目附近,而在win 8.1中,热点项目保持固定在随机位置。 我记录下这一行为是为了更好地理解我的意思:

这是重现问题的最小代码:

.dfm

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 378
  ClientWidth = 398
  Color = clBtnFace
  DoubleBuffered = True
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  Position = poScreenCenter
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object ListView1: TListView
    Left = 78
    Top = 40
    Width = 221
    Height = 286
    Columns = <
      item
        Width = 130
      end>
    DragMode = dmAutomatic
    MultiSelect = True
    OwnerData = True
    ReadOnly = True
    RowSelect = True
    TabOrder = 0
    ViewStyle = vsReport
    OnData = ListView1Data
    OnDragOver = ListView1DragOver
  end
end
当然,问题是,是否可以采取任何措施来纠正这种行为

编辑:

我试图实现我自己的跟踪系统,它似乎正在工作,但有一点例外:光标下最上面的项目始终保持选中状态

function TListView.GetItemIndexAt(X, Y: Integer): Integer;
var Info: TLVHitTestInfo;
begin
 Result:= -1;
 if HandleAllocated then begin
  Info.pt:= Point(X, Y);
  Result:= ListView_HitTest(Handle, Info);
 end;
end;

procedure TForm1.ListView1DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
var Src, Dest, I: Integer;
begin
 Accept:= True;
 Src:= ListView1.Selected.Index;
 Dest:= ListView1.GetItemIndexAt(X, Y);
 for I:= 0 to ListView1.Items.Count-1 do
  if (I = Src) or (I = Dest) then ListView1.Items[I].Selected:= True
   else ListView1.Items[I].Selected:= False;
end;

我已通过重置所有项目的状态并将此状态设置为刚拖过的项目解决了此问题:

type
  TListView = class(ComCtrls.TListView)
  protected
    procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); override;
    procedure DoEndDrag(Target: TObject; X, Y: Integer); override;
  public
    function GetItemIndexAt(X, Y: Integer): Integer;
  end;

function TListView.GetItemIndexAt(X, Y: Integer): Integer;
var
  HitInfo: TLVHitTestInfo;
begin
  Result := -1;
  if HandleAllocated then
  begin
    HitInfo.pt := Point(X, Y);
    Result := ListView_HitTest(Handle, HitInfo);
  end;
end;

procedure TListView.DragOver(Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
var
  DropIndex: Integer;
begin
  inherited;
  if OwnerData then
  begin
    ListView_SetItemState(Handle, -1, 0, LVIS_DROPHILITED);
    if Accept then
    begin
      DropIndex := GetItemIndexAt(X, Y);
      if DropIndex <> -1 then
        ListView_SetItemState(Handle, DropIndex, LVIS_DROPHILITED, LVIS_DROPHILITED);
    end;
  end;
end;

procedure TListView.DoEndDrag(Target: TObject; X, Y: Integer);
begin
  if OwnerData then
    ListView_SetItemState(Handle, -1, 0, LVIS_DROPHILITED);
  inherited;
end;
类型
TListView=class(ComCtrls.TListView)
受保护的
过程DragOver(源:TObject;X,Y:整数;状态:TDragState;变量Accept:Boolean);推翻
过程DoEndDrag(目标:TObject;X,Y:整数);推翻
公众的
函数GetItemIndexAt(X,Y:Integer):整数;
结束;
函数TListView.GetItemIndexAt(X,Y:Integer):整数;
变量
HitInfo:TLVHitTestInfo;
开始
结果:=-1;
如果手动分配,则
开始
HitInfo.pt:=点(X,Y);
结果:=ListView\u HitTest(句柄,HitInfo);
结束;
结束;
过程TListView.DragOver(源:TObject;X,Y:Integer;状态:TDragState;变量Accept:Boolean);
变量
DropIndex:整数;
开始
继承;
如果是所有者数据,则
开始
ListView_SetItemState(句柄,-1,0,LVIS_DROPHILITED);
如果接受,那么
开始
DropIndex:=GetItemIndexAt(X,Y);
如果DropIndex-1,那么
ListView_SetItemState(句柄、DropIndex、LVIS_DROPHILITED、LVIS_DROPHILITED);
结束;
结束;
结束;
过程TListView.DoEndDrag(目标:TObject;X,Y:Integer);
开始
如果是所有者数据,则
ListView_SetItemState(句柄,-1,0,LVIS_DROPHILITED);
继承;
结束;

对于非虚拟的
TListView
,行为是否不同。既然你特别提到了“虚拟”@Tom,我问你,是的,非虚拟模式似乎表现正确。顺便说一句,这不是真正的热跟踪,只是光标高亮显示,这是绘制错误。我建议使用VirtualTreeView控件。请检查我的答案并告诉我您的想法。:)做得好!也许您可以使用
GetItemAt
方法,并仅在启用
OwnerData
时应用此解决方案(因为非虚拟模式的行为似乎是正确的)。不客气!我在这里添加了对所做操作的解释,并对代码做了一些小的更改(主要测试现有的drop项;如果索引不是-1,这将包括对所有项的
LVIS\u DROPHILITED
)。希望你不介意:)我一点也不介意。:)我也认为测试-1确实是一件好事,但是
如果OwnerData和Accept则不是,因为每次
DropIndex
更改时,所有项目都必须清除
DROPHILITED
。只有
DropIndex
Accept
的约束。哦,没错。对不起,我错了!希望能解决:)顺便说一句,谢谢你纠正我的解释。我不是英语母语,用英语写作对我来说已经够难了;)
type
  TListView = class(ComCtrls.TListView)
  protected
    procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); override;
    procedure DoEndDrag(Target: TObject; X, Y: Integer); override;
  public
    function GetItemIndexAt(X, Y: Integer): Integer;
  end;

function TListView.GetItemIndexAt(X, Y: Integer): Integer;
var
  HitInfo: TLVHitTestInfo;
begin
  Result := -1;
  if HandleAllocated then
  begin
    HitInfo.pt := Point(X, Y);
    Result := ListView_HitTest(Handle, HitInfo);
  end;
end;

procedure TListView.DragOver(Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
var
  DropIndex: Integer;
begin
  inherited;
  if OwnerData then
  begin
    ListView_SetItemState(Handle, -1, 0, LVIS_DROPHILITED);
    if Accept then
    begin
      DropIndex := GetItemIndexAt(X, Y);
      if DropIndex <> -1 then
        ListView_SetItemState(Handle, DropIndex, LVIS_DROPHILITED, LVIS_DROPHILITED);
    end;
  end;
end;

procedure TListView.DoEndDrag(Target: TObject; X, Y: Integer);
begin
  if OwnerData then
    ListView_SetItemState(Handle, -1, 0, LVIS_DROPHILITED);
  inherited;
end;