Mega Code Archive
4 elinizin altında olması gereken kodlar 4 [file drag drop]
<![CDATA[
//www.dronymc.cjb.net
//drony@mynet.com
//icq:266148308
unit DragFromShell;
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('Plus', [TDragFromShell]);
end;
{ TDragFromShell }
procedure TDragFromShell.AownerWindowProc(var Message: TMessage);
var
S:String;
i,nb:integer;
begin
if Message.MSG<>WM_DROPFILES then
Message.Result:=CallWindowProc(FOldAownerWindowProc,FOwnerHandle,Message.Msg,Message.WPARAM,Message.LPARAM) else
begin
SetLength(s,256);
nb:=DragQueryFile(Message.wparam,$FFFFFFFF,pChar(s),255);
for i:=0 to nb-1 do
begin
DragQueryFile(Message.wparam,i,pChar(s),255);
DoShellDragDrop(trim(s));
end;
DragFinish(Message.WParam);
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
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.
]]>