捐赠 | 广告 | 注册 | 发布 | 上传 | 关于我们    
  粤ICP备10103342号-1 DELPHI盒子 | 盒子文章 | 盒子问答悬赏 | 最新更新 | 盒子检索 | 下载中心 | 高级搜索    
  精品专区 | 繁體中文 | 奖励公告栏 | 直通车账号登陆 | 关闭GOOGLE广告 | 临时留言    
盒子资源分类
全部展开 - 全部合拢
让程序支持外来文件拖放的单元文件
关键字:uDragFromShell 文件拖放
来 自:原创
平 台:Win2k/XP/NT,Win2003 下载所需:0 火柴
深浅度:中级 完成时间:2007/11/2
发布者:senfore 发布时间:2007/11/2
编辑器:DELPHI7 语  种:简体中文
分 类:不常用 下载浏览:0/9803
加入到我的收藏
下载错误报错
登陆以后才能下载
 用户名:
 密 码:
自动登陆(30天有效)
无图片
unit uDragFromShell;
{  单元名称:uDragFromShell
   单元说明:让TwinControl控件能接收外来的文件拖放
   其它声明:senfore收集修改,盒子首发:www.2ccc.com}
interface

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

type

TShellDragEvent = procedure(Sender: Tobject; Filename: string) of object;
TDragFromShell = class(Tcomponent)
private
  FOwnerHandle: Thandle;
  FOldAownerWindowProc: Pointer;
  FOnShellDragDrop: TShellDragEvent;
  procedure AownerWindowProc(var Message: TMessage);
  procedure SetOnShellDragDrop(const Value: TShellDragEvent);
protected
  procedure DoShellDragDrop(filename: string);
public
  constructor Create(Aowner: Tcomponent); override;
  destructor Destroy; override;
published
  property OnShellDragDrop: TShellDragEvent read FOnShellDragDrop write SetOnShellDragDrop;
end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Arn:o)', [TDragFromShell]);
end;

{ TDragFromShell }

procedure TDragFromShell.AownerWindowProc(var Message: TMessage);
var
count, index, hdrop: integer;
Pfilename: pchar;
begin
  if Message.MSG <> WM_DROPFILES then
    Message.Result := CallWindowProc(FOldAownerWindowProc, FOwnerHandle, Message.Msg, Message.WPARAM, Message.LPARAM) else
  begin
    Hdrop := message.WParam;
    Getmem(pfilename, Max_path);
    Count := DragQueryfile(hdrop, maxdword, Pfilename, max_path - 1);
    for index := 0 to count - 1 do
    begin
      DragQueryfile(Hdrop, index, Pfilename, maxbyte);
      DoShellDragDrop(StrPas(Pfilename));
    end;
    Freemem(Pfilename);
    Dragfinish(Hdrop);
  end;
end;

constructor TDragFromShell.Create(Aowner: Tcomponent);
begin
  FOldAownerWindowProc := nil;
  if not (Aowner is Twincontrol) then
  begin
    raise Exception.Create('The DragFromShell''s Owner must be a TWinControl');
  end;
  inherited;
  FOwnerHandle := Twincontrol(Aowner).handle;
  DragAcceptFiles(FOwnerHandle, true);
  FOldAownerWindowProc := Pointer(GetWindowLong(FOwnerHandle, GWL_WNDPROC));
  SetWindowLong(FOwnerHandle, GWL_WNDPROC, integer(MakeObjectInstance(AownerWindowProc)));
end;

destructor TDragFromShell.Destroy;
begin
  DragAcceptFiles(FOwnerHandle, false);
  SetWindowLong(FOwnerHandle, GWL_WNDPROC, Integer(FOldAownerWindowProc));
  inherited;
end;

procedure TDragFromShell.DoShellDragDrop(filename: string);
begin
  if Assigned(fonshellDragDrop) then
    fonshellDragDrop(Self, Filename);
end;

procedure TDragFromShell.SetOnShellDragDrop(const Value: TShellDragEvent);
begin
  FOnShellDragDrop := Value;
end;

end.

示例:这里给出了使用uDragFromShell的关键代码。

interface
uses uDragFromShell;

type
TDlgDragDrop = class(TForm)
...
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
  DragFromShell:TDragFromShell;
  procedure DropFiles(Sender: Tobject; Filename: string);
end;

implementation

procedure TDlgDragDrop.FormCreate(Sender: TObject);
begin
  DragFromShell:=TDragFromShell.Create(self);
  DragFromShell.OnShellDragDrop:=DropFiles;
end;

procedure TDlgDragDrop.FormDestroy(Sender: TObject);
begin
  DragFromShell.Free;
end;

procedure TDlgDragDrop.DropFiles(Sender: Tobject; Filename: string);
begin
  SendMessage(application.MainForm.Handle, FCP_FILEOPEN, 0, Integer(Filename));
  //这里是拖放文件的具体处理代码
end;
Google
 
本站原创作品,未经作者许可,严禁任何方式转载;转载作品,如果侵犯了您的权益,请联系我们
龙脉加密锁 15元起 Grid++Report 报表 申请支付@网
 相关文章
让程序支持外来文件拖放的单元文件
senfore 2007/11/2 下+0/浏+9804 评+3
让程序支持外来文本拖放的单元文件
senfore 2007/11/1 下+0/浏+9277 评+4
相关评论
共有评论3条
我要发表评论 查看全部评论
 
  DELPHI盒子版权所有 技术支持:深圳市麟瑞科技有限公司 1999-2024 V4.01 粤ICP备10103342号-1 更新RSS列表