FileEdit、DirLabel、FileListBox、FileFilterComloList、 DirectoryListBox、DriveComboList六个控件间的属性联系如下：　

　　DriveComboList .DirList := DirectoryListBox;

　　DirectoryListBox.DirLabel := DirLabel;

DirectoryListBox.FileList := FileListBox;

FileFilterComboList.FileList := FileListBox;

FileListBox.FileEdit := FileEdit;　

以上联系可以在设计时完成。只要打开相应属性的选择列表框进行选择即可。也可以在运行时利用如上的赋值语句建立联系。

　　文件控件的关键属性基本上都在以上联系中反映出来了。除此之外，FileFilterComboList有一个Filter属性，用来设置组合列表框的选择项；FileListBox 有一个Mask属性，用于设置显示文件的类型，这就允许FileListBox在脱离FileFilterComboList单独应用时仍能根据需要显示特定的文件。在6.4节中我们将应用这一功能。

　　文件控件的方法、事件基本是从ListBox和ComboBox中继承的。但FileListBox 中有一个ApplyFilePath方法很有用，我们将在后边给出其用法。　

6.3.2 文件名浏览查找系统的设计思路　

　　作为文件控件的应用实例，我们开发了一个简单的文件名浏览查找系统。这个系统可用于文件名的显示，把选中的文件写入列表框，并能按文件编辑框中输入的通配符对文件进行查找。

表6.5 部件的设计

━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

部件 属性 功能

─────────────────────────────────────

FileCtrForm Position=poDefault 主窗口

DirLabel 显示当前目录

FileEdit TabOrder=0 显示当前文件/输入文件显示匹配符

FileListBox1 FileEdit=FileEdit 显示当前目录文件

DirectoryListBox1 DirLabel=DirLabel 显示当前驱动器目录

FileList= FileListBox1

DriveComboBox1 DirList= DirectoryListBox1 选择当前驱动器

FilterComboBox1 FileList=FileListBox1 选择文件显示类型

Filter='All Files(*.*)|*.*|

Source Files(*.pas)|*.pas|

Form Files(*.dfm)|*.dfm|

Project Files(*.dpr)|*.dpr'

ListBox1 显示选中或查找的文件

Button1 Caption='查找' 按 FileEdit 中的内容进行查找

Button2 Caption='退出' 退出系统

━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━　

6.3.3 文件名浏览查找系统的功能和实现　

6.3.3.1 按指定后缀名显示当前目录中的文件　

　　实现这一功能只需要在控件间建立正确的联系即可，不需要代码支持。建立联系的方法如(6.3.1)中的介绍。　

6.3.3.2 把选中的文件添加到列表框中　

　　在FileListBox1的OnClick事件中：　

procedure TFileCtrForm.FileListBox1Click(Sender: TObject);

begin

if Searched then

begin

Searched := False;

ListBox1.Items.Clear;

Label5.Caption := 'Selected Files';

end;

if NotInList(ExtractFileName(FileListBox1.FileName),ListBox1.Items) then

ListBox1.Items.Add(ExtractFileName(FileListBox1.FileName));

end;

　　Searched是一个全局变量，用于标明ListBox1当前显示内容是查找的结果还是从FileListBox1中选定的文件。

函数NotInList用于判断待添加的字符串是否已存在于一个TStrings对象中。函数返回一个布尔型变量。

　　NotInList的具体实现如下。　

Function TFileCtrForm.NotInList(FileName: String;Items: TStrings): Boolean;

var

i: Integer;

begin

for I := 0 to Items.Count-1 do

if Items[i] = FileName then

begin

NotInList := False;

Exit;

end;

NotInList := True;

end;　

6.3.3.3 按指定匹配字符串显示当前目录中的文件　

　　当在FileEdit中输入一个匹配字符串，并回车，文件列表框将显示匹配结果。这一功能在FileEdit的OnKeyPress事件中实现。　

procedure TFileCtrForm.FileEditKeyPress(Sender: TObject; var Key: Char);

begin

if Key = #13 then

begin

FileListBox1.ApplyFilePath(FileEdit.Text);

Key := #0;

end;

end;

　　文件列表框提供的ApplyFilePath方法是解决这一问题的关键所在。　

6.3.3.4 按指定匹配字符串查找当前目录中的文件　

　　为了进行比较，我们用另一种方法来实现文件的查找功能，即利用标准过程FindFirst、FindNext。FileList1与ListBox1 中的内容完全一致。

当用户单击“查找”按钮时，与FileEdit 中字符串相匹配的文件将显示在ListBox1中。下面是实现代码。　

procedure TFileCtrForm.Button1Click(Sender: TObject);

var

i: Integer;

SearchRec: TSearchRec;

begin

Searched := True;

Label5.Caption := 'Search Result';

ListBox1.Items.Clear;

FindFirst(FileEdit.text,faAnyFile,SearchRec);

ListBox1.Items.Add(SearchRec.Name);

Repeat

i := FindNext(SearchRec);

If i = 0 then

ListBox1.Items.Add(SearchRec.Name);

until i <> 0;

end;

　　SearchRec是一个TSearchRec类型的记录。TSearchRec的定义如下：　

TSearchRec = record

Fill: array[1..21] of Byte;

Attr: Byte;

Time: Longint;

Size: Longint;

Name: string[12];

end;

　 在这一结构中提供了很多信息，灵活应用将给编程带来很大方便。下面我们举几个例子。

　　1. 检测给定文件的大小。　

function GetFileSize(const FileName: String): LongInt;

var

SearchRec: TSearchRec;

begin

if FindFirst(ExpandFileName(FileName), faAnyFile, SearchRec) = 0 then

Result := SearchRec.Size

else

Result := -1;

end;　

这一程序将在下一节中应用。

　　2. 获取给定文件的时间戳，事实上等价于FileAge函数。　

　　function GetFileTime(const FileName: String): Longint;

var

SearchRec: TSearchRec;

begin

if FindFirst(ExpandFileName(FileName),faAnyFile, SearchRec) = 0 then

Result := SearchRec.Time

else

Result := -1;

end;　

3. 检测文件的属性。如果文件具有某种属性，则　

SearchRec.Attr And GivenAttr > 0　

属性常量对应的值与意义如下表：　

　　 表6.6 属性常量对应的值与意义

━━━━━━━━━━━━━━━━━━━━

常量 值 描述

─────────────────────

faReadOnly $01 只读文件

faHidden $02 隐藏文件

faSysFile $04 系统文件

faVolumeID $08 卷标文件

faDirectory $10 目录文件

faArchive $20 档案文件

faAnyFile $3F 任何文件

━━━━━━━━━━━━━━━━━━━━　

6.4 文件管理综合举例：文件管理器的实现　

　　在本章的最后，我们利用Delphi提供的文件控件和文件管理函数开发一个简单的文件管理器。虽然这一文件管理器还无法和Windows提供的文件管理器相比拟，但它也为一般的文件操作提供了足够多的功能，而且如果读者感兴趣，还可以对它做进一步的扩充。在后边的拖放操作一章中，我们就为它提供了拖放支持，使它看起来更象一个“文件管理器”。

6.4.1 设计基本思路　

6.4.1.1 窗口设计　

　　文件管理器的主窗口是一个多文档界面(MDI)。有关文件、目录的显示和文件管理功能的实现都放在子窗口中。在程序执行过程中将根据需要弹出一些完成不同操作的对话框。这些对话框都是在需要时动态生成的。表6.7给出了本程序所设计窗体的清单。　

　　 表6.7 FileManger窗体清单

━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

窗体类 功能 用于创建该类窗体的菜单项

──────────────────────────────────────

TFileManager 主窗口

TFMForm 子窗口 Windows|New Window

TFileAttrForm 显示文件属性 File|Properties;Function|Search

TChangeForm 文件移动、拷贝、改名、改变 File|Move.Cope.Rename 当前目录等操作的输入对话框 Directory|change Directory

TSearchForm 输入待查找文件的名称和路径 Function|Search

TDiskViewForm 显示磁盘信息 Function|Disk View

TViewDir 输入待创建的子目录 Directory|CreateDirectory

TAboutBox 显示版权信息 Help|About

━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━　

6.4.1.2 界面设计　

　　主窗口界面主要是主菜单和用于表示当前目录、当前文件的状态条。　

　　 表6.8 主窗口界面设计

━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

部件 属性 功能

　─────────────────────────────

FileManager Style=fsMDI 主窗口

WindowMenu=Windows

Position=poDefault

MainMenu1 主菜单

FilePanel Align=alBottom 显示当前选中文件

BevelInner=bvLowered

BevelWidth=2

DirectoryPanel Align=alBottom 显示当前选中目录

Alignment=taLeftJustify

BevelInner=bvLowered

BevelWidth=2

━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

　

主窗口主菜单包括File、WIndows、Help三项。File菜单项在子窗口生成时被子窗口同名菜单项所取代。设置Windows、Help的GroupIndex = 9，可以使子窗口生成时这两个菜单项仍存在。

　　子窗口界面包括主菜单、目录树(DirectoryOutline)、文件列表框、 用于显示驱动器的标签集(TabSet)以及三个用于显示驱动器类型的TImage部件。　

　 表6.9 子窗口界面设计

━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

部件 属性 功能

───────────────────────────────────────

FMForm ActiveControl=DirectoryOutline 子窗口

Position=poDefault

Style=fsMDIChild

MainMenu1 主菜单

DriveTabSet Align=alTop 显示驱动器

style=tsOwnerDraw

DirectoryOutline Align=alLeft 显示当前驱动器的目录树

options=[ooDrawTreeRoot,

ooDrawFocusRect,ooStretchBitmaps]

FileList Align=alClient 显示当前目录中的文件

FileType=[ftReadOnly,

ftHidden,ftSystem,ftArchive,ftNormal]

ShowGlyphs=True

Network(Image) Picture(Network.bmp) 标志网络驱动器

Vsible=False

Floppy(Image) Picture(Floppy.bmp) 标志软驱

Visible=False

Fixed(Image) Picture(Fixed.bmp) 标志硬驱

Visible=False

━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

　

子窗口主菜单包括File、Function、Directory三个菜单项， 分别用于完成文件的基本管理功能、其它管理功能和目录管理功能。

　　由于对话框界面设计很简单，这里不再进行赘述。 读者可直接参考后面将给出的对话框界面图(图6.8---6.13)进行设计。

　

6.4.2 子窗口的创建、布置和关闭

　

　　子窗口的创建、布置由父窗口的Windows菜单控制，其菜单项如下：

　　● New Windows : 创建新的子窗口

● Tile : 平铺

　　● Cascade : 层叠

　　● ArrangeIcon : 排列图标

　 ● Minimized All : 极小化所有子窗口

　

　　子窗口的创建只需要简单调用窗体的Create方法：

　

　　FileMan := TFMForm.Create(Application);

　

子窗口的标准排列方式直接调用MDI窗口的标准方法Tile、Cascade和ArrangeIcons。

　　极小化所有子窗口的实现利用MDI窗口的两个属性：MDIChildCount和MDIChildren：

　

　　for i := 0 to MDICount - 1 do

MDIChildren[i].Windowstate := wsMinimized;

　

　

　　子窗口关闭时释放内存空间，为此在子窗口TFMForm的OnClose事件中令

　

Action := OnFree；

　

　　为了保持和Windows的File Manager的一致性，我们也禁止关闭最后一个子窗口，这需要在子窗口的OnCloseQuery事件处理过程中实现：

　

If FileManager.MDIChildCount <= 1 then

CanClose := False;

　

CanClose是OnCloseQuery事件过程返回的一个参数，用于判定窗口是否可以关闭。

　　由于这一过程归子窗口所有，因而MDIChildCount前必须加上其对象名FileManager。

　　但不幸的是：这样一来我们的程序无法终止了！原来MDI窗口关闭前首先关闭其所有的子窗口。如果子窗口不能关闭，MDI窗口也不能关闭。

为此我们需要判断发出关闭消息的是子窗口的系统菜单还是菜单的Exit项。

　　定义一个全局变量

　

　　var

ExitClick: Boolean;

　

在子窗口的Exit1Click事件处理过程中：

　

ExitClick := True;

FileManager.Exit1Click(Sender);

　

　

　　子窗口关闭前可以利用这一全局变量检测是否应关闭：

　

　　If (FileManager.MDIChildCount <= 1) and (Not ExitClick) then

CanClose := False;

　

6.4.3 文件控件的联系

　

　　在本例中我们使用了一组新的控件：TabSet、DirectoryOutline、FileListBox，用于显示和选择驱动器、目录和文件。与(6.3)中所用方法相比，使用这一组控件需要少量的代码支持。

　　TabSet与DirectoryOutline的联系在TabSet的Click事件处理过程中建立：

　

　　With DriveTabSet do

DirectoryOutline.Drive := Tabs[TabIndex][1];

　

DirectoryOutline与FileListBox的联系在DirectoryOutline的Change事件处理过程中建立：

　

FileList.Directory := DirectoryOutline.Directory;

FileList.Update;

　

6.4.4 DriveTabSet的自画风格显示　

　　Dephi为一些控件提供了自画风格的显示，如ListBox、ComboBox、TabSet等。 在缺省情况下，这些控件自动显示文本。而在自画风格下，拥有控件的窗体在运行时间内自己画出控件的每一项目。

自画风格显示通常的应用是为项目除文本外再添加图形显示。能以自画风格显示的控件有一个共同特点：都拥有一个TStrings类型的项目链。由于TStrings类的特点(参第三章)，它们都可以加入一个和对应文本相联系的对象。 而这正是自画风格显示的关键。

　　通常情况下产生一个自画风格需要三个步骤：

　　1.设置自画风格；

　　2.向字符串链表添加图形对象；

　　3.画出自画项目。　

6.4.4.1 设置自画风格　

　　控件属性Style 用于设置自画风格。对于DriveTabSet，我们把Style 属性设置为tsOwnerDraw。

　　对于ListBox、ComboBox等控件的设置与TabSet略有差异，读者可参阅联机帮助文档。　

6.4.4.2 向字符串链表添加图形对象　

　　1.在应用程序中添加图片部件

　　在本程序中我们设置了三个图片部件NetWork、Floppy、Fixed，并分别与三个位图文件NetWork.bmp、Floppy.bmp、Fixed.bmp相关联。

　　2.把图片添加到字符串链表中

　　根据字符串链表的性质，我们可以把对象与已存在的字符串建立联系，也可以同时添加字符串和对象。这里我们采用后一种方法。

　　在子窗口的OnCreate事件处理过程中，我们利用一个循环依次检测从a到z的驱动器是否存在以及驱动器的类型。这利用了Windwos API函数GetDrivetype, 如果驱动器不存在则返回0，否则返回驱动器的类型(DRIVE_REMOVABLE、DRIVE_FIXED、DRIVE_REMOTE)。根据驱动器类型我们可以判断与文本(驱动器名)同时添加到Tabs中的不同图形对象。在添加过程中，DriveTabSet的TabIndex被设置为当前驱动器。

程序清单如下：　

procedure TFMForm.FormCreate(Sender: TObject);

var

Drive, AddedIndex: Integer;

DriveLetter: Char;

begin

for Drive := 0 to 25 do

begin

DriveLetter := Chr(Drive + ord('a'));

case GetDrivetype(Drive) of

DRIVE_REMOVABLE:

AddedIndex := DriveTabSet.Tabs.AddObject(DriveLetter, Floppy.Picture.Graphic);

DRIVE_FIXED:

AddedIndex := DriveTabSet.Tabs.AddObject(DriveLetter, Fixed.Picture.Graphic);

DRIVE_REMOTE:

AddedIndex := DriveTabSet.Tabs.AddObject(DriveLetter, Network.Picture.Graphic);

end;

if UpCase(DriveLetter) = UpCase(FileList.Drive) then

DriveTabSet.TAbIndex := AddedIndex;

end;

end;

6.4.4.3 画出自画项目　

　　当把一个控件的风格设置为自画时，Windows不再负责往屏幕上画出控件的项目，而是为每个可见项目产生自画事件。应用程序可以通过处理自画事件画出控件的项目。　

1.确定自画项目的大小　

　　对于TabSet而言，这在OnMeasureTab事件处理过程中完成。我们需要把DriveTabSet每个标签的宽度增大到足以同时放下文本和位图。　

procedure TFMForm.DriveTabSetMeasureTab(Sender: TObject; Index: Integer;

var TabWidth: Integer);

var

BitmapWidth: Integer;

begin

BitmapWidth := TBitmap(DriveTabSet.Tabs.Objects[Index]).Width;

Inc(TabWidth, 2 + BitmapWidth);

end;

　　由于TStrings的Objects属性中存放的对象都是TObject类型，并没有Width属性，因而需要再把它转化为TBitmap类型的对象：　

　 BitmapWidth := TBitmap(DriveTabSet.Tabs.Objects[Index]).Width;

DELPHI基础教程

第六章　文件管理（三）

2.画出每个自画项目　

　　这在TabSet的OnDrawTab事件处理过程中完成。这一事件处理过程的参数中包含了待画项目索引、画板、待画区域、是否被选中等。这里我们只利用了前三个参数。事实上利用最后一个参数，我们可以对被选中的标签进行一些特殊的视觉效果处理。这一工作就留给读者自己去完成。　

procedure TFMForm.DriveTabSetDrawTab(Sender: TObject; TabCanvas: TCanvas;

R: TRect; Index: Integer; Selected: Boolean);

var

Bitmap: TBitmap;

begin

Bitmap := TBitmap(DriveTabSet.Tabs.Objects[Index]);

with TabCanvas do

begin

Draw(R.Left, R.Top + 4, Bitmap);

TextOut(R.Left + 2 + Bitmap.Width, R.Top + 2, DriveTabSet.Tabs[Index]);

end;

end;　

6.4.5 文件管理基本功能的实现　

　　在子窗口的File菜单中，定义了文件管理的基本功能，它们是：

　　● Open ：打开或运行一个文件(从文件列表框双击该文件可实现同样效果)

● Move ：文件在不同目录间的移动

　　● Copy ：文件拷贝

　　● Delete ：文件删除

　　● Rename ：文件更名

　　● Properties ：显示文件属性　

6.4.5.1 文件打开　

　　文件打开功能可以运行一个可执行文件，或把文件在与之相关联的应用程序中打开。文件总是与创建它的应用程序相关联，这种关联可以在Windows的文件管理器中修改。要注意的是：文件的关联是以后缀名为标志的，因而对一个文件关联方式的修改将影响所有相同后缀名的文件。

　　文件打开功能实现的关键是利用了Windows API函数ShellExecute 。由于Windows API函数的参数要求字符串类型是PChar，而Delphi中一般用的是有结束标志的String类型，因此为调用方便我们把这一函数进行了重新定义如下。　

function ExecuteFile(const FileName, Params, DefaultDir: String;

ShowCmd: Integer): THandle;

var

zFileName, zParams, zDir: array[0..79] of Char;

begin

Result := ShellExecute(Application.MainForm.Handle, nil,

StrPCopy(zFileName, FileName), StrPCopy(zParams, Params),

StrPCopy(zDir, DefaultDir), ShowCmd);

end;

　　以上函数在fmxutils单元中定义。fmxutils是一个自定义代码单元。

　　有关ShellExecute中各参数的具体含义读者可查阅联机Help文件。

　　StrPCopy把一个Pascal类型的字符串拷贝到一个无结束符的PChar类型字符串中。

　　在子窗口的Open1Click事件处理过程中：　

procedure TFMForm.Open1Click(Sender: TObject);

begin

with FileList do

ExecuteFile(FileName, '', Directory, SW_SHOW) ;

end;

　　如果FileList允许显示目录的话(即FileType属性再增加一项ftDirectory)，那么对于一个目录而言，打开的含义应该是显示它下边的子目录和文件。程序修改如下。　

　 procefure TFMForm.Open1Click(Sender: Tobject);

begin

With FileList do

begin

if HasAttr(FileName,faDirectory) then

DirectoryOutline.Directory := FileName

else

ExecuteFile(FileName,' ' ,Directory,SW_SHOW);

end;

end;　

其中HasAttr是一个fmxutils单元中的自定义函数，用于检测指定文件是否具有某种属性。　

function HasAttr(const FileName: String; Attr: Word): Boolean;

begin

Result := (FileGetAttr(FileName) and Attr) = Attr;

end;　

6.4.5.2 文件拷贝、移动、删除、更名　

　　文件拷贝的关键是使用了以文件句柄为操作对象的文件管理函数，因而提供了一种底层的I/O通道。在Object Pascal中这一点是利用无类型文件实现的。

　　在文件拷贝中首先检查目标文件名是否是一个目录。如是则把原文件的文件名添加到目标路径后，生成目标文件全路径名。而后提取源文件的时间戳，以备拷贝完成后设置目标文件。拷贝过程中使用了返回文件句柄或以文件句柄为参数的文件管理函数FileOpen、FileCreate、FileRead、FileWrite、FileClose。为保证文件的正常关闭和内存的释放，在拷贝过程中进行异常保护。

过程CopyFile实现上述功能，它定义在fmxutils单元中。　

procedure CopyFile(const FileName, DestName: TFileName);

var

CopyBuffer: Pointer;

TimeStamp, BytesCopied: Longint;

Source, Dest: Integer;

Destination: TFileName;

const

ChunkSize: Longint = 8192;

begin

Destination := ExpandFileName(DestName);

if HasAttr(Destination, faDirectory) then

Destination := Destination + '\' + ExtractFileName(FileName);

TimeStamp := FileAge(FileName);

GetMem(CopyBuffer, ChunkSize);

try

Source := FileOpen(FileName, fmShareDenyWrite);

if Source < 0 then

raise EFOpenError.Create(FmtLoadStr(SFOpenError, [FileName]));

try

Dest := FileCreate(Destination);

if Dest < 0 then

raise EFCreateError.Create(FmtLoadStr(SFCreateError,[Destination]));

try

repeat

BytesCopied := FileRead(Source, CopyBuffer^, ChunkSize);

if BytesCopied > 0 then

FileWrite(Dest, CopyBuffer^, BytesCopied);

until BytesCopied < ChunkSize;

finally

FileSetDate(Dest,TimeStamp);

FileClose(Dest);

end;

finally

FileClose(Source);

end;

finally

FreeMem(CopyBuffer, ChunkSize);

end;

end;

　　如果我们不使用FileSetDate过程，Windows自动把当前时间作为时间戳写入文件。

　　文件移动事实上是文件拷贝与文件删除的结合。fmxutils单元中的MoveFile过程实现了这一功能。　

procedure MoveFile(const FileName, DestName: TFileName);

var

Destination: TFileName;

begin

Destination := ExpandFileName(DestName);

if not RenameFile(FileName, Destination) then

begin

if HasAttr(FileName, faReadOnly) then

raise EFCantMove.Create(Format(SFCantMove, [FileName]));

CopyFile(FileName, Destination);

DeleteFile(FileName);

end;

end;　

EFCanMove是一个自定义异常类：　

　　type

EFCanMove := Class(EStreamError);

　　有关自定义异常类请参阅第十二章。

　　文件删除、文件更名直接调用Delphi文件管理过程DeleteFile、RenameFile。它们都以文件名为参数。操作执行前应弹出一个对话框进行确认，执行完毕后应调用Update方法更新FileList的显示。　

6.4.5.3 一致的界面　

　　文件拷贝、文件移动、 文件更名以及后边的改变当前目录在形式上都表现为从一个源文件到一个目标文件。因而可以采用统一的用户界面，即ChangeForm对话框

这四个菜单项共用一个Click事件处理过程，通过对Sender参数的检测，决定将要打开对话框的标题和显示内容。当用户按OK键关闭且目标文件(目录)非空时，程序弹出一个消息对话框要求用户进一步确认，而后执行相应的动作。

　　共用的事件处理过程FileChange的程序清单如下：　

procedure TFMForm.FileChange(Sender: TObject);

var

ChangeForm: TChangeForm;

IsFile: Boolean;

begin

ChangeForm := TchangeForm.Create(Self);

IsFile := True;

with ChangeForm do

begin

if Sender = Move1 then Caption := 'Move'

else if Sender = Copy1 then Caption := 'Copy'

else if Sender = Rename1 then Caption := 'Rename'

else if Sender = ChangeDirectory1 then

begin

Caption:='Change Directory';

IsFile:=False;

end

else Exit;

if IsFile then

begin

CurrentDir.Caption := FileList.Directory;

FromFileName.Text := FileList.FileName;

ToFileName.Text := '';

end

else

begin

CurrentDir.Caption := DriveTabSet.Tabs[DriveTabSet.TabIndex];

FromFileName.Text := DirectoryOutline.Directory;

ToFileName.Text := '';

end;

if (ShowModal <> idCancel) and (ToFileName.Text <> '') then

ConfirmChange(Caption, FromFileName.Text, ToFileName.Text);

end;

end;　

其中用到的自定义私有过程ConfirmChange用于执行相应的动作：　

procedure TFMForm.ConfirmChange(const ACaption, FromFile, ToFile: String);

begin

if MessageDlg(Format('%s %s to %s', [ACaption, FromFile, ToFile]),

mtConfirmation, [mbYes, mbNo], 0) = idYes then

begin

if ACaption = 'Move' then

MoveFile(FromFile, ToFile)

else if ACaption = 'Copy' then

CopyFile(FromFile, ToFile)

else if ACaption = 'Rename' then

RenameFile(FromFile, ToFile)

else if ACaption = 'Change Directory' then

changeDirectory(ToFile);

FileList.Update;

end;

end;　

6.4.5.4 显示文件属性　

　　当程序执行Properties 菜单项的Click 事件处理过程时，首先弹出一个TFileAttrForm类型的对话框，显示文件的属性

当用户修改并确认后程序重新设置文件属性。

　　Properties菜单项的Click事件处理过程如下：　

procedure TFMForm.Properties1Click(Sender: TObject);

var

Attributes, NewAttributes: Word;

FileAttrForm: TFileAttrForm;

begin

FileAttrForm := TFileAttrForm.Create(self);

ShowFileAttr(FileAttrForm,FileList.FileName,FileList.Directory);

end;

　　其中过程ShowFileAttr的实现如下：　

procedure TFMForm.ShowFileAttr(FileAttrForm:TFileAttrForm;

AFileName,Directory:String);

var

Attributes,NewAttributes: Word;

begin

with FileAttrForm do

begin

FileName.Caption := AFileName;

FilePath.Caption := Directory;

ChangeDate.Caption := DateTimeToStr(FileDateTime(AFileName));

Attributes := FileGetAttr(AFileName);

ReadOnly.Checked := (Attributes and faReadOnly) = faReadOnly;

Archive.Checked := (Attributes and faArchive) = faArchive;

System.Checked := (Attributes and faSysFile) = faSysFile;

Hidden.Checked := (Attributes and faHidden) = faHidden;

if ShowModal <> idCancel then

begin

NewAttributes := Attributes;

if ReadOnly.Checked then NewAttributes := NewAttributes or faReadOnly

else NewAttributes := NewAttributes and not faReadOnly;

if Archive.Checked then NewAttributes := NewAttributes or faArchive

else NewAttributes := NewAttributes and not faArchive;

if System.Checked then NewAttributes := NewAttributes or faSysFile

else NewAttributes := NewAttributes and not faSysFile;

if Hidden.Checked then NewAttributes := NewAttributes or faHidden

else NewAttributes := NewAttributes and not faHidden;

if NewAttributes <> Attributes then

FileSetAttr(AFileName, NewAttributes);

end;

end;

end;　

以上过程中用到的函数FileDataTime在fmxutils单元中定义，返回一个TDatatime类型的变量。　

function FileDateTime(const FileName: String): System.TDateTime;

begin

Result := FileDateToDateTime(FileAge(FileName));

end;　

6.4.6 其它文件管理功能的实现　

　　在子窗口的Function菜单中，定义了一些其它的文件管理功能：

　　● Search ：查找一个给定名字的文件，若存在则显示该文件属性

　　● Disk View ：显示当前驱动器的大小和剩余空间

　　● View type ：确定显示文件的类型　

6.4.6.1 文件查找　

　　当用户单击Search菜单项时，程序弹出一个对话框(如图6.10)，要求输入待查找的文件名和查找路径。文件名可以是通配符。当用户确认后程序显示第一个匹配文件的属性(如图6.9)。查找不到匹配文件则给出相应的信息。

在实现这一功能的最初设计中，我试图使用FileSearch函数，这个函数允许在多个不同路径中查找。但可惜的是：也许由于系统设计者的失误，这个函数并没有返回它应该返回的东西(第一个匹配文件的全路径名)，而是仍把输入的匹配符返回。

　　没有办法我只能再次使用FindFirst，这个函数的特性在6.3节中已进行了介绍。下面是这一功能的实现代码。　

procedure TFMForm.search1Click(Sender: TObject);

var

SearchForm: TSearchForm;

FileAttrForm: TFileAttrForm;

FindIt,path: String;

SearchRec: TSearchRec;

Return: Integer;

begin

SearchForm := TSearchForm.Create(self);

with SearchForm do

begin

SearchFile.text := '';

SearchPath.text := DirectoryOutline.Directory;

if (ShowModal <> idCancel) and

(SearchFile.Text <> '') and (SearchPath.text <> '') then

begin

FindIt := SearchPath.text+'\'+SearchFile.text;

Return := FindFirst(FindIt,faAnyFile,SearchRec);

if Return <> 0 then

FindIt := ''

else

FindIt := ExpandFileName(SearchRec.Name);

end;

if FindIt = '' then

MessageDlg('Cannot find the file in current directory.',

mtWarning, [mbOk], 0)

else

begin

Path := ExtractFilePath(FindIt);

FindIt := ExtractFileName(FindIt);

FileAttrForm := TFileAttrForm.Create(self);

ShowFileAttr(FileAttrForm,FindIt,Path);

end;

end;

end;　

6.4.6.2 显示磁盘信息

　　当用户单击Disk View菜单项时，将弹出一个TDiskViewForm类型的对话框，用来显示当前磁盘的信息

磁盘信息的获取是在DiskViewForm中DriveEdit编辑框的OnChange事件处理过程中实现的。　

procedure TDiskViewForm.driveEditChange(Sender: TObject);

var

dr: Byte;

Free,Total: LongInt;

begin

Free := DiskFree(0);

Total := DiskSize(0);

FreeSpace.text := IntToStr(Free)+ ' bytes.';

TotalSpace.text := IntToStr(Total) + ' bytes.';

end;

　　DiskFree、DiskSize带参数为0表示当前驱动器。读者可以很容易把它改成按用户输入显示磁盘信息的情况。

　　DiskViewForm中的三个编辑框设计时都令ReadOnly为True。　

6.4.6.3 改变显示文件的类型　

　　改变显示文件的类型事实上是设置FileList的Mask属性。我们利用一个标准的InputBox输入文件的匹配字符串。而后利用Update方法更新FileList。　

procedure TFMForm.Viewtype1Click(Sender: TObject);

var

FileMask: String;

begin

FileMask := InputBox('File type','Input File type For View :',FileList.Mask);

If FileMask = '' then FileMask := '*.*';

FileList.Mask := FileMask;

FileList.Update;

CreateCaption;

end;

　　其中的CreateCaption私有过程将在(6.4.8)中进行介绍。　

6.4.7 目录管理功能的实现　

　　在子窗口的Directory菜单中，提供了目录管理功能：

　　● Create Directory ：创建一个子目录

　　● Delete Directory ：删除一个空的子目录

　　● Change Directory ：改变当前目录　

6.4.7.1 创建目录　

　　创建目录时首先弹出一个TNewDir类型的对话框

对话框中要求用户输入目录名。如果用户不输入路径，则缺省认定为当前目录的子目录：　

　　Dir := ExpandFileName(DirName.Text)；　

　　而后调用MkDir函数。在目录创建过程中关闭了I/O错误检测，出错不产生异常而是把IOResult设置为非零值。通过检查IOResult是否为0可以确定创建是否成功。

程序清单如下：　

procedure TFMForm.CreateDirectory1Click(Sender: TObject);

var

NewDir: TNewDir;

Dir: String;

begin

{$I-}

NewDir := TNewDir.Create(self);

with NewDir do

begin

CurrentDir.Caption := DirectoryOutline.Directory;

if (ShowModal <> idCancel) and (DirName.Text <> '') then

Dir := ExpandFileName(DirName.text);

end;

MkDir(Dir);

if IOResult <> 0 then

MessageDlg('Cannot Create directory', mtWarning, [mbOk], 0);

end;

　　但不幸的是目录创建后我们却无法从当前目录树中看到。必须移到另一个驱动器而后再返回，创建的目录才是可见的。在后边我们将提供一种解决方法。　

6.4.7.2 删除目录　

　　在实现目录删除过程中，远不如创建目录那么顺利。碰到的问题是:

　　1.RmDir不允许删除当前目录。但为了操作方便，我们要求删除的恰恰是当前目录；

　　2.目录删除后调用Refresh方法或Update方法并不能使该目录从屏幕显示中去除。因而当用户试图进入该目录时会导致系统崩溃。

　　对第一个问题，我们的解决办法是把当前目录转换到其父目录。假如读者记得目录也被操作系统作为一种特殊的文件对待的话，那么就不会对下面的语句感到奇怪了：　

　　path := DirectoryOutline.Directory;

　　Directoryoutlin.Directory := ExpandFilePath(Path);

　　而后调用RmDir过程：　

RmDir(Path)；

　

　　第二个问题的解决却颇为费神。因为DirectoryOutline是Delphi提供的示例部件，没有Help文件支持。通过试验发现：只有当DirectoryOutline的Drive属性改变时，才重新从相应驱动器读取目录。而且它基本上是只读的，除非清除( Clear) 它，象Add、Delete这些方法对它都是无效的。

　　我曾经考虑过一个笨拙的方法，那就是先改变当前驱动器而后再改回来。但这种方法一方面速度无法忍受，另一方面当只存在一个驱动器可用时会导致系统崩溃。

　　正当我一筹莫展时，突然想到：DirectoryOutline是一个Sample部件，Delphi 提供了它的源代码。而当我分析了它的源代码后，我知道应该做什么了，那就是为DirectoryOutline增添一个Reset方法!　

6.7.3 为部件增添一个方法　

　　严格地说，我们所做的工作属于创建一个新部件。但因为我们有源代码，所以不必从DirectoryOutline继承而是直接修改它。这样我们可以省去与创建部件有关的许多繁琐工作。对创建新部件感兴趣的读者可阅读本书第三编的有关章节。

　　在Delphi IDE中打开DirectoryOutline的源文件后：

1.把库单元名改为DirPlus，类名改为TDirectoryOutlinePlus，表明这是DirectoryOutline的增强版。而后存入另一个目录中；

　 2.添加一个公有方法Reset。这一方法的作用是重新读取当前驱动器的目录。程序清单如下。　

procedure TDirectoryOutlinePlus.Reset;

begin

ChDir(FDrive + ':');

GetDir(0, FDirectory);

FDirectory := ForceCase(FDirectory);

if not (csLoading in ComponentState) then BuildTree;

end;

　　读者也许被这段代码弄糊涂了。由于篇幅所限，而且涉及到许多自定义部件开发的内容，我们也不准备去详细解释它。假如读者想彻底搞懂它，我建议先看一下本书第三编有关自定义部件开发的内容，而后再对照原DirectoryOutline的源代码进行分析。

　　3.编译成一个库文件DirPlus.tpu;

4.把DirPlus加入部件的Samples页中。

　　如何添加一个部件见第三编有关章节的介绍。

　　当增强的目录树准备好以后，必须修改我们的子窗口设计，但却不必亲自修改源代码。

　　1.删除子窗口中的TDirectoryOutline类部件DirectoryOutline。此时FileList占据了整个客户区；

　　2.把FileList的Align属改为None，并留出左边的空白供放部件用；

　　3.在窗口左部加入TDirectoryOutlinPlus类的部件DirectoryOutline；

4.把DirectoryOutline的Align属性改为Left，FileList的Align属性还原为Client；

5.在DirectoryOutline的事件OnChange列表中选取DirectoryOutlineChange，即原DirectoryOutline的处理过程。

　　以上工作的最终目标是实现目录创建、删除后屏幕的正确显示。这只需要调用DirectoryOutline的Reset方法即可。

目录删除过程的实现代码如下。　

procedure TFMForm.DeleteDirectory1Click(Sender: TObject);

var

path: String;

k: Integer;

begin

{$I-}

path := DirectoryOutline.Directory;

DirectoryOutline.Directory := ExtractFilePath(Path);

if MessageDlg('Delete ' + path + '?', mtConfirmation,[mbYes, mbNo], 0) = idYes then

RmDir(path);

if IOResult <> 0 then

MessageDlg(' Cannot remove directory! The path might not'+

'exist,non-empty or is the current logged directory.',mtWarning,[mbOk], 0)

else

DirectoryOutline.Reset;

end;

修改后的目录创建过程如下。　

procedure TFMForm.CreateDirectory1Click(Sender: TObject);

var

NewDir: TNewDir;

Dir: String;

begin

{$I-}

NewDir := TNewDir.Create(self);

with NewDir do

begin

CurrentDir.Caption := DirectoryOutline.Directory;

if (ShowModal <> idCancel) and (DirName.Text <> '') then

Dir := ExpandFileName(DirName.text);

end;

MkDir(Dir);

if IOResult <> 0 then

MessageDlg('Cannot Create directory', mtWarning, [mbOk], 0)

else

DirectoryOutline.Reset;

end;

　　当完成了这些工作，把程序重新编译、运行后，可以发现我们所希望实现的功能完全实现了！同时，我们有了一个更好的目录树部件。　

6.4.7.4 改变当前目录　

　　改变当前目录的实现非常简单，只要修改DirectoryOutline的Directory属性。但需注意的是：当改变后目录所在驱动器也发生变化时应相应修改DriveTabSet的当前值。由于驱动器名与DriveTabSet的索引属性TabIndex之间并没有确定的对应关系，因而需要通过一个循环进行查找匹配。

Change Directory的菜单事件处理过程是FileChange，即与文件的移动、拷贝、更名共用一个事件处理过程。详细情况请读者参看(6.4.5.3)中的介绍。

改变当前目录的实现如下。　

procedure TFMForm.ChangeDirectory(Todir: String);

var

i: Integer;

begin

{$I-}

ChDir(ToDir);

if IOResult <> 0 then

MessageDlg('Cannot find directory', mtWarning, [mbOk], 0)

else

begin

with DirectoryOutline do

begin

Directory := ToDir;

Refresh;

if DriveTabSet.Tabs[DriveTabSet.TabIndex][1]<>drive then

for I := 1 to 25 do

if DriveTabSet.Tabs[i][1] = drive then

begin

DriveTabSet.TabIndex := i;

Exit;

end;

end;

end;

end;

6.4.8 一些问题的处理　

6.4.8.1 子窗口的标题　

　　Windows的文件管理器是我们设计的楷模，在子窗口显示标题上也不例外。我们把当前目录加上文件的类型作为子窗口的标题。

过程CreateCaption用于生成子窗口的标题。　

procedure TFMForm.CreateCaption;

var

Cap: String;

begin

Cap := DirectoryOutline.Directory;

Cap := cap+'\'+FileList.mask;

Caption := Cap;

end;　

当前目录或文件显示类型发生变化时改变子窗口的标题。如DirectoryOutline的Change事件处理过程和ViewType菜单项的Click事件处理过程就调用了该过程。　

6.4.8.2 状态条的显示　

　　状态条用于显示当前目录和当前选中文件。它们的值在DirectoryOutline 和FileList的Change事件处理过程中修改。

　　DirectoryOutline和FileList最终的Change事件处理过程如下：　

procedure TFMForm.DirectoryOutlineChange(Sender: TObject);

begin

CreateCaption;

FileList.clear;

FileList.Directory := DirectoryOutline.Directory;

FileList.Update;

FileManager.DirectoryPanel.Caption := DirectoryOutline.Directory;

end;

procedure TFMForm.FileListChange(Sender: TObject);

begin

with FileList do

begin

if (ItemIndex >= 0) and (Not HasAttr(FileName,faDirectory)) then

begin

TheFileName := FileName;

FileManager.FilePanel.Caption :=

Format('%s, %d bytes', [TheFileName, GetFileSize(TheFileName)]);

end

else

FileManager.FilePanel.Caption := '';

end;

end;　

6.4.8.3 版本信息　

　　当用户单击主窗口的Help|About菜单项时将弹出一个About对话框，用于显示版本信息（如图6.13）。

　　这一对话框是用Delphi提供的模板做的。

6.4.8.4 菜单项的变灰与使能　

　　File菜单中定义的文件管理功能只有当活动焦点在FileList(即有当前选中文件)时才起作用。否则所有菜单项应变灰，以免导致系统崩溃。

　　这一功能在File菜单的Click事件处理过程中实现。这一点并不很容易被人想到，希望读者能从中受到启发。　

procedure TFMForm.File1Click(Sender: TObject);

var

FileSelected: Boolean;

begin

FileSelected := FileList.ItemIndex >= 0;

Open1.Enabled := FileSelected;

Delete1.Enabled := FileSelected;

Copy1.Enabled := FileSelected;

Move1.Enabled := FileSelected;

Rename1.Enabled := FileSelected;

Properties1.Enabled := FileSelected;

end;

　　判断是否有文件被选中是通过检测ItemIndex属性是否大于等于0来实现的。

　　 FileSelected := FileList.ItemIndex >= 0；　

6.4.8.5 可重用的文件处理模块　

　　库单元fmxutils是一个代码库，提供了若干文件处理模块。这些模块除在本程序中使用外，读者可以在其它应用程序中直接调用，而且不必重新编译，只要在Uses子句中包含即可。从中我们可以体会到，Delphi 以库单元为中心的程序组织方式提供了一种较完善的代码重用机制。　

6.4.9 小结　

　　文件管理器是一个较为综合的例程，使用到了绝大部分以文件名、文件句柄以及其它参数(除文件变量)为操作对象的文件管理过程/函数，同时也提供了一些程序设计开发的思想。我们的介绍是以程序功能模块来组织的，我建议读者在学习并试图自己建立这一程序时采用同样的方法。(6.4.8)中的内容或许是一开始就应了解的，但其它完全可以按顺序逐步地扩充，最后得到一个完整的程序。这一例程在后边的拖放操作和异常处理等章节中还要用到。读者可以以此为基础进一步完善它，使它真正成为一个完全实用的程序。

　　文件管理是在开发一个高级的Windows程序中不可避免的要涉及到的问题。本章介绍的思路和方法将为读者成为一个熟练的程序员奠定基础。

DELPHI基础教程

第七章　剪贴板和动态数据交换（一）

--------------------------------------------------------------------------------

应用程序间的数据交换是象Windows 这样的多任务环境的重要特性。作为一种基于Windows的开发工具，Delphi支持如下四种数据交换方式：剪贴板、动态数据交换 ( DDE)、对象联接与嵌入(OLE)以及动态联接库(DLLs)。这中间前三种方式最为常用，OLE功能最为强大，DDE次之。而剪贴板使用最为方便。在本章，我们只讨论剪贴板和动态数据交换。利用OLE实现数据交换见下一章，利用动态联接库(DLLs)进行数据交换将在第十章中介绍。　　

7.1 剪贴板及其应用　

本质上，剪贴板只是一个全局内存块。当一个应用程序将数据传送给剪贴板后，通过修改内存块分配标志，把相关内存块的所有权从应用程序移交给Windows自身。其它应用程序可以通过一个句柄找到这个内存块，从而能够从内存块中读取数据。这样就实现了数据在不同应用程序间的传输。　　

剪贴板虽然功能较为简单，且不能实现实时传输，但却是更为复杂的DDE和OLE的基础。对于一些只是偶尔需要使用其它应用程序数据的程序来说，使用剪贴板不失为一种方便、快捷的方式。

Delphi把剪贴板的大部分功能封装到一个TClipboard类中，同时把使用频度最高的文本传输功能(包括DBImage的图像传输功能)置入相应部件作为部件的方法，从而使用户可以十分方便地使用剪贴板进行编程。　

7.1.1 使用剪贴板传输文本　

剪贴板传输文本主要是应用如下的三个方法:CopyToClipboard、CutToClipboard 和PasteFromClipboard。包含这些方法的部件如下表所示。　

　　 表7.1 包含剪贴板方法的部件

━━━━━━━━━━━━━━━━━━━━━━━━━━━

方 法 部 件

———————————————————————————

TDBEdit　TDBMemo

TDBImage

CopyToClipboard TEdit TMemo TMaskEdit

TOLEContainer

TDDEServerItem

———————————————————————————

TDBEdit TDBMemo

CutToClipboard TDBImage

TEdit TMemo TMaskEdit

———————————————————————————

TDBEdit TDBMemo

PasteFromClipboard TDBImage

TEdit TMemo TMaskEdit

━━━━━━━━━━━━━━━━━━━━━━━━━━━　

除TDBImage外，其余全是有关文本的控件。

在把文本传输到剪贴板之前，文本必须被选中。

若选TMaskEdit的AutoSelect属性为True，则当MaskEdit获得输入焦点时文本自动被选中；若选TEdit、TMemo的HideSelection属性为True，则失去焦点时，文本选中状态自动隐藏，重新获得焦点时再显示。

下面的语句把MaskEdit中选中的文本剪切到剪贴板：　

MaskEdit .CutToClipboard;　

下面的语句把剪贴板中的文本粘贴到Memo的当前光标处：　

Memo.PasteFromClipboard；　

利用剪贴板类也可以实现文本的传输，见(7.1.2)中的介绍。　

7.1.2 剪贴板类　

为方便剪贴板的操作，Delphi在Clipbrd库单元中定义了一个TClipboard类，并且预定义了一个变量Clipboard作为类TClipboard的实例，从而使用户在绝大多数场合不必自己去定义一个TClipboard的实例。

利用剪贴板类可以进行文本、图像和部件的传输，剪贴板类为实现这些方法提供了相应的属性和方法。表7.2、表7.3列出了TClipboard属性和方法的意义。　　

表 7.2 TClipboard的属性

━━━━━━━━━━━━━━━━━━━━━━━━━━━

属 性 意 义

───────────────────────────

AsText 保存剪贴板的文本，只有运行时才可设置

FormatCount 可用剪贴板格式的数目

Formats 可用剪贴板格式链

━━━━━━━━━━━━━━━━━━━━━━━━━━━　

　　 表 7.3 TClipboard的方法

━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

方 法 参 数 意 义

─────────────────────────────────────

Clear 无 清除剪贴板的内容

Assign Source:TPersistent 把Source参数指定的对象拷贝到剪贴板，常

用于图形、图像对象

Open 无 打开剪贴板，阻止其它应用程序改变它的内容

Close 无 关闭打开的剪贴板

SetComponent Source:TPersistent 把部件拷贝到剪贴板

GetComponent Owner 从剪贴板取回一个部件并放置

Parent :TPersistent

SetAsHandle Format:Word 把指定格式数据的句柄交给剪贴板

返回类型：THandle

GetAsHandle Format:Word 返回剪贴板指定格式数据的句柄

返回类型：THandle

HasFormat Format:Word 判断剪贴板是否拥有给定的格式

返回类型：Boolean

SetTextBuf Buffer:PChar 设置剪贴板的文本内容

━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━　

　　剪贴板中可能的数据格式如下表。　

表 7.4　剪贴板数据格式及其意义

━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

数据格式 意 义

──────────────────────────────

CF_TEXT 文本。每行以CF_LF结束，nil标志文本结束

CF_BITMAP Windows位图

CF_METAFILE Windows元文件

CF_PICTURE TPicture类型的对象

CF_OBJECT 任何TPersistent类型的对象

━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━　

利用TClipboard实现文本的传输使用AsText属性和SetTextBuf方法。

AsText属性为非控件部件的剪贴板操作提供了方便。如：　

Clipboard. AsText := Form1.Caption ;　

把Form1的标题拷贝到剪贴板。　

Label1.Caption := Clipboard.AsText;　

把剪贴板中的文本写入Label1。

SetTextBuf用于把超过255个字符的字符串拷入剪贴板。　

7.1.3 利用剪贴板传输图像　

7.1.3.1 拷贝　

Image部件上的内容和窗体上的图形可以直接拷贝到剪贴板。图像拷贝利用Clipboard的Assign方法。

例如：　

Clipboard.Assign(Image1.Picture);　

把Image1上的图像拷贝到剪贴板。　

7.1.3.2 剪切　

图像的剪切是首先把图像拷贝到剪贴板，而后在原位置用空白图像进行覆盖。

下面一段程序表示了图像的剪切。　　

procedure TForm1.Cut1Click(Sender: TObject);

var

ARect: TRect;

begin

Clipboard.Assign(Image1.Picture);

with Image.Canvas do

begin

CopyMode := cmWhiteness;

ARect := Rect(0, 0, Image.Width, Image.Height);

CopyRect(ARect, Image.Canvas, ARect);

CopyMode := cmSrcCopy;

end;

end;　

7.1.3.3 粘贴　

从剪贴板上粘贴图像，首先检测剪贴板上的数据格式。如果格式为CF_BITMAP，则调用目标位图的Assign 方法粘贴图像。

程序清单如下。

procedure TForm1.PasteButtonClick(Sender: TObject);

var

Bitmap: TBitmap;

begin

if Clipboard.HasFormat(CF_BITMAP) then

begin

Bitmap := TBitmap.Create;

try

Bitmap.Assign(Clipboard);

Image.Canvas.Draw(0, 0, Bitmap);

finally

Bitmap.Free;

end;

end;

end;　

try...finally为资源保护块，参第十二章。

7.1.4 建立自己的剪贴板观察程序　

在这一节中我们要建立一个自己的剪贴板观察程序，用来保存截获到剪贴板中的位图。

Windows允许用户建立自己的剪贴板观察程序，并把该程序添加到一个剪贴板观察器链中。在链中，位置靠前的程序有义务把有关剪贴板的消息传递到紧随其后的观察程序。而处于链首的程序由Windows的消息循环机制直接把剪贴板消息发送过来。

建立一个剪贴板观察程序，首先该程序必须能响应相应的Windows消息。对于那些熟悉Microsoft公司Visual Basic的读者来说，这是令他们头疼而束手无策的地方。但Delphi在这方面却有良好的表现：利用关键字message，用户可以将一个过程定义为响应特定的Windows消息。如：　

procedure WMDrawClipboard(var Msg:TWMDrawClipboard);

message WM_DRAWCLIPBOARD;　

可以响应WM_DRAWCLIPBOARD消息。类TWMDrawClipboard是消息类Message 的子类。Delphi把所有的消息都重新进行了定义，使用户在使用时可以直接引用其便于记忆的数据成员，而不必再自己动手去分解消息。虽然这并不能算作是一个重大的改进，但却体现了Delphi处处为用户方便着想的特点。

我们将要建立的程序目的是把截获到剪贴板上的位图保存下来。在本书的写作过程中，这一工作是大量存在的。虽然利用Windows工具PaintBrush(画笔），通过粘贴、保存等操作可以实现这一功能，但却存在以下一些问题：

1.程序频繁切换影响效率，当有大量位图存在时更是如此；

2.画笔有一个很讨厌的缺陷：当剪贴板上的位图比画笔界面的客户区大时，客户区外的位图被截断。因而往往需要根据所截获位图的大小来调整画笔客户区的大小，并重新进行粘贴。而如果开始就把画笔客户区调整到足够大，又会覆盖掉屏幕上一些有用的信息。

为解决这些问题，我开发了下面的程序。程序启动时，以极小化方式运行。此时只要剪贴板中存入位图，则自动弹出一个对话框请求用户保存。如果用户希望查看确认，则可以双击运行程序图标，选择相应按钮，剪贴板中的位图就会显示在屏幕上。

部件关键属性设计如下：　

ClipSaveForm：

Caption＝‘Save Bitmap in Clipboard '

Panel1:

Align = ' Top '

Image1:

Align = ' Client '

SaveDialog1:

FileEditStyle = fsEdit

FileName = '*.bmp'

Filter = 'Bitmap Files(*.bmp)|*.bmp|Any Files(*.*)|*.*'

InitialDir = 'c:\bmp'

Title = 'Save Bitmap'　

程序主窗口是TForm派生类TClipSaveForm的实例。TClipSaveForm通过定义一些私有数据成员和过程，使响应和处理Windows的相应消息成为可能。下面是TClipSaveForm的类定义：　

type

TClipSaveForm = class(TForm)

SaveDialog1: TSaveDialog;

Image1: TImage;

Panel1: TPanel;

Button1: TButton;

SpeedButton1: TSpeedButton;

SpeedButton2: TSpeedButton;

Button2: TButton;

procedure FormCreate(Sender: TObject);

procedure FormDestroy(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure SpeedButton1Click(Sender: TObject);

procedure SpeedButton2Click(Sender: TObject);

private

{ Private declarations }

MyBitmap: TBitmap; { 保存截获的位图 }

View: Boolean; { 判断是否显示 }

NextViewerHandle: HWND; { 下一剪贴板观察器的句柄 }

procedure WMDrawClipboard(var Msg:TWMDrawClipboard);

message WM_DRAWCLIPBOARD;

procedure WMChangeCBChain(var Msg:TWMChangeCBChain);

message WM_CHANGECBCHAIN;

{ 响应Windows的剪贴板消息 }

public

{ Public declarations }

end;

窗口创建时，把该窗口登录为剪贴板观察器，添加到剪贴板观察器链中，同时进行变量、部件和剪贴板的初始化。　

procedure TClipSaveForm.FormCreate(Sender: TObject);

begin

View := False;

SpeedButton2.Down := True;

MyBitmap := TBitmap.create;

try

MyBitmap.Width := 0;

MyBitmap.Height := 0 ;

except

Application.terminate;

end;

Clipboard.Clear;

NextViewerHandle := SetClipboardViewer(Handle);

end;　

窗口关闭时，退出剪贴板观察器链，并释放内存：　

procedure TClipSaveForm.FormDestroy(Sender: TObject);

begin

ChangeClipboardChain(Handle,NextViewerHandle);

MyBitmap.Free;

end;　

在以上两段程序中用到的两个Windows API函数SetClipboardViewer和ChangeClipboardChain分别用于登录和退出剪贴板观察器链。

程序保存位图的功能是在消息响应过程WMDrawClipboard中实现的。该过程在剪贴板内容有变化时被调用。　

procedure TClipSaveForm.WMDrawClipboard(var Msg: TWMDrawClipboard);

var

FileName: String;

begin

If NextViewerHandle <> 0 then

SendMessage(NextViewerHandle,msg.Msg,0,0);

If ClipBoard.HasFormat(CF_BITMAP) then

begin

MyBitmap.Assign(Clipboard);

If SaveDialog1.Execute then

begin

FileName := SaveDialog1.FileName;

MyBitmap.SaveToFile(FileName);

end;

If View then

begin

WindowState := wsNormal;

Image1.Picture.Bitmap := MyBitmap;

end;

end;

Msg.Result := 0;

end;　

程序首先判断在剪贴板观察器链中是否还存在下一个观察器。如果有，则把消息传递下去，这是剪贴板观察器程序的义务。而后判断剪贴板上内容的格式是否为位图。如是，则首先把剪贴板上内容保存到数据成员MyBitmap中，并激活一个文件保存对话框把位图保存到文件中。如果View=True，则把窗口状态(WindowState)设置为wsNormal，并把MyBitmap赋给Image部件的相应值，使用户可以对剪贴板上的位图进行观察。

消息响应过程WMChangeCBChain在剪贴板观察器链上其它观察器退出时被调用。根据被移出观察器的不同位置决定了不同的处理方法。

procedure TClipSaveForm.WMChangeCBChain(var Msg: TWMChangeCBChain);

begin

if Msg.Remove = NextViewerHandle then

NextViewerHandle := Msg.Next

else

if NextViewerHandle <> 0 then

SendMessage(NextViewerHandle,Msg.Msg,Msg.Remove,Msg.Next);

Msg.Result := 0;

end;

窗口上有两个加速按钮，两个按钮。它们击键(click)事件处理过程如下。每一程序段的意义是非常显然的。　

procedure TClipSaveForm.Button1Click(Sender: TObject);

begin

Close;

end;

procedure TClipSaveForm.Button2Click(Sender: TObject);

begin

WindowState := wsMinimized;

end;

procedure TClipSaveForm.SpeedButton1Click(Sender: TObject);

begin

View := True;

Image1.Picture.Bitmap := MyBitmap;

end;　

procedure TClipSaveForm.SpeedButton2Click(Sender: TObject);

begin

View := False;

Image1.Picture.Bitmap := nil;

end;　

通过对这个程序的介绍，以下几点是应该注意的：

1.提供了一种自己截获和处理剪贴板上内容的方法。读者可以根据需要进一步扩充；

2.提供了响应Windows消息的方法。在第三篇有关自定义部件开发的内容中，这一问题还要详细论述；

3.最后的一点启示是：在Delphi程序开发中巧妙应用传统的Windows方法(如消息处理、 API函数等)仍是很有必要的。而在应用这些方法中所体现的方便之处，正是Delphi胜过其它可视化开发工具的一个重要方面。　

7.2 Windows的DDE原理和 Dephi的DDE实现机制　

7.2.1 Windows的DDE原理　

Windows的DDE机制基于Windows的消息机制。两个Windows应用程序通过相互之间传递DDE消息进行DDE会话(Conversation)，从而完成数据的请求、应答、传输。这两个应用程序分别称为服务器(Server)和客户(Client)。服务器是数据的提供者，客户是数据的请求和接受者。

DDE会话由客户程序启动。客户程序把一条消息(WM_DDE_INITIATE)传播给当前运行的所有Windows程序。这条消息指明了客户程序所需要的一般数据(应用程序、主题)。拥有这些数据的DDE服务器可以响应这条被传播的消息。此时，DDE会话就开始了。

由于在每个主题中，DDE服务器可以支持一个或多个数据项，所以在客户请求数据时应同时指明应用程序名、主题名和项目名。应用程序、主题、项目是DDE中三个最基本的概念。

利用Windows本身提供的DDE消息和API进行DDE编程是一件相当棘手的问题。 虽然使用DDE管理库(ddeml.dll)可以一定程度上减轻开发者的工作负担，但开发DDE程序仍不是一件轻松的事情。

此时Delphi出现了！Delphi通过其自身巧妙的设计使开发一个DDE应用程序同开发一个普通程序一样地快捷、方便。　

7.2.2 Delphi的DDE实现机制简介　

Delphi把所有的DDE功能做到四个部件中，它们是:

● TDDEClientConv ： 用于客户程序建立和维护一个DDE会话

● TDDEClientItem ： 用于客户程序建立和维护数据交换通道

● TDDEServerConv ： 用于服务器程序响应DDE会话

● TDDEServerItem ： 用于服务器程序维护数据交换通道　

　 前两个部件用于生成一个DDE客户程序，后两个部件用于生成一个DDE服务器程序。如果一个应用程序同时拥有这些部件，则这一程序既可以充当DDE客户，也可以充当DDE服务器。

会话部件TDDEClientConv、TDDEServerConv用于建立和维护一个DDE会话。DDE会话包括DDE服务和DDE主题两部分。

DDE服务是DDE服务器的名称，即在一般的Windows DDE机制中所讲的应用程序名。一般说来这一名称是DDE服务器应用程序执行文件名去掉 .EXE后缀。比如你的应用程序要和Word 6.0建立会话，则DDE服务为WINWORD。但也不尽然。比如你的应用程序要和Borland ReportSmith ( RPTSMITH.EXE ) 建立会话，则DDE 服务为 Report Smith。DDE服务到底如何，读者可参看相关的DDE服务器应用程序文档。

DDE主题是一个包含了联接信息的数据单元。一般说来DDE 主题是一个包括扩展名的完整文件名。例如和Excel中的一个文件建立DDE会话，则主题可能是　

Topic = 'c:\excel\Example\sale.xls'　

如果服务器是一个Delphi应用程序，缺省情况下主题是包含欲联接数据窗体的标题。如果服务器使用了DDEServerConv部件，则要求使用部件DDEServerConv的名称作为DDE主题。

项目部件TDDEclientItem、TDDEServerItem用于建立和维护DDE数据的传输通道。 DDE项目中包含着实际欲传输的数据。DDE项目的格式取决于DDE服务器应用程序。一个可能的DDE项目例子是电子表格中的单元和数据库表中的域。如果服务器是Delphi应用程序，则项目是连接的 DDEServerItem部件的名称。

Delphi的DDE实现机制方便、实用，但也有一个令人遗憾的缺陷：只能传输文本数据以及命令、宏，而不能传输图像数据。在这一点上微软公司推出的Visual Basic 要略胜一筹。不过在目前文本数据的使用仍是最广泛的，而且图像传输可以利用剪贴板和OLE来实现，则这一缺陷也并无很大的影响　

7.3 DDE客户程序的实现

DDE客户程序启动DDE会话，向服务器请求并从服务器接收数据。同时还可以向服务器发送数据、命令、宏，改变服务器的状态并控制服务器的运行。　

7.3.1 联接模式(ConnectMode)

　　Delphi的DDE提供了两种联接模式：自动和人工。这可以通过DDEClinetConv 部件的ConnectMode属性进行设置。如下表所示。　

表 7.5 DDE的联接模式

━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

　　　　　值　　　　　　　　　　　意　　　　　　义

───────────────────────────────

　　　ddeAutomatic 在运行中当包含TDDEClientConv部件的窗口创建时

联接自动建立

　　 ddeManual 只有当调用OpenLink方法时联接才建立

━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━　　　

不同联接模式，DDE客户程序的实现方式不同。

对于自动模式：

1. 向窗体中加入DDEClientConv和DDEClientItem部件并命名；

2. 把DDEClientItem部件的DdeConv属性设置为DDEClientConv部件的名称；

如果在设计时建立，则通过对象观察器进行选择；如果在运行时建立联系， 则通过如下的一条语句设置属性的值：　

DDEClientItem1.DdeConv := 'DDEClientConv1' ;　

3. 和服务器建立联系，实现数据共享。

对于人工模式：

1.向窗体中加入DDEClientConv部件；

2.和服务器建立联系；

3. 数据更新时调用RequestData方法申请并获得数据。　

7.3.2 和DDE服务器建立联系　

和DDE服务器建立联系，既可以在设计时进行，也可以在运行时进行。

在设计时，DDE联接可以通过剪贴板进行粘贴。具体步骤如下：

1. 激活服务器程序，并选中你的客户程序欲联接的数据；

2. 把数据和DDE联接信息拷贝到剪贴板上。一般说来这只需要选择服务器应用程序的 Edit|Copy 菜单；

3. 在Delphi IDE的设计窗体中选中DDEClientConv部件；

4. 在Object Inspector(对象观察器)中单击DDEService属性或DDETopic属性，然后再单击Ellipsis按钮，打开DDE Info对话框；

5.选择Paste Link按钮。此时App编辑框和Topic编辑框被自动填充。如果Paste Link按钮变灰，说明你准备用作服务器的应用程序不支持DDE或者DDE信息没有被成功地拷贝到剪贴板上；

6.选择OK 按钮。此时Object Inspector中的DDEService、DDETopic 属性包含了建立一个DDE联接的正确值。

对于人工模式以下步骤是不需要的。

7.选中DDEClientItem部件，并在Object Inspector中设置DdeConv属性为已完成联接的DDEClientConv部件名称；

8.假如剪贴板上的DDE 联接信息仍保留的话，从Object Inspector的下拉列表框中选择 DDEItem 属性的值。否则输入正确的值。

在运行时，调用 SetLink 方法来建立DDE联接。

SetLink有两个String类型的参数，分别用来接受DDEService和DDETopic的值。过程执行后DDEClientConv部件的DDEService 和DDeTopic属性被设置。要注意的是：在运行时直接设置DDEService和DDETopic的值并不能建立一个DDE联接，而必须调用SetLink 方法进行初始化。

比如，下面的语句和Excel的System主题建立联接：　

DDEClietnConv. SetLink('Excel','System')；　

调用SetLink方法后，还需要设置DDEClientItem部件的DDEItem属性。

比如，下面的语句联接Excel的Topics项目，用以获取当前活跃文件的文件名：　

DDEClietnItem.DDEItem := 'Topics';　

当DDE联接建立后，联接的数据保存在DDEClientItem部件的Text和Lines 属性中，Text用于保存一个字符串(String)，Lines用于保存一个字符串链表(TStrings)对象。

为了显示联接数据，可以在DDEClientItem的OnChange事件中把数值赋给一个可视部件。

下面的事件过程把联接数据实时地显示在一个编辑框中。

　 procedure Form1.DDEClientItemChange(Sender: Tobject);

begin

Edit1.Text := DDEClientItem1.Text;

end;　

运行状态下也可以从剪贴板上粘贴DDE联接信息，并调用SetLink建立DDE会话。下面的例子显示了当用户按下应用程序中的Paste Link按钮时，动态建立DDE会话的过程。　

procedure Form1.OnPasteLink(Sender: Tobject)；

　　var

Service, Topic, Item: String;

begin

if GetPasteLinkInfo (Service, Topic, Item) then

begin

AppName.Text := Service;

TopicName.Text := Topic;

ItemName.Text := Item;

DDEClient.SetLink (Service, Topic);

DDEClientItem.DdeConv := DDEClient;

DDEClientItem.DDEItem := ItemName.Text;

end;

end;　

GetPasteLinkInfo是DDEMan 库单元中定义的一个过程。如果返回True，则DDE联接信息保存在三个参数中；如果返回False，说明剪贴板上没有正确格式的DDE联接信息。　

7.3.3 数据申请　

虽然自动模式快捷、方便，但仍有一些理由使用DDE的人工模式：

1.服务器程序可能不支持自动数据传输，客户必须显式申请服务器更新一个特定的项目；

2.节省通信费用。假如没有实时传输的要求，则人工模式可以大幅度降低通信的开销；

3.若客户程序只用于控制服务器的运行，则往往没有必要使用自动模式。

人工模式下客户程序的数据更新需要采用数据申请的方式。数据申请需要调用DDEClientConv部件的RequestData方法。RequestData有一个参数，指向要申请的DDE项目。RequestData返回一个Pchar类型的无结束符字符串，包含了申请到的文本。返回字符串占用的内存必须在程序终止前显式释放。

在人工模式下，即使存在一个DDEClientItem部件且与DDEClientConv相联接，数据更新后DDEClientItem部件的Text、Lines属性的值也不会改变。　

7.3.4 数据发送　

数据发送与一般的DDE数据流向正好相反，是把数据从DDE客户应用程序发送到DDE服务器应用程序。

数据发送使用DDEClientConv部件的两个方法PokeData 和 PokeDataLines， 它们的语法是：　

　　function PokeData (Item: String ; Data: PChar): Boolean;

　　function PokeDataLines (Item: String ; Data: TStrings): Boolean;　

参数Item是DDE服务器中被联接的项目，Data是要发送的数据。如果数据是一个字符串，则把它转化为PChar类型并调用PokeData方法；如果数据是一个字符串链表对象，可调用PokeDataLines方法。

方法的返回值标志数据传送是否成功。因为有一些DDE服务器应用程序并不接收发送的数据。

下面的语句把编辑框中的内容发送给服务器：　

　　StrPCopy(TheText , Edit1.text);

DDEClientConv1.PokeData(DDEClientItem1.DDEItem , TheText);　

过程StrPCopy把一个Pascal类型的字符串拷贝到一个无结束符的PChar类型字符串中。

DELPHI基础教程

第七章　剪贴板和动态数据交换（二）

--------------------------------------------------------------------------------

7.3.5 控制服务器应用程序的执行　

客户程序控制服务器应用程序的一个方面是：必要的时候客户程序可以启动服务器程序，并装载会话主题。

而客户程序控制服务器应用程序更重要的一点是向服务器发送服务器承认的宏命令，来完成对服务器应用程序的各种操作。服务器到底支持哪些宏命令，可参阅服务器应用程序文档。

发送宏命令要使用DDEClientConv的两个方法 ExecuteMacro和ExecuteMacroLines ，它们的语法如下：　

function ExecuteMacro(Cmd: PChar; WaitFlag: Boolean): Boolean;

function ExecuteMacroLines(Cmd: TStrings;WaitFlag: Boolean): Boolean;　

Cmd是欲发送的宏命令字符串或宏命令字符串链表。WaitFlag决定了在DDE 服务器程序执行宏命令时客户程序的行为。如果WaitFlag设置为True，则在服务器宏命令执行完毕前，不允许对ExecuteMacro、ExecuteMacroLines、PokeData、PokeDataLines这些方法的成功调用，它们都不向服务器发送数据并返回False。如果WaitFlag设置为False，则调用的方法在第一个宏执行完毕前即试图向服务器发送数据。

WaitFalg的设置也取决于服务器应用程序。一些应用程序当在第一个宏执行完之前就试图向它发送数据或命令时，可能导致第一个宏执行失败或导致不可预料的后果。具体情况可查阅服务器应用程序文档。

函数返回值表示命令串是否被成功传输。而宏命令执行是否成功客户是无法检测到的。　

7.3.6 格式化文本　

DDEClientConv有一个布尔属性FormartChars，用于决定是否格式化文本。所谓格式化文本是指从传输来的文本数据中过滤掉BackSpace(8)、 Tab(7) 、Linefeed(10) 、Return(13)等字符。括号内是字符的ASCII码。许多时候这些字符将导致DDE客户数据显示的混乱。

　　FormatChars的缺省值是False。　

7.3.7 响应DDE事件　

部件DDEClientConv有两个事件OnOpen和OnClose，分别在DDE 会话建立和中止时触发。部件DDEClientItem有一个OnChange事件。这一事件常用于DDE项目数据的转储和显示，如(7.3.1)节所示。

在自动模式下，OnOpen事件在包含DDEClientConv部件的窗口创建时触发，或在调用SetLink方法时触发，OnClose事件在客户程序或服务器程序关闭时触发。

在人工模式下，OnOpen事件在调用OpenLink 方法时触发，OnClose事件在调用ColseLink方法时触发。　

7.3.8 利用客户程序和Excel交换数据　　　

下面我们建立一个DDE客户程序，并利用这一程序与Excel中的一个工作表交换数据。程序设计界面

界面中包含一个DDE会话部件DDEClientConv1和DDE项目部件DDEClientItem1，用于建立和维护DDE联接；一个RadioGroup控件和其中的两个无线电按钮AutoRadio、ManualRadio，用于设置联接模式；一个GroupBox控件和其中的两个按钮RequestBtn和PokeBtn，用于控制数据的申请和发送，其中RequestBtn在自动模式下变灰；一个文本框Memo1用于保存DDE数据；一个按钮PasteBtn用于粘贴联接信息并建立DDE联接；另外一个按钮CloseBtn用于关闭系统。

设计时把DDEClientConv1的FormatChars属性置为True，这样可以保留服务器传来数据的显示格式；ConnectMode保留ddeAutomatic的缺省设置。

程序在类TForm1中定义了一个私有数据成员Automatic，用于标志联接模式；三个字符串数据成员DDEService、DDETopic、DDEItem用于记录联接信息。

窗口生成时进行变量和部件状态的初始化。　

procedure TForm1.FormCreate(Sender: TObject);

begin

RequestBtn.Enabled := False;

AutoRadio.Checked := True;

Automatic := True;

end;　

当联接模式改变时，程序进行相应的处理。

自动模式转换为人工模式：　

procedure TForm1.ManualRadioClick(Sender: TObject);

begin

if Automatic then

begin

RequestBtn.Enabled := ManualRadio.Checked;

DDEClientConv1.ConnectMode := ddeManual;

Automatic := False;

end;

end;　

人工模式转换为自动模式：

procedure TForm1.AutoRadioClick(Sender: TObject);

begin

if not Automatic then

begin

RequestBtn.Enabled := ManualRadio.Checked;

If (DDEService = '') or (DDETopic = '') then

begin

MessageDlg(' Can not Set Link.',mtWarning,[mbOK],0);

Exit;

end;

DDEClientConv1.SetLink (DDEService, DDETopic);

DDEClientItem1.DdeConv := DDEClientConv1;

DDEClientItem1.DDEItem := DDEItem;

DDEClientConv1.ConnectMode := ddeAutomatic;

Automatic := True;

end;

end;　

当从自动模式转换到人工模式，只需要简单修改相应属性即可；而从人工模式转换到自动模式，则需要调用SetLink重新建立联接，否则往往会引发一个DDE异常。

联接的建立采用从剪贴板粘贴联接信息的方式，这是最具有灵活性的一种方法。

procedure TForm1.PasteBtnClick(Sender: TObject);

begin

if GetPasteLinkInfo (DDEService, DDETopic, DDEItem) then

begin

DDEClientConv1.SetLink (DDEService, DDETopic);

if Automatic then

begin

DDEClientItem1.DdeConv := DDEClientConv1;

DDEClientItem1.DDEItem := DDEItem;

end;

end;

end;　

GetPasteInfo是 DDEMan库单元中定义的一个函数，用于检测剪贴板上是否有联接信息并返回相应的DDE服务、主题和项目。

对于人工模式，必须由客户显式向服务器申请数据。在这种模式下DDE项目部件是多余的，接收到的DDE联接信息用一个字符串来记录。下面是实现代码。　

procedure TForm1.RequestBtnClick(Sender: TObject);

var

TheData: PChar;

begin

If DDEItem = '' then

begin

MessageDlg('Can not Request Data',mtWarning,[mbOK],0);

Exit;

end;

TheData := StrAlloc(79);

DDEClientConv1.OpenLink;

TheData := DDEClientConv1.RequestData(DDEItem);

DDEClientConv1.CloseLink;

if TheData <> nil then

Memo1.Text := StrPas(TheData);

StrDisPose(TheData);

end;

OpenLink、CloseLink方法用于打开和关闭联接。RequestData方法向服务器申请数据并返回到一个PChar字符串中。字符串必须显式分配内存并在退出时释放。

数据发送在不同联接模式下是不同的。对于人工模式，增加了联接的打开和关闭操作。程序清单如下。　

procedure TForm1.PokeBtnClick(Sender: TObject);

begin

If DDEItem = '' then

begin

MessageDlg('Can not Poke Data.',mtWarning,[mbOK],0);

Exit;

end;

if Automatic then

DDEClientConv1.PokeDataLines(DDEItem,Memo1.Lines)

else

begin

DDEClientConv1.OpenLink;

DDEClientConv1.PokeDataLines(DDEItem,Memo1.Lines);

DDEClientConv1.CloseLink;

end;

end;　

打开Microsoft Office中的Excel，装入一个文件，把相关的单元选中，拷贝到剪贴板上。而后运行程序，按下Paste Link按钮，DDE联接就建立起来，相关单元中的数据显示在Memo1中。之后可以进行模式转换、数据申请、申请发送等一系列工作。运行后的屏幕显示如下图所示。

7.3.9 用客户程序控制程序管理器　

下面的例子用客户程序向程序管理器发送命令，用于创建程序组、程序项以及删除程序组。

程序管理器提供了应用程序的DDE接口命令字符串，应用程序利用这些命令字符串可以实现以下的功能：

1.创建程序组

命令格式为：

CreateGroup(程序组名[，程序组所在的路径])

程序组不存在时进行创建；如程序组存在则按照指定的路径激活。

2.删除程序组

命令格式为：

DeleteGroup(程序组名)

3.显示程序组

命令格式为；

ShowGroup(程序组名，显示标志)

显示标志用于控制程序组在程序管理器中以极大、极小或正常方式显示。

4.重新装入程序组

命令格式为：

ReLoadGroup(程序组名)

该命令使程序管理器先删除而后再重新装入一个已有的程序组。

5.向程序组中添加程序项

命令格式为：

AddItem(命令行[，描述[，图标路径[，图标序号[，图标横坐标，图标纵坐标[，工作区目录[，热键[，是否最小化显示标志]]]]]]])

命令行控制程序项的执行，可包括路径、参数等。其它参数分别对应在程序管理器中添加一个程序项时需要设置的参数和选项。它们都有缺省设置，因而是可选的。

6.替换程序组中的程序项

命令格式为：

ReplaceItem(程序项名)

该命令删除一个程序项，并将所删除程序项的位置记录下来，以后通过AddItem在这个所记录的位置增加新项目。

7.从程序组中删除程序项

命令格式为：

DeleteItem(程序项名)

从当前活动程序组中删除一个程序项。

8.关闭程序管理器

命令格式为：

ExitProgram(是否保存程序组信息标志)

从应用程序向程序管理器发送命令字符串的方法是基本一致的。为简便起见，在例程中只实现了其中仅包含一个字符串参数的情形，读者可以很容易作进一步的扩展。

程序设计界面如图所示，包含一个DDE客户会话(DDEClientConv)部件和四个完成不同功能的按钮。

DDEClientConv在设计时和程序管理器建立一个DDE会话，其中DDE服务器和DDE主题 都为PROGMAN。联接模式ConnectMode设置为ddeManual。

我们把只有一个字符串参数的命令发送情况抽象出来，形成下面的SendMacro函数。　

function TForm1.SendMacro(Name: String;Command: String): Boolean;

var

Macro: String;

Cmd: array[0..255] of Char;

begin

Result := True;

if Name <> '' then

begin

Macro := Format('['+Command+'(%s)]', [Name]) + #13#10;

StrPCopy (Cmd, Macro);

DDEClient.OpenLink;

if not DDEClient.ExecuteMacro(Cmd, False) then

Result := False;

DDEClient.CloseLink;

end;

end;　

过程首先利用Format函数形成宏字符串：　

Macro := Format('['+Command+'(%s)]', [Name]) + #13#10;　

而后把Pascal类型的字符串拷贝到一个程序管理器可接受的PChar类型字符串中。

DDE联接采用人工模式。首先调用OpenLink方法。而后调用ExecuteMacro方法发送命令，如失败则返回False。最后用CloseLink关闭联接。

三个按钮CreateButton、AddButton、DeleteButton分别用于创建程序组、添加程序项、删除程序组。它们的程序实现大同小异，如下所示。

创建程序组：　

procedure TForm1.CreateButtonClick(Sender: TObject);

var

Name: String;

begin

Name := InputBox('Input Box','Input Group Name','');

if Name = '' then

MessageDlg('Group name can not be blank.', mtError, [mbOK], 0)

else

if SendMacro(Name,'CreateGroup') = False then

MessageDlg('Unable to create group.', mtInformation, [mbOK], 0);

end;

添加程序项：　

procedure TForm1.AddButtonClick(Sender: TObject);

var

Name: String;

begin

Name := InputBox('Input Box','Input Application full_Path name','');

if Name = '' then

MessageDlg('Application name can not be blank.', mtError, [mbOK], 0)

else

if SendMacro(Name,'AddItem') = False then

MessageDlg('Unable to Add Item.', mtInformation, [mbOK], 0);

end;

删除程序组：　

procedure TForm1.DeleteButtonClick(Sender: TObject);

var

Name: String;

begin

Name := InputBox('Input Box','Input Group Name to be Deleted','');

if Name = '' then

MessageDlg('Group name can not be blank.', mtError, [mbOK], 0)

else

if SendMacro(Name,'DeleteGroup') = False then

MessageDlg('Unable to create group.', mtInformation, [mbOK], 0);

end;

7.4 DDE服务器程序的实现　

　 DDE服务器程序响应DDE客户的请求，一般地它包含了客户程序希望获取的数据。

创建一个DDE服务器程序，必须要把一个DDEServerItem部件添加到窗体中。DDEServerItem的text或Lines属性包含了要联接的数据。一般地 DDEServerItem部件又和另一个文本控件相联系。当文本控件中的内容变化时则更新DDEServerItem 的text或Lines属性的值。下面的一段程序把DDEServerItem和一个列表框相联系。这一联系是在列表框的OnChange事件中实现。　

procedure Form1.OnListBoxChange(Sender: TObject);

begin

DDEServerItem1.Lines := ListBox1.Items;

end;　

创建DDE服务器程序时也可以再加入一个DDEServerConv部件，并把两个部件利用DDEServerItem的ServerConv属性联系起来。此时DDE主题成为部件DDEServerConv的名称，而不是拥有DDEServerItem部件窗体的标题。

在下列情况下使用DDEServerConv部件成为必要：

1.拥有DDEServerItem 部件窗体的标题可能在运行时改变或可能有其它窗体拥有同样的标题。在这种情况下DDE联接可能无法建立；

2.DDE客户程序可能会向你的服务器程序发送一条宏命令。在这种情况下只有拥有一个DDEServerConv部件才能响应OnMacroExecute事件并执行相应的动作。　

7.4.1 和DDE客户程序建立联接　

一般说来，建立DDE联接是客户程序的任务。但服务器程序可以把一个联接拷贝到剪贴板上供客户程序粘贴并建立DDE会话。步骤如下：

1.调用DDEServerItem部件的CopyToClipboard方法， 把Text(或Lines)属性的值和DDE联接信息拷贝到剪贴板上；

2.DDE客户程序插入联接的数据。一般地这是通过选择适当的命令(如Edit|Paste Special或Edit|Paste Link)来实现的。

7.4.2 响应DDE事件　

部件DDEServerConv有三个事件：OnOpen、OnClose、OnExecuteMacro。前两个事件在DDE会话建立和终止时触发。同(7.3.7)中的介绍。

OnExecuteMacro事件用于响应客户程序发送过来的宏指令。OnExecuteMacro事件处理过程有一个Msg参数，保存发送过来的指令串。用户可以在该过程中决定如何响应这些宏指令。

DDEServerItem部件只有一个事件OnPokeData。这一事件用于响应客户程序发送来的数据。如果客户程序是Delphi程序，则客户程序调用了PokeData或PokeDataLines方法。在这一事件的处理过程中用户可以把发送来的数据保存到一个合适的地方。一般说来这应该就是DDEServerItem所联系的文本控件。

下面的程序把发送来的数据保存到ListBox中。

procedure Form1.OnDDEServerItemPokeData(Serder: TObject)；

begin

ListBox1.Items := DDEServerItem1.Lines;

end;　

7.4.3 DDE服务器应用例程　

下面我们创建一个DDE服务器例程和一个相应的DDE客户例程。

DDE服务器例程可以完成的工作有：

1.把DDE联接信息拷贝到剪贴板上供其它程序使用；

2.利用一个TMemo部件为其它程序提供数据源；

3.接收客户程序发送来的数据；

4.根据客户程序发送来的宏指令改变自身的运行状态。

其中各部件的关键属性如下：　

DDESrvrForm.ActiveControl = Memo1

DDESrvrForm.Menu = MainMenu1

Bevel1.Align = alTop

Memo1.Align = alClient

DDETestItem.ServerConv = DDETestTopic　

通过设置Bevel1、Memo1的Align属性，可以保证窗口大小变化时仍能有较为美观的屏幕显示。

Memo1是服务器的数据源，DDE项目部件DDETestItem通过Memo1的OnChange事件与Memo1 建立联系。　

procedure TDdeSrvrForm.doOnChange(Sender: TObject);

begin

if not FInPoke then

DDETestItem.Lines := Memo1.Lines;

end;　

其中FInPoke是一个布尔类型的私有数据成员，用于标志程序是否在处理客户程序的数据发送。当数据是由客户发送过来转存到数据源时，则没有必要再把数据传给DDE项目部件。

把联接信息拷贝到剪贴板，只需简单调用DDETestItem的CopyToClipboard方法。　

procedure TDDESrvrForm.CopyClick(Sender: TObject);

begin

DDETestItem.CopyToClipboard;

end;　

这是通过菜单项Edit|Copy来调用的。

接收客户程序发送来的数据，是在DDETestItem的OnPokeData事件处理过程中。在接收过程中改变FInPoke的值，以阻止数据的无效反送。　

procedure TDDESrvrForm.doOnPoke(Sender: TObject);

begin

FInPoke := True;

Memo1.Lines := DDETestItem.Lines;

FInPoke := False;

end;　

在DDE会话部件DDETestTopic的OnExecuteMacro事件处理过程中处理客户发送来的宏指令。我们共定义了五种可以响应的宏指令：CopyDDE、Clear、WS_Normal、WS_MINIMIZED、WS_MAXIMIZED，分别用于拷贝联接信息、清除Memo1中的内容以及改变窗口显示状态。

procedure TDdeSrvrForm.doMacro(Sender: TObject;Msg: TStrings);

var

Cmd: String;

i: Integer;

begin

Cmd := '';

if Msg.Count = 0 then Exit;

for I := 0 to Msg.Count-1 do

begin

Cmd := Msg.Strings[i];

if UpperCase(Cmd) = 'COPYDDE' then

DDETestItem.CopyToClipboard

else if UpperCase(Cmd) = 'CLEAR' then

Memo1.text: = ''

else if UpperCase(Cmd) = 'WS_NORMAL' then

WindowState := wsNormal

else if UpperCase(Cmd) = 'WS_MINIMIZED' then

WindowState := wsMinimized

else if UpperCase(Cmd) = 'WS_MAXIMIZED' then

WindowState := wsMaximized

else

MessageDlg('Invalid Command',mtWarning,[mbOK],0);

end;

end;　

下面的DDE客户程序，主要是为了验证上面的DDE服务器程序而设计的，但同时也提供了一个DDE客户程序设计的完整实例。

　

程序把接收到的DDE数据保存在一个TMemo类部件DDEDat中，而欲发送给服务器的数据和宏指令在另一个TMemo类部件PokeDat中输入。两个按钮PokeBtn、ExecuteBtn用于发送数据和宏指令。两个菜单项File|New Link和Edit|Paste Link用于根据用户的输入建立新联接和从剪贴板上粘贴DDE联接。

DDE联接的建立通过调用SetLink方法实现。

建立新联接的实现代码如下。　

procedure TFormD.doNewLink(Sender: TObject);

begin

DDEClient.SetLink (AppName.Text, TopicName.Text);

DDEClientItem.DdeConv := DDEClient;

DDEClientItem.DDEItem := ItemName.Text;

end;　

通过从剪贴板粘贴联接信息来建立联接的实现代码如下。　

procedure TFormD.Edit1Click(Sender: TObject);

var

Service, Topic, Item : String;

begin

PasteLink1.Enabled := GetPasteLinkInfo (Service, Topic, Item);

end;

procedure TFormD.doPasteLink(Sender: TObject);

var

Service, Topic, Item : String;

begin

if GetPasteLinkInfo (Service, Topic, Item) then

begin

AppName.Text := Service;

TopicName.Text := Topic;

ItemName.Text := Item;

DDEClient.SetLink (Service, Topic);

DDEClientItem.DdeConv := DDEClient;

DDEClientItem.DdeItem := ItemName.Text;

end;

end;　

在DDEClientItem的OnChange事件处理过程中把接收到的事件保存在DDEDat中。　

procedure TFormD.DDEClientItemChange(Sender: TObject);

begin

DDEDat.Lines := DDEClientItem.Lines;

end;　

数据发送的实现代码如下。　

procedure TFormD.doPoke (Sender: TObject);

var

DDECli : TDDEClientConv;

begin

DDECli := DDEClientItem.DdeConv;

if DdeCli <> nil then

DDECli.PokeDataLines (DDEClientItem.DDEItem, PokeDat.Lines);

end;

宏指令发送的实现代码如下。　

procedure TFormD.doMacro (Sender: TObject);

var

DDECli: TDDEClientConv;

Cmd: String;

begin

DDECli := DDEClientItem.DdeConv;

if DDECli <> nil then

begin

Cmd := PokeDat.Text + #13#10;

DDECli.ExecuteMacroLines (PokeDat.Lines, True);

end;

end;　

运行以上两个程序，建立DDE联接。经测试，数据传输、数据发送和宏指令的发送与执行都达到预期要求。

7.4.4 小结　

剪贴板和DDE是Windows下数据通信的两种方法。Delphi以简便、友好的方式实现了相应的功能，为用户编程提供了方便。一般说来，剪贴板多用于静态数据传输，而DDE用于动态数据交换、控制其它程序运行等场合。这些内容对于多用户环境下的程序开发是很重要的

谢谢!

学习中，需要多看看

学习学习~~~偷师本学徒来偷偷~~~