was ist neu ¦  programmier tips ¦  indy artikel ¦  intraweb artikel ¦  informationen ¦  links ¦  interviews
 sonstiges ¦  tutorials ¦  Add&Win Gewinnspiel

Tips (1541)

Dateien (137)
Datenbanken (90)
Drucken (35)
Grafik (114)
IDE (21)
Indy (5)
Internet / LAN (130)
IntraWeb (0)
Mathematik (76)
Multimedia (45)
Oberfläche (107)
Objekte/
ActiveX (51)

OpenTools API (3)
Sonstiges (126)
Strings (83)
System (266)
VCL (242)

Tips sortiert nach
Komponente


Tip suchen

Tip hinzufügen

Add&Win Gewinnspiel

Werbung

38 Visitors Online


 
...Dateien von der eigenen Anwendung per Drag and Drop zum Windows Explorer kopieren?
Autor: R.Kleinpeter
[ Tip ausdrucken ]  

Tip Bewertung (71):  
     


{This example will show you how your application
will be able to copy files from your application to
Windows Explorer using Drag'n Drop.
Exactly the way it is done by the OS itself!

Create a new application containing just one unit,
called 'Unit1'. Drop a FileListBox and a DirectoryListBox on to the form,
leave their names the way they are.
Connect FileListBox1 with DirectoryListBox1 by setting the FileList-property of
DirectoryListBox1. Make sure that the MultiSelect-property of FileListBox1 is set to 'True'!

The best thing you can do now is to replace all text with the code below:}

//---------------------------------------------

unit Unit1;

interface

uses
  
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs,
  StdCtrls, FileCtrl, ActiveX, ShlObj, ComObj;

type
  
TForm1 = class(TForm, IDropSource)
    FileListBox1: TFileListBox;
    DirectoryListBox1: TDirectoryListBox;
    procedure FileListBox1MouseDown(Sender: TObject; Button:
      TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FileListBox1MouseMove(Sender: TObject; Shift: TShiftState;
      X,
      Y: Integer);
  private
    
FDragStartPos: TPoint;
    function QueryContinueDrag(fEscapePressed: BOOL;
      grfKeyState: Longint): HResult; stdcall;
    function GiveFeedback(dwEffect: Longint): HResult; stdcall;
  public
  end
;

var
  
Form1: TForm1;

implementation

{$R *.DFM}

function GetFileListDataObject(const Directory: string; Files:
  TStrings):
  IDataObject;
type
  
PArrayOfPItemIDList = ^TArrayOfPItemIDList;
  TArrayOfPItemIDList = array[0..0] of PItemIDList;
var
  
Malloc: IMalloc;
  Root: IShellFolder;
  FolderPidl: PItemIDList;
  Folder: IShellFolder;
  p: PArrayOfPItemIDList;
  chEaten: ULONG;
  dwAttributes: ULONG;
  FileCount: Integer;
  i: Integer;
begin
  
Result := nil;
  if Files.Count = 0 then
    
Exit;
  OleCheck(SHGetMalloc(Malloc));
  OleCheck(SHGetDesktopFolder(Root));
  OleCheck(Root.ParseDisplayName(0, nil,
    PWideChar(WideString(Directory)),
    chEaten, FolderPidl, dwAttributes));
  try
    
OleCheck(Root.BindToObject(FolderPidl, nil, IShellFolder,
      Pointer(Folder)));
    FileCount := Files.Count;
    p := AllocMem(SizeOf(PItemIDList) * FileCount);
    try
      for 
i := 0 to FileCount - 1 do
      begin
        
OleCheck(Folder.ParseDisplayName(0, nil,
          PWideChar(WideString(Files[i])), chEaten, p^[i],
          dwAttributes));
      end;
      OleCheck(Folder.GetUIObjectOf(0, FileCount, p^[0], IDataObject,
        nil,
        Pointer(Result)));
    finally
      for 
i := 0 to FileCount - 1 do begin
        if 
p^[i] <> nil then Malloc.Free(p^[i]);
      end;
      FreeMem(p);
    end;
  finally
    
Malloc.Free(FolderPidl);
  end;
end;

function TForm1.QueryContinueDrag(fEscapePressed: BOOL;
  grfKeyState: Longint): HResult; stdcall;
begin
  if 
fEscapePressed or (grfKeyState and MK_RBUTTON = MK_RBUTTON) then
  begin
    
Result := DRAGDROP_S_CANCEL
  end else if grfKeyState and MK_LBUTTON = 0 then
  begin
    
Result := DRAGDROP_S_DROP
  end else
  begin
    
Result := S_OK;
  end;
end;

function TForm1.GiveFeedback(dwEffect: Longint): HResult; stdcall;
begin
  
Result := DRAGDROP_S_USEDEFAULTCURSORS;
end;

procedure TForm1.FileListBox1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if 
Button = mbLeft then
  begin
    
FDragStartPos.x := X;
    FDragStartPos.y := Y;
  end;
end;

procedure TForm1.FileListBox1MouseMove(Sender: TObject; Shift:
  TShiftState;
  X, Y: Integer);
const
  
Threshold = 5;
var
  
SelFileList: TStrings;
  i: Integer;
  DataObject: IDataObject;
  Effect: DWORD;
begin
  with 
Sender as TFileListBox do
  begin
    if 
(SelCount > 0) and (csLButtonDown in ControlState)
      and ((Abs(X - FDragStartPos.x) >= Threshold)
      or (Abs(Y - FDragStartPos.y) >= Threshold)) then
      begin
      
Perform(WM_LBUTTONUP, 0, MakeLong(X, Y));
      SelFileList := TStringList.Create;
      try
        
SelFileList.Capacity := SelCount;
        for i := 0 to Items.Count - 1 do
          if 
Selected[i] then SelFileList.Add(Items[i]);
        DataObject := GetFileListDataObject(Directory, SelFileList);
      finally
        
SelFileList.Free;
      end;
      Effect := DROPEFFECT_NONE;
      DoDragDrop(DataObject, Self, DROPEFFECT_COPY, Effect);
    end;
  end;
end;

initialization
  
OleInitialize(nil);
finalization
  
OleUninitialize;
end.

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
{
As you might have seen, TForm1 is not only a member of class TForm,
but also of class IDropSource!

Now make sure that the two FileListBox events
'OnMouseMove' and 'OnMouseDown' are set correctly.

Run your application and try out the Drag and Drop feature!
You can select multiple items to drag and press escape to cancel.
The cursor will show you what action will take place.
}



 

Bewerten Sie diesen Tipp:

dürftig
ausgezeichnet


Copyright © by SwissDelphiCenter.ch
All trademarks are the sole property of their respective owners