delphi(8)
时间：2006-06-10 来源：许我一个信仰
第9章 创建定制组件
对Delphi研发人员来说，创建定制组件的前景非常好。Delphi是用Object Pascal 实现的，包括了种类繁多的组件，有些是用Object Pascal实现的，另一些是ActiveX组件。在本章中你可以建立几种组件，其中有一个调试组件可用于跟踪代码并输出到日志文件、捕获代码路径，和对代码中一些具有不变性的条件进行测试。本章的内容包括：使用组件向导过程、编译并测试组件、将组件和图标关联起来，以及包的安装和管理。
许多类可以转换成组件，在设计时更加易于使用。组件可能小而简单，也可能大而复杂。TEdit和TLabel控件是基本组件的例子。而较大的商务组件能够对一整类问题提供完整的解决方案；例如Word和Excel就是大而复杂的组件。通常在创建大而复杂的组件时，需要创建许多较小的组件和子系统，然后使用这些小的模块来构造所需的解决方案。本章相当于一块基脚石，它是更为强大的组件和应用程序的基础。
9.1 组件单元概览
要成功创建组件，关键是要认识到组件是类。对于好的类和好的组件来说，二者的规范是基本相同的。TObject类是所有类的祖先；而TPersistent类是所有组件的祖先，它将组件与其他类区分开来。
TPersistent将持久状态的概念引入到类中。即：在应用程序的多次运行之间，可以存储并再次获取类的特性。区分组件与其他类的另一个因素是，组件可以在设计时进行修改；因为组件具有公开权限的接口。并非所有组件都有精巧的公开接口，但大多数组件都有一些数据和事件特性，可以在设计时对其进行可视化的修改。所有其他的类都是用代码编程修改，并且直到程序运行时才生效，但组件并非如此。对组件数据特性的改变可以立即生效。在使用组件时，首先要知道定义组件的单元如何编写。
unit UEditConvertType;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs,
StdCtrls;
type
TEditConvertType = class(TEdit)
private
{ Private declarations }
protected
{ Protected declarations }
public
{ Public declarations }
published
{ Published declarations }
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('PKTools', [TEditConvertType]);
end;
end.
从代码列表中可以看到，组件单元与其他单元基本上没有区别。组件单元也有接口部分和实现部分，其作用与非组件类相同。unit 和 uses语句也是相同的。接口部分和实现部分均可有uses子句。组件类在接口类型部分定义。上述代码定义了TEdit的子类TEditConvertType。类的四种访问区域都是可用的。私有、保护、公有接口与通常的意义相同，公开接口包含了组件的事件和数据特性，组成了组件的设计时接口。
最重要的不同是实现部分Register过程的说明和定义。当使用Component | Install Component菜单项安装组件时，Delphi将执行相应的Register过程，该过程调用了RegisterComponents过程。RegisterComponents过程的第一个参数表示把组件添加到组件目标的哪一个属性页（这里是PKTools），第二个参数是TComponentClass类的数组，表示要注册的组件。该元类数组表明Register过程可用在一个语句中注册多个组件。例如：如果UEditConvertType单元包含多个组件——TEditConvertType和TMaskedEditConvertType，那么可以将所有的类名添加到数组中并安装到PKTools面板上。
RegisterComponents('PKTools', [TEditConvertType,
TMaskedEditConvertType]);
要记住的关键是：通过把组件分层，然后逐层的添加功能，即可对组件的功能进行增量和迭代式的修改。在一个组件中包含过多的功能是不必要的。
虽然从零开始创建组件并非令人畏惧的任务，但是启动新组件最容易的途径是使用组件向导过程。下节将快速的浏览一下组件向导，然后演示一个新组件的例子（在9.5节“编译并测试组件”中，您可以建立并测试一个 TEditConvertType 组件）。
9.2 使用组件向导
Component Wizard对话框（见图9.1）将创建一个单元，其中包括了类的外壳定义和Register过程。使用向导总比从零开始方便得多。按照下列步骤，即可创建一个新的标签组件，该组件可以显示扩展的字体风格。
图9.1 Delphi的Component Wizard对话框可以自动地
生成单元，其中包含了新组件定义的外壳
1．在Delphi中，单击Component | New Component菜单项，显示组件向导对话框。
2．在 New Component对话框里选择TLabel作为祖先类型。
3．将新的组件类命名为TLabelExtendedFont。
4．对所要创建的组件选择一个已存在的组件面板属性页，或输入新的属性页名称。
5．给出单元文件的路径和名字。可以用前缀U替换类名中的前缀T作为单元的名字，这样就得到了ULabelExtendedFont单元。
6．如果搜索路径中并未包含新的单元，则更新该路径。若单击了浏览按钮（Unit file name输入框右侧的省略号按钮），那么路径将自动更新。
7．单击OK按钮，生成单元文件。
TLabelExtendedFont可以在文字后显示阴影，从而产生使文本凸起的效果。可以对深度感知进行配置，以显示或浅或深的阴影。
9.2.1 为扩展的标签控件编写代码
扩展的标签控件可以显示带有阴影的标签，其深度和颜色是可变的。这意味着需要一些特性来表示是否显示阴影、阴影的深度、阴影的颜色等。标签的Color特性用做前景色。最后，为确保每次接收到Paint消息时都出现应有的效果，我们需要过载paint方法。组件的完整代码列出如下：
unit ULabelExtendedFont;
// ULabelExtendedFont.pas - Contains extended fonts, currently
// only defines shadowing text capability
// Copyright (c) 2000. All Rights Reserved.
// by Software Conceptions, Inc. Okemos, MI USA (800) 471-5890
// Written by Paul Kimmel
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs,
StdCtrls;
type
TShadowDepth =(sdShallow, sdDeep);
TLabelExtendedFont = class(TLabel)
private
{ Private declarations }
FHasShadow : Boolean;
FShadowColor : TColor;
FShadowDepth : TShadowDepth;
procedure SetShadowColor( Const Value : TColor );
Procedure SetShadowDepth( Const Value : TShadowDepth );
Procedure SetHasShadow( Const Value : Boolean);
Procedure DrawShadow;
protected
{ Protected declarations }
Procedure Paint; override;
public
{ Public declarations }
published
{ Published declarations }
Property HasShadow : Boolean read FHasShadow write
SetHasShadow;
property ShadowColor : TColor read FShadowColor write
SetShadowColor;
property ShadowDepth : TShadowDepth read FShadowDepth write
SetShadowDepth;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents(‘PKTools’, [TLabelExtendedFont]);
end;
{ TLabelExtendedFont }
procedure TLabelExtendedFont.DrawShadow;
const
Alignments: array[TAlignment] of Word = (DT_LEFT, DT_RIGHT,
DT_CENTER);
var
Rect : TRect;
Flags : Word;
begin
SetBkMode( Canvas.Handle, Windows.Transparent );
Rect := ClientRect;
Canvas.Font := Font;
Canvas.Font.Color := FShadowColor;
Rect.Left := Rect.Left - Ord(FShadowDepth) - 2;
Rect.Top := Rect.Top - Ord(FShadowDepth) - 2;
Flags := DT_EXPANDTABS or Alignments[Alignment];
if( WordWrap ) then
Flags := Flags Or DT_WORDBREAK;
if not ShowAccelChar then Flags := Flags or DT_NOPREFIX;
DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags);
end;
procedure TLabelExtendedFont.Paint;
begin
if( FHasShadow ) then DrawShadow;
inherited Paint;
end;
procedure TLabelExtendedFont.SetHasShadow(const Value: Boolean);
begin
if( Value = FHasShadow ) then exit;
Transparent := Value;
FHasShadow := Value;
Invalidate; // cause it to repaint
end;
procedure TLabelExtendedFont.SetShadowColor(const Value: TColor);
begin
if( Value = FShadowColor ) then exit;
FShadowColor := Value;
Invalidate;
end;
procedure TLabelExtendedFont.SetShadowDepth(const Value:
TShadowDepth);
begin
if( Value = FShadowDepth ) then exit;
FShadowDepth := Value;
Invalidate;
end;
end.
在三个属性HasShadow、ShadowDepth、ShadowColor各自的read子句中都直接返回了实际的字段值，而其write子句都调用了相应的写方法。由于这三个set方法都使得控件失效，导致重新绘制，因此在这些过程中都需要先计算当前特性值，并在没有发生真正的改变的情况下，退出相应的过程。
大部分工作都是在私有方法DrawShadow中完成的，该方法由Paint方法调用。要注意：如果调用SetHasShadow 存取方法，可能会改变Transparent状态值。这确保了标签的背景色不会隐藏阴影字体。当调用Paint方法时，如果HasShadow为真，那么背景文字将直接由DrawShadow方法写到画布上（为清楚起见，DrawShadow 方法使用了块注释；这里为使代码短些没有列出注释）。
DrawShadow方法创建了阴影效果。SetBkMode是一个API 调用，它将画布模式设置为Transparent，但并不影响相应的特性。ClientRect用于得到组件的客户区矩形，然后加以修改使之与组件的边界矩形稍有偏移，以便确定DrawText调用向画布写入文本的位置。FShadowDepth字段的序数值用于帮助确定阴影字体的偏移值。Alignments数组用来将TAlignment枚举值转换为Windows API中使用的字体对齐常数值。如果组件把WordWrap设置为True，DT_WORDBREAK将添加到位标志Flags。而且，如果在Object Inspector中设置了ShowAccelChar，那么DT_NOPREFIX将以按位或的方式添加到Flags。
简而言之，DrawShadow方法考虑了组件中所有用于格式化的属性，并将其转换为Windows中的等价形式。最后使用DrawText API方法直接写到标签组件的画布上。
9.2.2 测试控件
图9.2中，使用新的标签组件在面板上显示了几行文本。在安装新的组件之前，可以像测试其他的类一样，很容易地在程序中对其进行测试。按照下列步骤，可以测试TLabelExtendedFont 组件。
图9.2 这里是TLabelExtendedFont的三个实例，它们在窗体上显示了三行文本
注意：在进行子类化时一个很好的惯例是：使用超类名作为新组件名字的首部。这样，Delphi就可以在Object Inspector中按字母顺序对类似的组件进行排序，并且有助于从一般到特殊来了解类的功能。
1．在Delphi中创建一个新的应用程序。
2．把ULabelExtendedFont 单元添加到工程中。
3．在新工程的默认窗体单元中，向实现部分的uses语句添加ULabelExtendedFont 单元。
4．添加一些用于创建标签组件实例的代码（如下所示）。
with TLabelExtendedFont.Create( Self ) do
begin
Top := 10;
Left := 10;
Caption := 'http://www.softconcepts.com';
HasShadow := True;
ShadowDepth := sdShallow;
ShadowColor := clBlack;
Font.Style := [fsBold, fsItalic];
Font.Name := 'New Times Roman';
Font.Size := 16;
Font.Color := TColor( Random( 1000000 ) ) + 100;
Parent := Self;
end;
警告：在上述动态创建的组件并不需要显式利用Free释放，因为它们是由窗体拥有的。每个拥有控件的组件都负责删除其子控件（参见controls单元中列出的TWinControl.Destroy代码，看一看 TWinControl控件（如Form）释放时，将发生哪些动作）。
上述代码创建了扩展标签控件的实例，并将包含它的控件作为其所有者（将Parent特性赋值为Self也是可以的，前提是对象应该是TWinControl类型的，如窗体），并设置了标签控件在左上位置。控件的标题就是要显示的文本。HasShadow、ShadowDepth和ShadowColor 是新增的特性，用于确定字体和阴影的外观。最后需要设置控件的所有者，因为当被拥有的控件需要对消息如WM_PAINT进行响应时，Windows 是通过其所有者通知控件的（将组件安装到包，可以将组件显示在组件面板上，可以参考9.8节“将组件安装到包中”）。
9.3 组件的构造函数和析构函数
组件是类。所以，在需要的情况下，它们可以有重载的构造函数和析构函数。组件构造函数定义为Constructor Create（AOwner：TComponent）;virtual;。所有类的析构函数都具有同样的形式：destructor Destroy;override;。要添加构造函数、析构函数或同时添加两者到组件类中，可声明如下：
constructor Create( AOwner : TComponent ); override;
destructor Destroy; override;
通常，如果组件包含由构造函数分配的对象，则需要析构函数。如果在组件中增加新的存储属性而且需要初始化，或者组件拥有对象时，构造函数是很有用处。否则可以使用超类构造函数和超类析构函数。最后，TLabel的构造函数和析构函数完成了所有的初始化和清除工作（可以参考第8章中防止大量消耗处理器时间的特性改变，对过载组件构造函数的例子的讨论）。
9.4 定义组件特性
组件特性可以具有任何有意义的外观。如果要在Object Inspector中显示特性，需要将其声明为公开权限。反之亦然。有时候您可能想限制在Object Inspector中显示的特性。当定义组件的子类时，可以自动得到公开特性。然而许多Delphi组件实现为TCustomComponent，因而其属性具有保护权限，如果要定义仅显示某些特定特性的组件，可以继承TCustomComponent。
这种类型组件的一个例子是版本标签组件，可能显示在About对话框中（参见图9.3，其中包括了About对话框模板，以及显示了版本信息的TVersionLabel控件）。如图9.4所示，在Project Options对话框的Version Info属性页上所设置的版本信息，可以通过版本标签来动态显示。由于版本信息是特定于Windows的，我们需要使用两个Windows API过程来取得版本信息并解码。
图9.3 把TVersionLabel添加到New Items对话框的Form属性页中的
AboutBox模板上。图中所示的程序版本为1.0，已经编译了两次
提示：当使用版本信息时，如果需要编译器来跟踪编译应用程序的次数，请确认已经选定了“Include version information in project”和“Auto- increment project number”复选框。
图9.4 Project Options对话框的Version Info属性页可以向程序添加动态版本信息。而
TVersionLabel控件可以显示不断更新的版本信息。有可能就是在About对话框中
我们知道，版本标签组件是一种特定用途的标签组件，并不具有通常的用途。这意味着不需要程序员直接修改标题特性。实际上，版本标签太专门化，以至于我们不需要程序员修改与版本信息相关的任何属性。因此你需要子类化TCustomLabel来得到TVersionLabel组件；这样所有的特性都具有保护权限，减少了无意误用的可能性。使用Component菜单启动组件向导，为TVersionLabel创建一个单元。将单元命名为UVersionLabel，并子类化TCustomLabel来得到新组件。
UVersionLabel.pas单元的接口部分如下（实现部分在后面的段落中，将二者合起来可以得到完整的代码）。
unit UVersionLabel;
// UVersionLabel.pas - Fills in the version label from the
FileVersionInfo
// Copyright (c) 2000. All Rights Reserved.
// Written by Paul Kimmel. Okemos, MI USA
// Software Conceptions, Inc 800-471-5890
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs,
StdCtrls;
type
TVersionLabel = class(TCustomLabel)
private
{ Private declarations }
FFileName : TFileName;
FMask: String;
function GetEnvPathString : String;
function GetApplicationName( const AppName : String ) :
String;
protected
{ Protected declarations }
procedure SetFileName( Value : TFileName );
procedure SetVersion;
procedure SetMask(const Value: String);
property Caption stored False;
public
{ Public declarations }
published
{ Published declarations }
constructor Create(AOwner : TComponent); override;
property FileName : TFileName read FFileName write
SetFileName;
property Mask : String read FMask write SetMask stored True;
end;
procedure Register;
该类定义了两个字段：FFileName和FMask。FFileName字段用于存储可执行文件的路径和文件名，版本信息就是从该文件读取的。FMask字段包含了实际的标签标题的缺省掩码值。GetEnvPathString用于从系统环境返回路径字符串。该方法在设计时使用，用来查找可执行文件。GetApplicationName实现了动态的设计时和运行时的代码，用于确定可执行文件名。
SetFileName是FileName特性的写方法。SetVersion更新Caption属性，以精确显示版本信息。SetMask是FMask字段的写存取器（accossor）。要谨慎或采用一些错误检测代码，以防用户定义的掩码值没有包含足够的数据。property Caption声明并未提升Caption特性的权限，因此该属性仍然是保护权限。但却改变了存储限定符，因此版本标题不再存储。如果版本标题被存储，在读取动态版本后，DefineProperties方法将从.DFM文件中读取存储的版本信息并覆盖标题，导致出现不正确的版本和编译信息。
公开访问区域并未提升TCustomLabel中的保护特性。结果用户无法编程更新标签或标题。定义了一个新的构造函数，添加了两个额外的特性FileName和 Mask，以表示私有字段。TVersionLabel类的实现如下。
implementation
procedure Register;
begin
RegisterComponents('PKTools', [TVersionLabel]);
end;
constructor TVersionLabel.Create(AOwner : TComponent);
resourcestring
DefaultMask = 'Version %s.%s (Release %s Build %s)';
begin
inherited Create(AOwner);
Mask := DefaultMask;
end;
procedure TVersionLabel.SetVersion;
var
MajorVersion, MinorVersion, Release, Build : String;
Version : String;
begin
Version := GetVersionString( FFileName );
DecodeVersion( Version, MajorVersion, MinorVersion, Release,
Build );
Caption := Format(FMask, [MajorVersion, MinorVersion, Release,
Build] );
end;
resourcestring
DefaultPath = '.\;\';
function TVersionLabel.GetEnvPathString : String;
const
MAX = 1024;
begin
SetLength( result, MAX );
if( GetEnvironmentVariable( PChar('Path'), PChar(result), MAX )
= 0 ) then
result := DefaultPath;
end;
function TVersionLabel.GetApplicationName(const AppName : String
) : String;
begin
if( csDesigning in ComponentState ) then
// see if a compiled version already exists, if we are designing
result := FileSearch( AppName, GetEnvPathString + DefaultPath)
else
result := Application.EXEName;
end;
procedure TVersionLabel.SetFileName( Value : TFileName );
begin
if( CompareText( FFileName, Value ) = 0 ) then exit;
FFileName := GetApplicationName( Value );
SetVersion;
end;
procedure TVersionLabel.SetMask(const Value: String);
begin
if( FMask = Value ) then exit;
FMask := Value;
SetVersion;
end;
end.
构造函数用一个资源字符串来设置默认的掩码。根据当前的实现，掩码需要包括四个字符串特性。需要添加代码来定义一个基本的编辑掩码，只允许用户改变实际的静态文本。SetVersion 调用 GetVersionString 和 DecodeVersionString,，使用Microsoft公司的 version.dll返回的信息。
function GetVersionString( FileName : String ) : String;
resourcestring
VersionRequestString =
'\\StringFileInfo\\040904E4\\FileVersion';
var
Size, Dummy, Len : DWord;
Buffer : PChar;
RawPointer : Pointer;
begin
result := '<unknown>';
Size := GetFileVersionInfoSize( PChar(FileName), Dummy );
if( Size = 0 ) then exit;
GetMem( Buffer, Size );
try
if( GetFileVersionInfo( PChar(FileName), Dummy, Size,
Buffer ) = False ) then exit;
if( VerQueryValue( Buffer, PChar(VersionRequestString),
RawPointer, Len ) = False ) then exit
result := StrPas( PChar(RawPointer) );
finally
FreeMem(Buffer);
end;
end;
procedure DecodeVersion( Version : String; var MajorVersion,
MinorVersion, Release, Build : String
function GetValue( var Version : String ) : String;
begin
result := Copy( Version, 1, Pos('.', Version ) - 1);
if( result = EmptyStr ) then result := 'x';
Delete( Version, 2, Pos('.', Version ));
end;
begin
MajorVersion := GetValue(Version);
MinorVersion := GetValue(Version);
Release := GetValue(Version);
Build := GetValue(Version);
end;
GetEnvPathString 使用kernel32.dll中的GetEnvironmentVariable来读取系统环境路径。 GetEnvPathString被用在GetApplicationName中。在设计时, GetApplicationName使用FileSearch搜索系统路径和当前目录，以找到可执行文件（是否处于设计模式，可以通过使用in操作符来判断）。如果程序在运行中，那么Application.EXEName包含了应用程序文件名，因此可以找到包含了更新的版本信息的文件。SetFileName和 SetMask是用于直接访问特性的方法。
这个类有两个不足。首先该类没有适当处理坏的掩码，其次需要用户手工输入FileName特性，对于长或困难的路径也是如此。如果利用特性编辑器来查找并设置FileName特性，该属性将更为有用而且易于使用。参考第10章，看一下如何为FileName属性定义并注册特性编辑器。
TVersionLabel示范了一个自动跟踪当前版本信息的实用组件。该组件采用Windows API来获取版本数据，更重要的是它示范了如何通过隐藏和暴露特性来控制组件的使用方式。通过对TVersionLabel组件示范了如何通过限制可用的特性来约束组件的用法，并防止误用。如果你要隐藏已有的特性，那么可以使用组件的TCustom型的祖先类，并只对用户可以访问的特性提升权限。如果要提供已有的和新的行为，那么既可以使用TCustom也可使用其子类组件。下一节演示了一个类型化编辑组件和代码陷阱，详细地示范了如何编译并测试组件。
9.5 编译并测试组件
测试组件就像测试其他的类一样简单。在把组件安装到VCL之前，最好添加一个包含组件的单元，创建组件的实例，并对代码进行单步调试。否则，包中的访问违例可能使Delphi关闭，这样测试组件会很困难。
当你定义了新的组件时，创建一个简单的测试程序，使用代码来实例化新组件。要仔细设计测试，使得可以单步跟踪组件的每条代码路径。请记住：虽然严格的测试是耗费时间的，但对于对象，特别是组件来说，测试的好处在于它们一经证实是正确的，就成为了整洁而可靠的代码包。用来示范测试的组件是TEditType，TEditType组件允许用户将TEdit组件中得到的文本作为 Boolean，Currency，Date，DateTime，Float，Integer，Time，或String使用。
unit UEditType;
// UEditType.PAS - Type Conversion for TEdit
// Copyright (c) 1998. All Rights Reserved.
// Software Conceptions, Inc. Okemos, MI USA
// Written by Paul Kimmel. Okemos, MI USA
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs,
StdCtrls;
type
TEditType = class(TEdit)
private
{ Private declarations }
protected
{ Protected declarations }
Procedure SetAsBoolean( const Value : Boolean );
Function GetAsBoolean : Boolean;
Procedure SetAsCurrency( const Value : Currency );
Function GetAsCurrency : Currency;
Procedure SetAsDate( const Value : TDateTime );
Function GetAsDate : TDateTime;
Procedure SetAsDateTime( const Value : TDateTime );
Function GetAsDateTime : TDateTime;
Procedure SetAsFloat( const Value : Double );
Function GetAsFloat : Double;
Procedure SetAsInteger( const Value : Integer );
Function GetAsInteger : Integer;
Procedure SetAsTime( const Value : TDateTime );
Function GetAsTime : TDateTime;
Procedure SetAsString( const Value : String );
Function GetAsString : String;
public
{ Public declarations }
Property AsBoolean : Boolean read GetAsBoolean write
SetAsBoolean;
Property AsCurrency : Currency read GetAsCurrency write
SetAsCurrency;
Property AsDate : TDateTime read GetAsDate write SetAsDate;
Property AsDateTime : TDateTime read GetAsDateTime write
SetAsDateTime;
Property AsFloat : Double read GetAsFloat write SetAsFloat;
Property AsInteger : Longint read GetAsInteger write
SetAsInteger;
Property AsTime : TDateTime read GetAsTime write SetAsTime;
Property AsString : string read GetAsString write
SetAsString;
published
{ Published declarations }
end;
procedure Register;
implementation
uses
UBooleanUtil;
procedure TEditType.SetAsBoolean( const Value : Boolean );
begin
Text := TBooleanUtil.BooleanToStr(Value);
end;
function TEditType.GetAsBoolean : Boolean;
begin
result := TBooleanUtil.StrToBoolean(Text);
end;
procedure TEditType.SetAsCurrency( const Value : Currency );
begin
Text := FloatToStr(Value);
end;
function TEditType.GetAsCurrency : Currency;
begin
result := StrToFloat(Text);
end;
procedure TEditType.SetAsDate( const Value : TDateTime );
begin
Text := DateToStr(Value);
end;
function TEditType.GetAsDate : TDateTime;
begin
result := StrToDate(Text);
end;
procedure TEditType.SetAsDateTime( const Value : TDateTime );
begin
Text := DateTimeToStr(Value);
end;
function TEditType.GetAsDateTime : TDateTime;
begin
result := StrToDateTime(Text);
end;
procedure TEditType.SetAsFloat( const Value : Double );
begin
Text := FloatToStr(Value);
end;
function TEditType.GetAsFloat : Double;
begin
result := StrToFloat(Text);
end;
procedure TEditType.SetAsInteger( const Value : Integer );
begin
Text := IntToStr(Value);
end;
function TEditType.GetAsInteger : Integer;
begin
result := StrToInt(Text);
end;
procedure TEditType.SetAsTime( const Value : TDateTime );
begin
Text := TimeToStr(Value);
end;
function TEditType.GetAsTime : TDateTime;
begin
result := StrToTime(Text);
end;
procedure TEditType.SetAsString( const Value : String );
begin
Text := Value;
end;
function TEditType.GetAsString : String;
begin
result := Text;
end;
procedure Register;
begin
RegisterComponents(‘PKTools’, [TEditType]);
end;
end.
TEditType可以用大部分Delphi的内建类型设置组件的Text特性，并通过选择合适的特性在这些类型与字符串值之间进行转换。对TEditType组件全面而有效的测试将设置并获取每个类型的值，以确保转换正确地工作。
把测试代码和组件关联起来的途径是使用条件编译指令并添加测试方法。例如：如下定义的公有方法RunTests就足够了。
procedure TEditType.RunTests;
var
C : Currency;
begin
{$IFOPT D+}
Text := 'True';
if( AsBoolean ) then AsBoolean := Not AsBoolean;
Text := '300.37';
C := AsCurrency;
AsCurrency := 547.29;
ShowMessage(AsString);
AsDate := Now;
if( AsDate <= Now ) then
AsDatetime := AsDate;
ShowMessage( 'The date is :' + AsString );
AsFloat := 12345.67;
AsFloat := 2 * AsFloat;
AsInteger := Trunc(AsFloat);
AsTime := Now;
ShowMessage( 'The time is: ' + Text );
{$ENDIF}
end;
要记住把RunTests的声明添加到类中。如果组件在调试选项打开的情况下编译，{$IFOPTD+}指令将只包括测试代码（关于条件调试代码的完整讨论，可以参见第7章中有关使用条件编译动态增删测试代码的部分）。测试代码将测试大多数特性访问方法——其余的方法作为练习，当关闭调试选项编译组件时，测试代码就被清除了。
使用上述技巧，把测试代码与组件放在一起，使得扩展组件的行为以及相应的测试非常容易。如果要子类化组件，可以将RunTests过程定义为虚过程并在子类中重载RunTests。在安装组件之前，可以按照下列步骤快速地进行一次补充性测试。
1．创建一个空白的应用程序。
2．添加包括组件的单元(本例中是UEditType)。
3．创建组件实例，命名为RunTests。
通过TEditType组件和这三个步骤，可以使用下面的代码来测试类。
with TEditType.Create(Self) do
begin
Parent := Self;
RunTests;
end;
如果已经对一个组件进行了完全的测试，可以将其添加到包中，然后将包安装到组件面板上（细节可以参见9.8节“将组件安装到包中”）。
9.5.1 陷阱代码
代码陷阱是一个很古老的技巧，它对于测试组件非常合适。断点对于调试很有用，但是断点无法跟随已编译并安装的组件。如果修改组件后要重新测试，那么所有改变的代码路径都需要进行测试。
通过在代码中添加陷阱机制，陷阱被抛出时可以将其注释掉。在代码遇到陷阱时，会将其抛出。通过放置好陷阱并当其被抛出时将其注释掉，就建立了一个可以指示陷阱代码和非陷阱代码的虚拟标记。通过在单元中搜索陷阱标记，可以找到任何没有陷阱代码的路径。陷阱是怎样创建的？在嵌阱汇编程序语句中使用soft-ice中断即可。
asm int 3 end; //Trap!
注意：考虑所有可能的控制流程来陷入每一个代码路径。例如：如果你有一个if then 和 else条件，那么添加一个陷阱到if 和else部分，这将确保你已测试了二者之一的代码路径。陷阱也可以标识出未使用过的代码。通过搜索未注释的陷阱，即可找到不必要的代码。
当遇到陷阱时，IDE将立即停在陷阱后的一行，如图9.5所示。如果在每个代码路径都编写了陷阱，当完成代码时即可利用它们进行测试。当陷阱抛出后将其注释，可以记录已经测试的代码（见图9.6）。
图9.5 使用中断3，即所谓的soft-ice中断（这个昵称是根据
一个使用该调试中断的产品命名的），可以向代码添
加断点。如图所示，代码就像遇到了断点一样停下来
图9.6 未测试过的代码路径不会抛出陷阱（区别于已注释掉的陷阱语句）
如果修改代码，去掉陷阱的注释并确保它被重新测试。当保存组件时，陷阱也就是断点，与代码一同存储。
9.6 在Code Insight中定义陷阱
上一节的陷阱代码可以放置在Code Insight中，它是该类型代码的一个好例子（见图9.7）。为将陷阱添加到Code Insight 中，从Editor Properties对话框中选择Code Insight属性页。单击Tools | Editor Options菜单项，即可打开Editor Properties对话框。逐字添加如下所示的代码。
asm int 3 end; // Trap |
图9.7 用Code Insight来定义“陷阱”述语。按Ctrl +J键并
输入TRAP，即可将陷阱语句添加到代码中
管道（|）符号是Enter键上面的‘\’键。管道字符表示插入代码后光标的位置。为将陷阱添加到代码中，在代码编辑器中将光标置于所需的位置，并按Ctrl+J键。键入Trap，当Trap模板被选定后按Enter键即可（见图9.8）。
图9.8 从Code Completion对话框中选定Trap
模板，按Ctrl+J键可显示该对话框
9.7 添加组件图标
还需要向组件添加图标，以提供一些有关组件功能的信息。如果子类化已有的组件，除非指定新的图标，否则将得到其父类的图标。如果你没有指定组件的图标，而且该组件不是有图标的组件的子类，那么您的组件就获得一个通用的图标，与图9.9中鼠标所指出的图标相同。
注意：除了组件图标外，添加一个关键字文件以及编译过的.HLP文件可以将您的组件的帮助信息集成到Delphi中。
图9.9 当没有给出包含组件图标的资源文
件时，将使用通用图标来标识组件
如果不想使用通用图标，或者从祖先继承的图标不够用，那么可以用Image Editor很方便地创建新的组件图标。
9.7.1 用Image Editor创建组件资源文件
假设已经创建了能够跟踪代码并向外部文本文件输出的Debug组件。经过测试，代码工作正确，而您正准备定义组件来封装跟踪行为。该组件不是可视化的，即无需处理运行时控件，也无法继承祖先图标。使用本书中迄今为止讨论过的惯例，可以将类命名为TDebug，将单元命名为UDebug。而您正要定义包含组件图标的资源文件，其操作如下。
1．从Delphi的Tools菜单中选择Image Editor。
2．在Image Editor中，选择File，New，Component Resource File（组件资源文件的扩展名为.dcr）。
3．组件图标是24×24像素的位图。在Resource菜单中单击New,Bitmap，将显示如图9.10所示的Bitmap Properties对话框。
图9.10 Image Editor的Bitmap Properties对话框，
组件位图是24×24像素，16色的位图
4．把Width和Height改变为24，单击OK。
5．在untitled1.dcr资源对话框中用右键单击Bitmap1项。改变位图的名字以便与类名TDEBUG相匹配。
6．当画出或复制位图后，存储为与组件单元同名的.DCR文件，放在与组件单元同样的位置。例如：UDebug.pas需要一个UDebug.dcr文件。
那就是所需要做的工作。当将组件编译为包时，Delphi将会自动查找与组件单元同名的.DCR文件。
图9.11 这是为TDebug组件选定的位图，图像放大了许多倍
9.7.2 查找图标资源
如果您擅长从头开始画图标，那么可以使用Image Editor和任何画图程序来绘制自定义图标。另一个可能的资源是从已有的动态链接库、可执行文件，和图标文件（*.ico）中提取图标。图标可能受版权保护，因此在借用图标之前，可能需要同拥有该文件的厂商商议。大多数计算机中都有成千上万个图标。ExtractIcon API函数能够从.ico文件或可执行文件提取图标。下面的代码示范了一个简单的程序，从一个.EXE或.DLL文件读取所有的图标。
unit UFormIconGrabber;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, ExtCtrls, ShellAPI;
type
TForm1 = class(TForm)
Image1: TImage;
Button1: TButton;
Label1: TLabel;
EditFileName: TEdit;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
Procedure NextIcon;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.NextIcon;
const
I : Integer = 0;
FileName : String = ‘’;
var
Count : Integer;
begin
if( FileName <> EditFileName.Text ) then
begin
FileName := EditFileName.Text;
I := 0;
// Use $FFFFFFFF to get the image count
Count := ExtractIcon( Application.Handle, PChar(FileName),
$FFFFFFFF );
end
else
Inc(I);
if( I < Count ) then
Image1.Picture.Icon.Handle :=
ExtractIcon( Application.Handle, PChar(FileName), I )
else
ShowMessage(‘No more images’ );
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
NextIcon;
end;
end.
在类定义中需要添加按钮、标签、编辑控件，以及一个图像控件到窗体中，以创建示例程序。在这个应用程序中，惟一的方法是NextIcon。NextIcon首先确定上一次调用NextIcon后FileName是否发生了改变；如果已经改变，将更新索引I和FileName。对ExtractIcon的第一次调用得到FileName文件中的图标数量，是通过参数$FFFFFFFF表示的。如果Count比索引大，那么将从FileName文件中提取下一个图标并显示在TImage控件中。
只需增加一些功能，即可提取硬盘上每个可执行文件和.ico文件中的每个图标。在我的工作站上大约有10000个图标。使用TImage.Picture.SaveToFile方法可以很容易地将图标保存到单独的文件，然后在Image Editor中进行修改。
9.8 将组件安装到包中
编译过的包的扩展名为.bpl。bpl是Borland Package Library的缩写，该类型的文件实际上是具有特定扩展名的DLL。包中可以包含一个或多个组件。按照对工程或团队有意义的方式将组件组织为包是个很好的想法。您可能有一个标准的包，其中包含了来自您公司的自定义组件；或利用工程创建了一些包。当在某个工程上工作时，装载该工程的包，到另一个工程上工作时，就装载相应的包。
Delphi 6的新功能是，可以将包工程包括到Project Manager中，如图9.12所示。这使得在开发应用程序及其组件时，创建和调试组件库都很方便。包编辑器实际上负责管理向包添加和删除组件单元、以及编译、安装包。
图9.12 Project Manager中的包Spro，以及与Project
Manager驻留在同一对话框中的包编辑器
当已经对组件进行了测试和调试，准备把组件安装到包的时候，可以打开已有的包并使用包编辑器来安装，或者单击Component | Install Component菜单。Install Component菜单项可以将组件安装到新的或已有的包中，这依赖于您使用Install Component对话框中的哪个属性页执行该操作（如图9.13所示）。
图9.13 Install Component对话框
缺省情况下，组件将放置到Borland提供的dclusr60.dpk包中。它被称为Borland User Package。要将组件安装到新的包中，可按照下列步骤，下面以TEditType组件为例来演示。
1．在Delphi中单击Component，Install Component菜单项。
2．在Install Component对话框中，单击Into New Package属性页。
3．输入要安装的组件的路径和文件名，或使用Browse按钮来定位相应的单元。
4．输入新的.dpk文件的路径和名字（未编译的包文件）。
5．输入包的描述。
6．单击OK按钮。
7．Delphi将提示你编译并安装包；单击Yes将新的包添加到组件面板。
如图9.14所示，包编辑器中显示了新的foo.dpk包以及其中的TEditType组件。在包编辑器中，可以单击Compile按钮来编译包，单击Install the package按钮来安装包，或者单击Options按钮设置编译器选项。请记住：VCL 库实际上是存储为.bpl文件的动态链接库。与任何其他的动态链接库工程一样，需要进行编译和安装，管理一些选项。通过包编辑器或者Project Manager中的右击上下文菜单，可以完成这些工作。
图9.14 Package Editor 用于编译、安装组件库，以及设置工程选项
现在已经测试并安装了你的组件，他们可以像其他的组件一样绘制在窗体或数据模块上。为与其他的开发者分享组件，可以提供组件库（.bpl文件）和所有Delphi编译单元（.dcu 文件）。如果希望其他人可以访问组件的源代码，还可以包括源代码单元文件。
9.9 小 结
本章讲授了初步的组件设计。创建自定义组件属于专业化的程序设计。创建组件和创建应用程序惟一的区别是用户的不同。通常，组件的用户是另外一些开发者；他们是你的用户群体。加入帮助文件和关键字文件是个好主意，这样可以为使用组件的人提供必要的文档。可以安装Delphi帮助的格式来编写帮助文件，使得组件的帮助与Delphi的帮助集成起来。
现在您已经掌握了创建自定义组件的技术基础。后面的章节将示范更为高级的技术，使得组件与应用程序分离开来。
相关阅读 更多 +
排行榜 更多 +
