[Delphi] drag/drop z poza formy...

0

Mamy na formie np. Edit. Ktoś wie jak zrobić żeby przeciągnąć z pulpitu jakiś plik w pole edita tak, żeby edit.text miał pełną ścieżkę do pliku...
Dzięki :-)

--
A poza tym, chętnie zagram z kimś w szachy... ;)

0

Tu jest mój komponent wykorzystujący mechanizm D&D z Eksploratora (również pulpitu). Nie chce mi się wydzielać z tego i przerabiać na oddzielny kod części dot. przeciągania elementów. Fragment dot. D&D jest zaznaczony.

unit Drzewo;

/////////////////////////////////////////////////////////
*TDrzewo - Copyright©2001 Stolarski and Company; *
Uwaga: przed usunięciem ustawić AcceptFiles na false;
/////////////////////////////////////////////////////////

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls,ShellApi,shlobj;
type
TFileDropEvent = procedure(Files: Tstrings; X, Y: Integer) of object;

type
TDrzewo = class(TCustomTreeView)
private
{ Private declarations }
FAcceptFiles: Boolean;
FOnFileDrop: TFileDropEvent;
FDysk:string;
FOnExpanding:TTVExpandingEvent;
procedure WMDROPFILES(var Msg: TWMDropFiles); message WM_DROPFILES;
procedure SetAcceptFiles(Accept: Boolean);
protected
{ Protected declarations }
procedure Loaded; override;
procedure Dysk(dysk:string);
procedure Folder(const katalog:string;nazwa:TTreeNode);
function Znajdz(Node:TTreeNode;nazwa:string):boolean;
procedure Expand(Node:TTreeNode);override;
public
{ Public declarations }
constructor Create(AOwner:TComponent);override;
destructor Destroy;override;
function Sciezka(Node:TTreeNode):string;
function Path:string;
function Child(Nazwa:string):TTreeNode;
procedure Odswiez;
property Selected;
property DropTarget;
property TopItem;
property Brush;
property ClientOrigin;
property ClientRect;
property ControlCount;
property Controls;
property Handle;
property ParentWindow;
property Showing;
property BoundsRect;
property ClientHeight;
property ClientWidth;
property ControlState;
property ControlStyle;
property Parent;
property WindowProc;
property ComObject;
property ComponentCount;
property ComponentIndex;
property Components;
property ComponentState;
property ComponentStyle;
property DesignInfo;
property Owner;
property VCLComObject;
published
{ Published declarations }
property Drive:string read FDysk write Dysk;
property AcceptFiles: Boolean read FAcceptFiles write SetAcceptFiles;
property OnFileDrop: TFileDropEvent read FOnFileDrop write FOnFileDrop;
property BorderStyle;
property DragMode;
property HideSelection;
//property Images;
property Indent;
property Items;
property ShowButtons;
property ShowLines;
property ShowRoot;
//property SortType;
//property StateImages;
property ReadOnly;
property Ctl3D;
property HelpContext;
property ParentCtl3D;
property TabOrder;
property TabStop;
property Align;
property Color;
property Cursor;
property DragCursor;
property Enabled;
property Font;
property Height;
property Hint;
property Left;
property Name;
property ParentColor;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property Top;
property Visible;
property Width;
property Tag;
property OnChange;
property OnChanging;
property OnCollapsed;
property OnCollapsing;
property OnCompare;
property OnDeletion;
property OnEdited;
property OnEditing;
property OnExpanded;
property OnGetImageIndex;
property OnGetSelectedIndex;
property OnExpanding:TTVExpandingEvent read FOnExpanding write FOnExpanding;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDrag;
end;

procedure Register;

var
ImageList:TImageList;
Dir,IconList:TShFileInfo;

implementation

procedure Register;
begin
RegisterComponents('Samples', [TDrzewo]);
end;

constructor TDrzewo.Create(AOwner:TComponent);
begin
ImageList:=TImageList.Create(self);
ImageList.ShareImages:=true;
ImageList.Handle:=ShGetFileInfo('',0,IconList,SizeOf(IconList),shgfi_SysIconIndex or shgfi_SmallIcon);
FAcceptFiles:=false;
FDysk:='';
inherited Create(AOwner);
end;

function TDrzewo.Child(Nazwa:string):TTreeNode;
var
Node:TTreeNode;
begin
Result:=nil;
Node:=TDrzewo(self).Selected.GetFirstChild;
if Node.Text=Nazwa then begin
Result:=Node;
Exit;
end;
while Nodenil do begin
Node:=TDrzewo(self).Selected.GetNextChild(Node);
if Node.Text=Nazwa then begin
Result:=Node;
Exit;
end;
end;
end;

procedure TDrzewo.Loaded;
begin
if not(csDesigning in ComponentState)then DragAcceptFiles(Handle,FAcceptFiles);
end;

destructor TDrzewo.Destroy;
begin
//if not(csDesigning in ComponentState)then DragAcceptFiles(Handle,FAcceptFiles);
ImageList.Free;
inherited Destroy;
end;

//Drag & Drop
procedure TDrzewo.WMDROPFILES(var Msg: TWMDropFiles);
var
i, DropCount, BufSize: integer;
FileName: pChar;
FileList: TStrings;
Point: TPoint;
begin
BufSize := 0;
DropCount := DragQueryFile(Msg.Drop, $FFFFFFFF, nil, BufSize);
FileList := TStringList.Create;
try
for i := 0 to DropCount - 1 do begin
BufSize := DragQueryFile(Msg.Drop, i, nil, BufSize) + 1;
FileName := StrAlloc(BufSize + 1);
try
DragQueryFile(Msg.Drop, i, FileName, BufSize);
FileList.Add(FileName);
DragQueryPoint(Msg.Drop, Point);
finally
StrDispose(FileName);
end;
end;
DragFinish(Msg.Drop);
if Assigned(FOnFile
Drop) then
FOnFileDrop(FileList, Point.X, Point.Y)
finally
FileList.Free;
end;
end;

procedure TDrzewo.SetAcceptFiles(Accept: Boolean);
begin
if not(csDesigning in ComponentState) then
DragAcceptFiles(Handle, Accept);
FAcceptFiles := Accept;
end;
//

procedure TDrzewo.Dysk(dysk:string);
var
Node:TTreeNode;
typ:array[0..2]of Char;
begin
if dysk=FDysk then Exit;
TDrzewo(self).Items.Clear;
FDysk:=dysk;
Node:=TDrzewo(Self).Items.AddFirst(nil,dysk);
StrPCopy(typ,dysk);
case GetDriveType(typ) of
DRIVE_REMOVABLE:begin
Node.ImageIndex:=6;
Node.SelectedIndex:=6;
end;
DRIVE_FIXED:begin
Node.ImageIndex:=8;
Node.SelectedIndex:=8;
end;
DRIVE_REMOTE:begin
Node.ImageIndex:=9;
Node.SelectedIndex:=9;
end;
DRIVE_CDROM:begin
Node.ImageIndex:=11;
Node.SelectedIndex:=11;
end;
DRIVE_RAMDISK:begin
Node.ImageIndex:=12;
Node.SelectedIndex:=12;
end;
else begin
Node.ImageIndex:=8;
Node.SelectedIndex:=8;
end;
end;
Folder(dysk,Node);
TDrzewo(self).AlphaSort;
end;

function TDrzewo.Znajdz(Node:TTreeNode;nazwa:string):boolean;
var
x:integer;
begin
Result:=true;
for x:=0 to Node.Count-1 do
if Node.Item[x].Text=nazwa then Exit;
Result:=false;
end;

procedure TDrzewo.Folder(const katalog:string;nazwa:TTreeNode);
var
SR:TSearchRec;
Found:Integer;
Node:TTreeNode;
Buf:array[0..259]of Char;
begin
TDrzewo(self).Images:=ImageList;
Found:=FindFirst(katalog+'\.',faAnyFile,SR);
try
while (Found=0) do begin
if (SR.Name'.')and(SR.Name'..') then
if (SR.Attr and faDirectory)0 then begin
if not Znajdz(nazwa,SR.Name) then begin
Node:=TDrzewo(Self).Items.AddChild(nazwa,SR.Name);
StrPCopy(Buf,sciezka(Node)+SR.Name);
ShGetFileInfo(Buf,0,Dir,SizeOf(Dir),SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
Node.ImageIndex:=Dir.iIcon;
ShGetFileInfo(Buf,0,Dir,SizeOf(Dir),SHGFI_OPENICON or SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
Node.SelectedIndex:=Dir.iIcon;
end;
end;
Found:=FindNext(SR);
end;
finally
FindClose(SR);
end;
end;

function TDrzewo.Sciezka(Node:TTreeNode):string;
begin
if Node.Level>0 then
Result:=Sciezka(Node.Parent)+Node.Parent.Text+'\'
else
Result:='';
end;

procedure TDrzewo.Expand(Node:TTreeNode);
var
SubNode:TTreeNode;
allow:boolean;
begin
inherited Expand(Node);
if Assigned(OnExpanding) then OnExpanding(Self,Node,allow);
SubNode:=Node.GetFirstChild;
SubNode.AlphaSort;
while SubNodenil do begin
Folder(Sciezka(SubNode)+SubNode.text,SubNode);
SubNode.AlphaSort;
SubNode:=Node.GetNextChild(SubNode);
end;
end;

function TDrzewo.Path:string;
var
zaznaczony:TTreeNode;
begin
zaznaczony:=TDrzewo(self).Selected;
if zaznaczonynil then
Result:=Sciezka(zaznaczony)+zaznaczony.Text
else
Result:='';
end;

procedure TDrzewo.Odswiez;
var
SR:TSearchRec;
Found,x:integer;
Node:TTreeNode;
znalezione:boolean;
begin
for x:=0 to TDrzewo(Self).Items.Count-1 do begin
Node:=TDrzewo(Self).Items.Item[x];
if Node.Expanded then
Folder(Sciezka(Node)+Node.text,Node);
end;

x:=0;
repeat
Inc(x);
znalezione:=false;
Node:=TDrzewo(Self).Items.Item[x];
Found:=FindFirst(Sciezka(Node)+Node.Text+'.*',faAnyFile,SR);
try
while (Found=0) do begin
if (SR.Name'.')and(SR.Name'..') then
if (SR.Attr and faDirectory)0 then
if SR.Name=Node.Text then begin
znalezione:=true;
Break;
end;
Found:=FindNext(SR);
end;
finally
FindClose(SR);
if not znalezione then Node.Delete;
end;
until x>=TDrzewo(Self).Items.Count-1;
end;

end.

P.S. Jakby komuś przyszło do głowy instalować ten komponent, to ostrzegam, że ikonki dysków nie będą się zgadzać z akutalnymi o ile nie pracujecie w Windows 95 (pisałem to jakieś 4 lata temu...)

--
Jest jeszcze jeden błąd ... :)
--------Oficjalny kanał----------
Service for programmers w IRC:
Kanał: #4programmers
Serwer: warszawa.ircnet.pl
Sieć: POLNet
Port: 6667

1 użytkowników online, w tym zalogowanych: 0, gości: 1