在winowsXp环境下，delphi7开发的程序，拖拽功能在win8下无法使用解决办法
在winowsXp环境下，delphi7开发的程序，拖拽功能在win8下无法使用
在winowsXp环境下，delphi7开发的程序，拖拽功能在win8下无法使用，在win7下能正常使用
代码类似这样
procedure TForm1.DragDropFile(var message:TMessage);
begin
showmessage('DragDropFile');//只须这句就行了
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
DragAcceptFiles(Handle,true);
end;
end.
------解决思路----------------------
------解决思路----------------------
在winowsXp环境下，delphi7开发的程序，拖拽功能在win8下无法使用，在win7下能正常使用
代码类似这样
procedure TForm1.DragDropFile(var message:TMessage);
begin
showmessage('DragDropFile');//只须这句就行了
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
DragAcceptFiles(Handle,true);
end;
end.
------解决思路----------------------
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.
------解决思路----------------------
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 消息