Kod: Tümünü seç
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.
DoDragDrop(DataObject, Self, DROPEFFECT_COPY, Effect);
Bu satirda hata aliyorum, sebebi nedir acaba ?
