-----------开发环境D7-在后续的控件开发中，没有特别注明，开发环境都是D7---------
学习，只供学习！
写控件，和使用，控件没有安装；
-----------------
------------------Unit1开始---有窗体------
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, unit2;
type
TForm1 = class(TForm)
Button1: TButton;
Panel1: TPanel;
Memo1: TMemo;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
procedure DropFiles(Receiver: TWinControl;
const FileNames: TStrings;const FilesCount: Integer;
const DropPoint: TPoint) ;
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
var
uDragging:TlxpDraggingFilesMonitor;
{$R *.dfm}
{ TDropFilesEvent = procedure(Receiver: TWinControl;
const FileNames: TStrings;const FilesCount: Integer;
const DropPoint: TPoint) of object;}
procedure TForm1.Button1Click(Sender: TObject);
begin
uDragging:= TlxpDraggingFilesMonitor.Create(self);
uDragging.AcceptFilesControl:=Panel1;
uDragging.OnDropFiles :=DropFiles;
Button1.Enabled:=false;
Button2.Enabled:=True;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
FreeAndNil(uDragging);
Button1.Enabled:=True;
Button2.Enabled:=false;
end;
procedure TForm1.DropFiles(Receiver: TWinControl;
const FileNames: TStrings; const FilesCount: Integer;
const DropPoint: TPoint);
begin
Memo1.Lines:= FileNames;
end;
end.
-------------------Unit1结束--------------------
------------------Unit2开始-----组件所在的单元----
------大佬的-----
unit Unit2;
interface
Uses
Windows, Controls, Classes, Messages, ShellApi, SysUtils;
type
TDropFilesEvent = procedure(Receiver: TWinControl;
const FileNames: TStrings;const FilesCount: Integer;
const DropPoint: TPoint) of object;
TlxpDraggingFilesMonitor = class(TComponent)
{由于组件在运行时不需要可见，所以从TComponent派生}
private
FAcceptFilesControl: TWinControl; {指定接收者}
OldWindowProc: TWndMethod; {保存FAcceptFilesControl原来的窗口过程}
FFilesName: TStrings; {拖放的文件名列表}
FOnDropFiles: TDropFilesEvent; {拖放事件}
procedure SetAcceptFilesControl(const Value: TWinControl);
protected
{FAcceptFilesControl新的窗口过程}
procedure NewWindowProc(var Message: TMessage);
procedure Notification(
AComponent: TComponent; Operation: TOperation); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property AcceptFilesControl: TWinControl read FAcceptFilesControl
write SetAcceptFilesControl;
property OnDropFiles: TDropFilesEvent read FOnDropFiles write FOnDropFiles;
end;
implementation
constructor TlxpDraggingFilesMonitor.Create(AOwner: TComponent);
begin
inherited;
FFilesName := TStringList.Create;
end;
destructor TlxpDraggingFilesMonitor.Destroy;
begin
if Assigned(FAcceptFilesControl) then
DragAcceptFiles(FAcceptFilesControl.Handle, False);
{注销文件拖放监视器}
FreeAndNil(FFilesName);
inherited;
end;
procedure TlxpDraggingFilesMonitor.SetAcceptFilesControl(
const Value: TWinControl);
begin
if FAcceptFilesControl <> Value then
begin
if Assigned(Value) and (not (csDesigning in ComponentState)) then
{设计时不执行下列代码}
begin
DragAcceptFiles(Value.Handle, True); {注册文件拖放监视器}
OldWindowProc := Value.WindowProc; {首先保存过程WindowProc 的指针}
Value.WindowProc := NewWindowProc; {给WindowProc 赋予新过程的地址}
end;
FAcceptFilesControl := Value;
FAcceptFilesControl.FreeNotification(Self);
{注册AcceptFilesControl，确保它被销毁时通知这个组件}
end;
end;
{在这个过程里处理文件拖放消息}
procedure TlxpDraggingFilesMonitor.NewWindowProc(var Message: TMessage);
var
Count, Index, hDrop: Integer;
PFileName: PChar;
P: TPoint;
begin
if Message.Msg = WM_DROPFILES then {如果是文件拖放消息}
begin
hDrop := Message.WParam;
FFilesName.Clear;
GetMem(PFileName, MAX_PATH); {给缓冲区PFileName 分配空间}
Count := DragQueryFile(hDrop, MAXDWORD, PFileName, MAX_PATH-1);
{取得文件总个数}
for Index := 0 to Count-1 do
begin
DragQueryFile(hDrop, Index, PFileName, MAXBYTE);
{得到每个文件的名字}
FFilesName.Add(PFileName);
end;
DragQueryPoint(hDrop, P); {取得鼠标松开时的位置，保存到P}
if Assigned(FOnDropFiles) then {如果用户书写了事件代码，则触发事件}
FOnDropFiles(FAcceptFilesControl, FFilesName, Count, P);
FreeMem(PFileName); {释放缓冲区空间}
DragFinish(hDrop); {完成本次拖放}
end else
OldWindowProc(Message); {调用原来的WindowProc 过程处理别的消息}
end;
procedure TlxpDraggingFilesMonitor.Notification(
AComponent:TComponent; Operation: TOperation);
begin
inherited;
if (AComponent = FAcceptFilesControl) and (Operation = opRemove)
then
FAcceptFilesControl := nil;
end;
end.
-------------------Unit2结束--------------------
-------------Form--开始------
object Form1: TForm1
Left = 381
Top = 163
Width = 561
Height = 509
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object Button1: TButton
Left = 352
Top = 296
Width = 75
Height = 25
Caption = '启用拖拽'
TabOrder = 0
OnClick = Button1Click
end
object Panel1: TPanel
Left = 64
Top = 256
Width = 233
Height = 177
Caption = '文件拖到这里'
TabOrder = 1
end
object Memo1: TMemo
Left = 24
Top = 8
Width = 449
Height = 209
Lines.Strings = (
'Memo1')
TabOrder = 2
end
object Button2: TButton
Left = 352
Top = 344
Width = 75
Height = 25
Caption = '关闭拖拽'
Enabled = False
TabOrder = 3
OnClick = Button2Click
end
end
--------------Form 结束---------
