unit1.pas

来自「Drag files and Drop to delphi forms 0402」· PAS 代码 · 共 580 行 · 第 1/2 页

unit Unit1;

interface

uses
  DragDrop,
  DropSource,
  DropTarget,
  DragDropPIDL,
  PathComboBox,
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, ActiveX, ShellApi, ShlObj, Buttons, ExtCtrls,StdCtrls, CommCtrl;

type

  TForm1 = class(TForm)
    ListView1: TListView;
    Panel1: TPanel;
    DropPIDLSource1: TDropPIDLSource;
    Button1: TButton;
    StatusBar1: TStatusBar;
    Label1: TLabel;
    DropPIDLTarget1: TDropPIDLTarget;
    sbUpLevel: TSpeedButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ListView1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button1Click(Sender: TObject);
    procedure ListView1DblClick(Sender: TObject);
    procedure ListView1KeyPress(Sender: TObject; var Key: Char);
    procedure DropPIDLTarget1Drop(Sender: TObject; ShiftState: TShiftState;
      Point: TPoint; var Effect: Integer);
    procedure sbUpLevelClick(Sender: TObject);
    procedure DropPIDLTarget1DragOver(Sender: TObject;
      ShiftState: TShiftState; Point: TPoint; var Effect: Integer);
  private
    CurrentShellFolder: IShellFolder;
    CurrentFolderImageIndex: integer;
    FImageList: TImageList;
    FRecyclePIDL: pItemIdList;
    FIsDragging: boolean;

    //custom component NOT installed in the IDE...
    PathComboBox: TPathComboBox;
    procedure PathComboBoxChange(Sender: TObject);

    procedure SetCurrentFolder;
    procedure RefreshListNames;
    procedure PopulateListview;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;


implementation

{$R *.DFM}

//---------------------------------------------------------------------
// TLVItemData class
// (objects used to store extra data with each Listview item)
//---------------------------------------------------------------------

type
  TLVItemData = class
    SortStr: string; {just used to sort the listview}
    RelativePIDL: pItemIDList; {each item stores its own PIDLs}
    AbsolutePIDL: pItemIDList;
  public
    destructor Destroy; override;
  end;


destructor TLVItemData.Destroy;
begin
  //nb: ShellMalloc interface declared and assigned in DropSource.pas
  ShellMalloc.Free(RelativePIDL);
  ShellMalloc.Free(AbsolutePIDL);
  inherited;
end;

//---------------------------------------------------------------------
// Local functions ...
//---------------------------------------------------------------------

//Used to sort the listview...
function ListviewSort(Item1, Item2: TListItem;
  lParam: Integer): Integer; stdcall;
Begin
  if (Item1<>nil) and (Item2<>nil) and (Item1<>Item2) then
    Result:= lstrcmpi( pChar(TLVItemData(Item1.Data).SortStr),
      pChar(TLVItemData(Item2.Data).SortStr) )
  else Result:=0;
End;
//---------------------------------------------------------------------

//Just used for sorting listview...
function GetPathName(Folder: IShellFolder; Pidl: PItemIdList): String;
var StrRet: TStrRet;
Begin
  Result:='';
  Folder.GetDisplayNameOf(Pidl,SHGDN_FORPARSING,StrRet);
  case StrRet.uType of
    STRRET_WSTR: Result:=WideCharToString(StrRet.pOleStr);
    STRRET_OFFSET: Result:=PChar(UINT(Pidl)+StrRet.uOffset);
    STRRET_CSTR: Result:=StrRet.cStr;
  End;
end;

//---------------------------------------------------------------------
// TForm1 class ...
//---------------------------------------------------------------------

procedure TForm1.FormCreate(Sender: TObject);
var
  sfi: TShFileInfo;
begin

  //get access to the shell imagelist...
  FImageList := TImageList.create(self);
  FImageList.handle :=
    shgetfileinfo('',0,sfi,sizeof(tshfileinfo), shgfi_sysiconindex or shgfi_smallicon);
  FImageList.shareimages := true;
  FImageList.BlendColor := clHighlight;
  Listview1.SmallImages := FImageList;

  //Create our custom component...
  PathComboBox := TPathComboBox.create(self);
  PathComboBox.parent := self;
  PathComboBox.top := 35;
  PathComboBox.left := 2;
  PathComboBox.width := 434;
  PathComboBox.ShowVirtualFolders := true;
  PathComboBox.OnChange := PathComboBoxChange;
  PathComboBox.path := extractfilepath(paramstr(0));

  //SetCurrentFolder;
  DropPIDLTarget1.register(Listview1);

  fRecyclePIDL := nil;
  ShGetSpecialFolderLocation(0,CSIDL_BITBUCKET	,fRecyclePIDL);
end;
//---------------------------------------------------------------------

procedure TForm1.FormDestroy(Sender: TObject);
var
  i: integer;
begin
  DropPIDLTarget1.unregister;

  with Listview1.items do
    for i := 0 to Count-1 do
      TLVItemData(Item[i].data).free;

  FImageList.free;
  ShellMalloc.Free(fRecyclePIDL);
end;
//---------------------------------------------------------------------

//---------------------------------------------------------------------
// Start a Drag and Drop (DropPIDLSource1.execute) ...
//---------------------------------------------------------------------
procedure TForm1.ListView1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
const
  AllowedAttribMask: Longint = (SFGAO_CANCOPY or SFGAO_CANMOVE);
var
  i: integer;
  attr: UINT;
  res: TDragResult;
  tmpImageList: TImageList;
  dummyPt: TPoint;
  DraggingFromRecycle: boolean;
  attributes: integer;
begin
  //If no files selected then exit...
  if Listview1.SelCount = 0 then
    exit;

  statusbar1.simpletext := '';
  if (DragDetectPlus(TWinControl(Sender).Handle, Point(X,Y))) then
  begin
    // OK, HOW TO KNOW IF WE'RE DRAGGING FROM THE 'RECYCLE BIN'...
    DraggingFromRecycle := False;
    // ILIsEqual() doesn't seem to work in Win95/Win98 ...
    if ILIsEqual(fRecyclePIDL,PathCombobox.pidl) then
      DraggingFromRecycle := true
    else
    begin
      // OK, not great but this works in Win95/Win98 ...
      attributes := integer(GetFileAttributes(pchar(PathCombobox.path)));
      if (attributes <> -1) and (attributes and FILE_ATTRIBUTE_HIDDEN <> 0) and
         (attributes and FILE_ATTRIBUTE_SYSTEM <> 0) then
        DraggingFromRecycle := true;
    end;

    // CopyFolderPidlToList automatically deletes anything from a previous dragdrop...
    DropPIDLSource1.CopyFolderPidlToList(PathComboBox.Pidl);
    // Fill DropSource1.Files with selected files in ListView1...
    for i := 0 to Listview1.items.Count-1 do
      if (Listview1.items.item[i].Selected) then
        with TLVItemData(Listview1.items.item[i].data) do
        begin
          // Make sure the shell allows us to drag each selected file/folder ...
          attr := AllowedAttribMask;
          CurrentShellFolder.GetAttributesOf(1,RelativePIDL,attr);
          // If not allowed to copy and move the quit drag...
          if (attr and AllowedAttribMask) = 0  then
            exit;
          DropPIDLSource1.CopyFilePidlToList(RelativePIDL);
          if DraggingFromRecycle then
            DropPIDLSource1.MappedNames.add(Listview1.items.item[i].Caption);
        end;

    // Let Listview1 draw the drag image for us ...
    tmpImageList := TImageList.Create(Self);
    try
      tmpImageList.handle :=
        ListView_CreateDragImage(Listview1.Handle, Listview1.Selected.Index, dummyPt);
      DropPIDLSource1.Images := tmpImageList;
      DropPIDLSource1.ShowImage := True;

      statusbar1.SimpleText := 'Dragging ...';

      // DropPIDLTarget1.dragtypes := [];
      // the above line has been commented out to
      // allow dropping onto self if a subfolder is the droptarget...
      // see DropPIDLTarget1DragOver()

      //Do the dragdrop...
      FIsDragging := True;
      try
        res := DropPIDLSource1.Execute;
      finally
        FIsDragging := False;
      end;

    finally
      tmpImageList.Free;
    end;

    //DropPIDLTarget1.dragtypes := [dtCopy,dtMove];

    if res in [drDropCopy, drDropMove] then
      statusbar1.simpletext := 'Drag and Drop succeeded.'
    else
      statusbar1.simpletext := 'Drag and Drop cancelled.';

    if (res <> drDropMove) then
      exit;

    // This is a real kludge, which also may not be long enough...
    // See detailed demo for a much better solution.
    sleep(1000);
    RefreshListNames;
  end;
end;


//---------------------------------------------------------------------
// DropPIDLTarget1 Methods ...
//---------------------------------------------------------------------

// If the Listview's droptarget is a system folder then
// make sure the target highlighting is done 'cleanly'...
// otherwise don't allow the drop.
procedure TForm1.DropPIDLTarget1DragOver(Sender: TObject;
  ShiftState: TShiftState; Point: TPoint; var Effect: Integer);
var
  NewTargetListItem: TListItem;
begin
  NewTargetListItem := Listview1.GetItemAt(Point.X,Point.Y);

  if (NewTargetListItem = nil) then
  begin
    // If a folder was previously a droptarget cancel its droptarget status...
    if (Listview1.DropTarget <> nil) then
    begin
      // Hide the drag image.
      DropPIDLTarget1.ShowImage := False;
      try
        // cancel current droptarget folder as droptarget...
        Listview1.DropTarget := nil;
        Listview1.Update;
      finally
        // Windows must have time to repaint the invalidated listview