Delphi里实现接收文件拖拽消息的功能

5bug 2018-01-20 719人围观 ,发现0个评论 WM_DropFilesDragAcceptFilesDelphi拖拽文件

鼠标的拖拽给我们平时操作电脑带来了非常大的方便之处,Delphi开发软件的时候,也经常会遇到某些场景下特别需要支持鼠标拖拽文件功能,例如网盘、即时通信发送文件等,这里就给大家分享具体实现这个功能的方法,原理就是截获WM_DropFiles消息,具体还是老规矩看代码吧!

unit Unit8;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Winapi.ShellAPI;

type
  TForm8 = class(TForm)
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    procedure DoWM_DropFiles(var Message: TMessage); message WM_DropFiles;
  public
    { Public declarations }
  end;

var
  Form8: TForm8;

implementation

{$R *.dfm}

procedure TForm8.DoWM_DropFiles(var Message: TMessage);
var
  I: Integer;
  p: array [0 .. 254] of Char;
  FileName: string;
begin
  try
    I := DragQueryFile(Message.wParam, $FFFFFFFF, nil, 0);
    for I := 0 to I - 1 do
    begin
      DragQueryFile(Message.wParam, I, p, 255);
      FileName := StrPas(p);
      if FileExists(FileName) then
      begin
        // 若是文件
        Memo1.Lines.Add('文件:' + FileName);
      end
      else if DirectoryExists(StrPas(p)) then
      begin
        // 若是文件夹
        Memo1.Lines.Add('文件夹:' + FileName);
      end;
    end;
  finally
    DragFinish(Message.wParam);
    Message.Result := 1;
  end;
end;

procedure TForm8.FormCreate(Sender: TObject);
begin
  DragAcceptFiles(Handle, True);
end;

end.

运行效果如下:

1.gif

别忘记了执行DragAcceptFiles哦,另外目前这种写法下在管理员权限运行程序的话是不支持拖拽的,如果这种情况下想解决该问题,可以参考网友分享的这篇文章 ---》传送门


不容错过
Powered By Z-BlogPHP