Если я беру виртуальную машину 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,