Горячая дорожка не работает в виртуальном TListView при перетаскивании

Если я беру виртуальную машину TListViewи пытаюсь перетащить элементы ( Accept:= Trueвсегда), система «горячего слежения» выглядит поврежденной. В выигрыше 7 горячий элемент остается рядом с выбранным элементом, в то время как в выигрыше 8.1 он остается фиксированным в случайных позициях. Я записал это поведение, чтобы лучше понять, что я имею в виду:

Вот запись с победы 7

Вот запись с победы 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

.pas

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls;

type
  TForm1 = class(TForm)
    ListView1: TListView;
    procedure ListView1Data(Sender: TObject; Item: TListItem);
    procedure FormCreate(Sender: TObject);
    procedure ListView1DragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
 ListView1.Items.Count:= 10;
end;

procedure TForm1.ListView1Data(Sender: TObject; Item: TListItem);
begin
 Item.Caption:= 'Item '+IntToStr(Item.Index);
end;

procedure TForm1.ListView1DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
 Accept:= True;
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;

listview,delphi,debugging,delphi-2009,

2

Ответов: 1


2

Я решил проблему, сбросив LVIS_DROPHILITED состояние всех элементов и установив это состояние на только что перетаскиваемый элемент:

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;
ListView, Дельфы, отладка, Дельфы-2009,
Похожие вопросы