procedure TForm1.ShellListViewDragOver(Sender, Source: TObject; X,
Y: Integer; State: TDragState; var Accept: Boolean);
begin
Accept := Source is TTreeview;
end;
TreeView + ShellListView (drag n drop)
Проблема с drag n drop из TreeView в ShellListView
Код:
Весь прикол в том, что даже если не писать обработчик ShellListViewDragDrop а
запустить приложение, перейти например на диск c: в ShellListView, далее в папку NEW (папка пуста) затем перетащить какой-то элемент в из TreeView в эту пустую папку - получаю еррор List Index out of bounds (0)
отладчик ссылается на строчку for J := 1 to Columns.Count - 1 do в коде
Код:
function TCustomShellListView.OwnerDataFetch(Item: TListItem;
Request: TItemRequest): Boolean;
var
AFolder: TShellFolder;
J: integer;
begin
Result := True;
AFolder := Folders[Item.Index];
if not Assigned(AFolder) then exit;
if (Item.Index > FFolders.Count - 1) or (Item.Index < 0) then Exit;
if irText in Request then
Item.Caption := AFolder.DisplayName;
if irImage in Request then
Item.ImageIndex := AFolder.ImageIndex(ViewStyle = vsIcon);
if ViewStyle <> vsReport then Exit;
//PIDL := AFolder.FPIDL;
AFolder.LoadColumnDetails(FRootFolder, Self.Handle, Columns.Count);
for J := 1 to Columns.Count - 1 do
Item.SubItems.Add(AFolder.Details[J]);
(*
FRootFolder.ViewHandle := Self.Handle;
SF2 := FRootFolder.ShellFolder2;
if Assigned(SF2) then
begin
// Already have name and icon, so see if we can provide details
for J := 1 to Columns.Count - 1 do
begin
HR := SF2.GetDetailsOf(PIDL, J, SD);
Item.SubItems.Add(StrRetToString(PIDL, SD.str, Format('**%x**', [HR])));
end;
end
else
begin
ISD := FRootFolder.ShellDetails;
if Assigned(ISD) then
begin
PIDL := TShellFolder(FFolders[Item.Index]).FPIDL;
for J := 1 to Columns.Count - 1 do
begin
ISD.GetDetailsOf(PIDL, J, SD);
Item.SubItems.Add(StrRetToString(PIDL, SD.str));
end;
end
else if (fpFileSystem in FRootFolder.Properties) then
begin
GetDetailsOf(TShellFolder(FFolders[Item.Index]), FindData);
for J := 1 to Columns.Count - 1 do
Item.SubItems.Add(DefaultDetailColumn(FindData, J));
end;
end;
(**)
end;
Request: TItemRequest): Boolean;
var
AFolder: TShellFolder;
J: integer;
begin
Result := True;
AFolder := Folders[Item.Index];
if not Assigned(AFolder) then exit;
if (Item.Index > FFolders.Count - 1) or (Item.Index < 0) then Exit;
if irText in Request then
Item.Caption := AFolder.DisplayName;
if irImage in Request then
Item.ImageIndex := AFolder.ImageIndex(ViewStyle = vsIcon);
if ViewStyle <> vsReport then Exit;
//PIDL := AFolder.FPIDL;
AFolder.LoadColumnDetails(FRootFolder, Self.Handle, Columns.Count);
for J := 1 to Columns.Count - 1 do
Item.SubItems.Add(AFolder.Details[J]);
(*
FRootFolder.ViewHandle := Self.Handle;
SF2 := FRootFolder.ShellFolder2;
if Assigned(SF2) then
begin
// Already have name and icon, so see if we can provide details
for J := 1 to Columns.Count - 1 do
begin
HR := SF2.GetDetailsOf(PIDL, J, SD);
Item.SubItems.Add(StrRetToString(PIDL, SD.str, Format('**%x**', [HR])));
end;
end
else
begin
ISD := FRootFolder.ShellDetails;
if Assigned(ISD) then
begin
PIDL := TShellFolder(FFolders[Item.Index]).FPIDL;
for J := 1 to Columns.Count - 1 do
begin
ISD.GetDetailsOf(PIDL, J, SD);
Item.SubItems.Add(StrRetToString(PIDL, SD.str));
end;
end
else if (fpFileSystem in FRootFolder.Properties) then
begin
GetDetailsOf(TShellFolder(FFolders[Item.Index]), FindData);
for J := 1 to Columns.Count - 1 do
Item.SubItems.Add(DefaultDetailColumn(FindData, J));
end;
end;
(**)
end;
подскажите пожалуйста как с этим бороться?
p.s эта ситуация наблюдается исключительно при ViewStyle vsReport или VsList и при попытке переноса одного элемента именно в пустую папку. при vsIcon - всё норм...
не удалось воспроизвести проблему
и это всё только при VSList или VSReport, при VSIcon всё норм... я об этом писал ранее
Ну баг делят между собой винда и ComCtrls:14933 (TCustomListView.GetTopItem)