注册 登录  
 加关注
   显示下一条  |  关闭
温馨提示!由于新浪微博认证机制调整,您的新浪微博帐号绑定已过期,请重新绑定!立即重新绑定新浪微博》  |  关闭

BCB-DG's Blog

...

 
 
 

日志

 
 

DragFromShell  

2008-11-25 14:26:33|  分类: Delphi |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |

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;

  评论这张
 
阅读(661)| 评论(0)
推荐 转载

历史上的今天

评论

<#--最新日志,群博日志--> <#--推荐日志--> <#--引用记录--> <#--博主推荐--> <#--随机阅读--> <#--首页推荐--> <#--历史上的今天--> <#--被推荐日志--> <#--上一篇,下一篇--> <#-- 热度 --> <#-- 网易新闻广告 --> <#--右边模块结构--> <#--评论模块结构--> <#--引用模块结构--> <#--博主发起的投票-->
 
 
 
 
 
 
 
 
 
 
 
 
 
 

页脚

网易公司版权所有 ©1997-2017