Использование Drag and drop

[Kirilis2018]

Использую Drag and drop (Embarcadero® RAD Studio 10.1 Berlin) для перетаскивания путей к папкам - в Edit.

Стандартный код и на форме только один Edit1.text: Все работает, но вот Как запретить перетягивать файлы, а разрешить перетягивать только папки ?

unit Unit1;
 
interface
 
uses
  Winapi.Windows, Winapi.Messages, shellapi, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
 
type
  TForm1 = class(TForm)
    Edit1: TEdit;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    procedure draganddrop (var msg:TWMDropFiles); message WM_DROPFILES;
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  dragfile: array [0..max_path] of char;
implementation
 
{$R *.dfm}
 
procedure Tform1.draganddrop(var msg: TWMDRopfiles);
begin
 
if dragqueryfile(msg.drop,0,dragfile,max_path)> 0 then
form1.edit1.text:=dragfile;
 
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
dragacceptfiles(handle,true);
end;
 
end.

[vasya2019]

проверять перетаскиваемый файл функцией FileGetAttr, для каталога функция вернёт faDirectory

[Kirilis2018]

vasya2019, А как это правильно сделать?

[vasya2019]

var
  Form1: TForm1;
  dragfile: string;
......
procedure Tform1.draganddrop(var msg: TWMDRopfiles);
begin
  setlength(dragfile,max_path);
  setlength(dragfile,dragqueryfile(msg.drop,0,pchar(dragfile),max_path));
  if FileGetAttr(dragfile) = faDirectory then edit1.text := dragfile;
end;
.......

Сообщение отредактировано: vasya2019 - 20.02.19, 20:26

[ZBugZ]

Или использовать extractfilepath

[Kirilis2018]

vasya2019, Спасибо! Сработало!