Delphi实现vista，win7，wiin8 下拖拽功能

unit Unit1;


interface


uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,ShellAPI;


type
  TForm1 = class(TForm)
    btn1: TButton;
    procedure FormCreate(Sender: TObject);
  private
    function AllowMeesageForVistaAbove(uMessageID:UINT;bAllow:Boolean):Boolean ;
  protected
    procedure DragDropFile(var message:TMessage);  message WM_DROPFILES;
  public
    ChangeWindowMessageFilter:function(msg: UINT; dwFlag: DWORD): BOOL; stdcall;
  end;


var
  Form1: TForm1;
  const
    MSGFLT_ADD= 1 ;
    MSGFLT_REMOVE= 2 ;
implementation


{$R *.dfm}


//register global messages for vista win7.
function TForm1.AllowMeesageForVistaAbove(uMessageID: THandle;
  bAllow: Boolean): Boolean;
var
   bResult:Boolean;
   hUserMod:HMODULE;
begin
    bResult:=False;
    hUserMod:=Null;
    //vista and later
    hUserMod := LoadLibrary(PChar('user32.dll'));
    if( NULL=hUserMod ) then
    begin
      Result:=FALSE;
      Exit;
    end;
    ChangeWindowMessageFilter:=GetProcAddress(hUserMod,'ChangeWindowMessageFilter');
    if not Assigned(ChangeWindowMessageFilter) then
    begin
        Result:= FALSE;
        Exit;
    end;
    if bAllow then
    bResult:= ChangeWindowMessageFilter(uMessageID,  1  )
    else
      bResult:=ChangeWindowMessageFilter(uMessageID, 2);//MSGFLT_ADD: 1, MSGFLT_REMOVE: 2


    if( NULL <> hUserMod )   then
    begin
        FreeLibrary( hUserMod );
    end;


    result:= bResult;


end;


procedure TForm1.DragDropFile(var message: TMessage);
begin
  showmessage('DragDropFile');//只须这句就行了
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
 DragAcceptFiles(Handle,true);
 AllowMeesageForVistaAbove(SPI_SETANIMATION,True);


  //allow drop files
  AllowMeesageForVistaAbove(WM_DROPFILES, True);
end;


end.