Про drag-n-drop

"А я все чаще замечаю, что..." в тестовых проектиках для выбора файла нажимать на какую-нибудь кнопку "Browse" и выбирать файл - слишком долго.. Намного быстрее получается перетащить нужный файл (особенно когда надо перепробовать десятки файлов) из окна проводника в свой тестовый проект

Вдруг кому-то пригодится - модуль, облегчающий это действие -несколько шагов, чтобы все заработало:

• добавить .pas файл в проект или путь к файлу в настройки окружения - кому как нравится
• добавить в uses формы, которая будет принимать дропы, ссылку на модуль
• создать 2 обработчика, для реакции на "мышка с обьектом над нами" и "юзер бросил нам обьект"
• ну и создать собственно экземпляр класса в подходящем месте

Где-то вот так:

...
type
  TfrmMain = class(TForm)
  ...
  private
  ...
    procedure FileDropEvent (Sender: TObject; const Filenames: TWideStrings);
    procedure FileEnterEvent (Sender: TObject; const Filenames: TWideStrings; var Accept: boolean);
  public
    { Public declarations }
  end;
var
  frmMain: TfrmMain;

implementation

uses
  DragDropSupportUnit, ActiveX;

var
  FileDrop: TFileDrop;

{$R *.dfm}

...

procedure TfrmMain.FileEnterEvent(Sender: TObject; const Filenames: TWideStrings; var Accept: boolean);
begin
   // разрешим дропать только файлы по какому-то правилу - скажем только файлы .mp3
  Accept := AnsiLowerCase ( ExtractFileExt ( Filenames [0] ) ) = '.flv';
end;

procedure TfrmMain.FileDropEvent(Sender: TObject; const Filenames: TWideStrings);
begin
  // прореагируем на бросание файлов на контрол (файлов может быть и несколько)
  if Filenames.Count > 1 then
  begin
    MessageBox(Handle, 'Many files - will be used only first', 'Warning', MB_OK + MB_ICONINFORMATION);
  end;
  edSource.Text := Filenames [0];
end;

...

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  ...
  FileDrop := TFileDrop.Create ( FileDropEvent, FileEnterEvent );
  RegisterDragDrop (Handle, FileDrop as IDropTarget);
  ...
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  ...
  RevokeDragDrop(handle);
  ...
end;

Это все: вызов RegisterDragDrop назначает контрол, handle которого передали параметром, приемником драг-дропа (так что это может быть как вся форма, так и к примеру только поле ввода.. дропаем файл на поле ввода и там тут же появляется имя файла), закрывая программу вертаем все взад.

Код собственно полезного модуля (мне лениво в пятницу вечером делать архив, ложить куда-то на рапиду.. скопипастить в ide да сохранить):

// использование: создать обьект, передав ему указатели на обработчики
// OnEnter и OnDrop и зарегистрировать приемник drag-drop-а:
//     RegisterDragDrop (Handle, FFileDrop as IDropTarget);
unit DragDropSupportUnit;

interface

uses
  windows, sysutils, widestrings, ActiveX, shellAPI;

type
  TFileDropEvent = procedure (Sender: TObject; const Filenames: TWideStrings) of object;
  TFileEnterEvent = procedure (Sender: TObject; const Filenames: TWideStrings; var Accept: boolean) of object;

  TFileDrop = class (TInterfacedObject, IDropTarget)
  private
    FDropEvent: TFileDropEvent;
    FEnterEvent: TFileEnterEvent;
    FFilenames: TWideStrings;
    FCanDrop: boolean;
  public
    constructor Create (AOnDrop: TFileDropEvent; AOnEnter: TFileEnterEvent);
    destructor Destroy; override;

    function DragEnter(const dataObj: IDataObject; grfKeyState: Longint;
      pt: TPoint; var dwEffect: Longint): HResult; stdcall;
    function DragOver(grfKeyState: Longint; pt: TPoint;
      var dwEffect: Longint): HResult; stdcall;
    function DragLeave: HResult; stdcall;
    function Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint;
      var dwEffect: Longint): HResult; stdcall;
  end;


implementation

{ TFileDrop }

constructor TFileDrop.Create(AOnDrop: TFileDropEvent;
  AOnEnter: TFileEnterEvent);
begin
  inherited Create;
  FDropEvent := AOnDrop;
  FEnterEvent := AOnEnter;
  FCanDrop := false;

  FFilenames := TWideStringList.Create;
end;

destructor TFileDrop.Destroy;
begin
  FFilenames.Free;
  inherited;
end;

function TFileDrop.DragEnter(const dataObj: IDataObject;
  grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;
var
  medium: TStgMedium;
  format: TFormatEtc;
  fn: array [0..MAX_PATH] of char;
  fcount, i: integer;
begin
  dataObj._AddRef;

  format.cfFormat := CF_HDROP;
  format.ptd := nil;
  format.dwAspect := DVASPECT_CONTENT;
  format.lindex := -1;
  format.tymed := TYMED_HGLOBAL;

  if dataObj.GetData (format, medium) = S_OK then
  begin
    fcount := DragQueryFile (medium.hGlobal, $FFFFFFFF, nil, 0);
    if fcount > 0 then
    begin
      for i := 0 to fcount - 1 do
      begin
        DragQueryFile (medium.hGlobal, i, fn, sizeof (fn));
        FFilenames.Add ( string ( fn ) );
      end;
      FCanDrop := true;
    end else
      FFilenames.Clear;
  end;

  if medium.unkForRelease = nil then
    ReleaseStgMedium (medium);
  dataObj._Release;

  if Assigned (FEnterEvent) then
    FEnterEvent (self, FFilenames, FCanDrop);

  if FCanDrop then
    dwEffect := DROPEFFECT_COPY
  else
    dwEffect := DROPEFFECT_NONE;
  Result := S_OK;
end;

function TFileDrop.DragLeave: HResult;
begin
  FFilenames.Clear;
  Result := S_OK;
end;

function TFileDrop.DragOver(grfKeyState: Integer; pt: TPoint;
  var dwEffect: Integer): HResult;
begin
  if FCanDrop then
    dwEffect := DROPEFFECT_COPY
  else
    dwEffect := DROPEFFECT_NONE;
  Result := S_OK;
end;

function TFileDrop.Drop(const dataObj: IDataObject; grfKeyState: Integer;
  pt: TPoint; var dwEffect: Integer): HResult;
begin
  if Assigned (FDropEvent) and FCanDrop then
  begin
    FDropEvent (self, FFilenames);
    dwEffect := DROPEFFECT_COPY;
  end else
    dwEffect := DROPEFFECT_NONE;

  FFilenames.Clear;
  Result := S_OK;
end;

initialization
  OleInitialize(nil);

finalization
  OleUninitialize;

end.