在TabSet拖放中我们用下面的MouseDown事件处理过程来开始一个标签的拖动首先判断按下的是否是左键而后再判断项目是否合法
procedure TFormTabSetMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X Y: Integer)
var
DragItem: Integer;
begin
if Button = mbLeft then
begin
DragItem := TabSetItemAtPos(Point(X Y))
if (DragItem > ) and (DragItem < TabSetTabsCount) then
TabSetBeginDrag(False)
end;
end;
接收拖动项目
一个控件能否接收拖动项目是由该控件的OnDragOver事件决定的在TabSet拖动中主要是利用鼠标的位置进行判断
procedure TFormTabSetDragOver(Sender Source: TObject; X Y: Integer;
State: TDragState; var Accept: Boolean)
var
DropPos: Integer;
begin
if Source = TabSet then
begin
DropPos := TabSetItemAtPos(Point(X Y))
Accept := (DropPos > ) and (DropPos <> TabSetTabIndex) and
(DropPos < TabSetTabsCount)
end;
else
Accept := False;
end;
放下拖动项目
当OnDragOver事件处理过程返回的Accept为True且项目被放下时由OnDragDrop事件处理过程来完成拖动放下后的响应在TabSet拖放实例中是改变标签的位置
procedure TFormTabSetDragDrop(Sender Source: TObject; X Y: Integer)
var
OldPos: Integer;
NewPos: Integer;
begin
if Source = TabSet then
begin
OldPos := TabSetTabIndex;
NewPos := TabSetItemAtPos(Point(X Y))
if (NewPos > ) and (NewPos <> OldPos) then
TabSetTabsMove(OldPos NewPos)
end;
end;
结束拖动操作
结束拖动操作的方式有两种或者是用户释放了鼠标键或者是程序用EndDrag方法强行中止拖动结束拖动操作的后果有两种放下被接受或放下被忽略
拖动操作结束后源控件都要收到一条消息响应拖动结束事件OnEndDrag
拖放应用实例文件管理器的拖放支持
在第六章最后开发的文件管理器应用实例虽然功能上已初具规模但在操作上与Windows的文件管理器相比还有很大不足其中最大的缺陷是它不支持文件的拖放移动和拖放拷贝在这一章结束的时候我们可以来弥补这一缺陷了
文件拖放移动指的是当用户把一个文件拖动到目录树下的某一目录并放下时文件将自动移动到该目录中文件拖放拷贝指的是当用户把一个文件拖动到某个驱动器标签上并放下时文件将自动拷贝到该驱动器的当前目录下作为源控件的文件列表框和作为目标控件的目录树驱动器标签可以位于不同的子窗口驱动器的当前目录是任一子窗口的最新操作结果而不论这一子窗口与拖动源拖动目标是否有关系
为了实现上述功能有两个问题必须首先解决
如何记录每一驱动器的当前目录?
为此我们定义了一个全局变量
var
CurentDirList: Array[…] of string[];
在DirectoryOutline的OnChange事件中
procedure TFMFormDirectoryOutlineChange(Sender: TObject)
begin
CreateCaption;
FileListclear;
FileListDirectory := DirectoryOutlineDirectory;
FileListUpdate;
CurrentDirList[DriveTabSetTabIndex] := DirectoryOutlineDirectory;
FileManagerDirectoryPanelCaption := DirectoryOutlineDirectory;
end;
由于DriveTabSet在响应OnDragDrop事件前先响应OnClick事件并由该事件激发DirectoryOutline的Onchange事件因而可保证在任何时候OnDragDrop事件中用到的CurrentDirList数组项不为空字符串
如何保证移动拷贝与子窗口的无关性?
在这里一个关键问题是我们判断源控件时是用is操作符进行类型检查
If Source is TFileList then
…
如果我们用下面的语句
If Source = FileList then
…
则移动拷贝操作将限制在本子窗口范围内
当解决了上述问题后我们的工作就只是遵循拖放的一般开发步骤按步就班来完成了
FileList开始拖动操作
procedure TFMFormFileListMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X Y: Integer)
begin
if Button = mbLeft then
with Sender as TFileListBox do
begin
if ItemAtPos(Point(X Y) True) >= then
BeginDrag(False)
end;
end;
ItemAtPos用来检查当前是否有文件存在而BeginDrag方法传递参数False 允许FileList单独处理鼠标事件而并不开始拖动事实上这种情况是大量存在的
[] [] [] []