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;