在winowsXp环境下，delphi7开发的程序，拖拽功能在win8下无法使用

Question

unit Unit1;interface
在win8下无法使用拖拽功能 是因为没注册拖拽功能 所以不能用
win8下系统服务和桌面程序已经隔离了，所以许多通信机制失效了
用下面的注册一下 就可以了
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.

Answer 1

procedure TForm1.FormCreate(Sender: TObject);
begin
  DragAcceptFiles(pnl1.Handle,true);
  OLDWndProc := Self.pnl1.WindowProc;
  Self.pnl1.WindowProc := Self.DragDropFile;
end;
procedure TForm1.DragDropFile(var msg:TMessage);
begin
  mmo1.Lines.Add(inttostr(msg.Msg));
  if msg.Msg = WM_DropFiles then
  begin
    showmessage('DragDropFile');//只须这句就行了
  end
  else
  begin
    OLDWndProc(msg);
  end;
end;测试发现确实没有WM_DropFiles 消息

Answer 2

确实是这样，加上
 AllowMeesageForVistaAbove(SPI_SETANIMATION,True);  //allow drop files
  AllowMeesageForVistaAbove(WM_DROPFILES, True);
就可以了

Answer 3

当年做开发时，客户的vista系统也不支持拖拽，忘记怎么解决的了