Delphi 组件渐进开发浅谈（一）——由简入繁

　　最近业余时间在写游戏修改器玩，对于Delphi自带的组件总觉得差强人意，需要书写大量冗余代码，如果大量使用第三方组件，在以后的移植和与他人交互时也不是很方便，因此便产生了自己封装组件的想法。
　　实际上这个想法在很久以前（大概04年写第一个修改器的时候）就有了，一直没有闲暇时间去做，而工作上类似的组件也会很实用，虽然不见得有第三方组件设计的那么规范、强大，但小巧、灵活是自主开发的优点。
　　很多初学者喜欢大量使用第三方组件库，经常见到一个软件中掺杂了四、五种组件库，这是让人很郁闷的。为了阅读、维护这样一个代码，需要下载、携带很多不必要的文件，一旦系统出现Bug，也要在海量的代码中查找，对于一个初学者来说，这更是一个很麻烦的事情。
　　很多初学者不愿意，甚至惧怕阅读核心代码，喜欢求捷径，一旦遇到问题，必然手足无措。阅读并继承Delphi类、组件，将会提高对内核的认识。
1.由简入繁
　　万事开头难，想从无到有总会让人无所头绪。那么从已有的组件继承会事半功倍。
　　考虑到组件或者程序在不同语言的操作系统上执行，应该让组件支持Unicode，那么Delphi 7原生的组件就略显力不从心，所以决定从Tnt组件继承。
　　Delphi 2009开始支持Unicode，但有很多的Bug，Delphi 2010略有改善，也总觉得差强人意，而且Tnt组件库卖给TMS之后，对Delphi 2009、2010均有支持，并能自动识别判断，因此从Tnt组件库继承衍生是一个良好的开始。当然，也可以参照Tnt组件库的代码，判断Delphi内核是否支持Unicode。
1.1.创建一个TGcxEdit组件
1.1.1.了解TCustom-xxx类
　　在StdCtrls单元内可以看到如下代码：

  TLabel = class(TCustomLabel)
  TEdit = class(TCustomEdit)
  TComboBox = class(TCustomComboBox)
  TCheckBox = class(TCustomCheckBox)
  TGroupBox = class(TCustomGroupBox)
  ……

　　可以看出，在Delphi中，大部分面向开发的组件或者类，基本都有一个带有Custom前缀的类。
　　该类（TCustom-xxx）实现基本功能，而子类（Txxx）仅仅将公开（Public）或保护（Protected）的属性公布（Published）到Object Inspector中，或者将保护（Protected）的方法函数公开。
  TEdit = class(TCustomEdit)
  published
    property Anchors;
    property AutoSelect;
    property AutoSize;
    property BevelEdges;
    ……
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;
  end;
　　不要偷懒，如果你没有书写Custom类，以后在扩展、继承的时候会感觉很麻烦。
1.1.2.师从TTntCustomEdit
　　打开TntStdCtrls单元，可以看到TTntEdit继承自TTntCustomEdit，TTntCustomEdit继承自TCustomEdit。那么，我们将从TTntCustomEdit继承，开始超越。
1.1.2.1.颜色属性CommonColor与ReadOnlyColor
　　我首先要建立的这个组件很简单，会根据ReadOnly属性自动设置颜色，那么需要增加两个属性以及相应的私有变量：
  TGcxCustomEdit = class(TTntCustomEdit)
  private
    { Private declarations }
    FCommonColor: TColor;
    FReadOnlyColor: TColor;
    procedure SetCommonColor(const Value: TColor);
    procedure SetReadOnlyColor(const Value: TColor);
  protected
    { Protected declarations }
    property CommonColor: TColor
      read FCommonColor write SetCommonColor default clInfoBk;
    property ReadOnlyColor: TColor
      read FReadOnlyColor write SetReadOnlyColor default clSkyBlue;
  end;
　　好了，开始填写代码：
procedure TGcxCustomEdit.SetCommonColor(const Value: TColor);
begin
  FCommonColor := Value;
  UpdateColor;
end;

procedure TGcxCustomEdit.SetReadOnlyColor(const Value: TColor);
begin
  FReadOnlyColor := Value;
  UpdateColor;
end;
1.1.2.2.更新组件颜色方法UpdateColor
　　可以看到，两个设置函数中，都调用了一个UpdateColor，因为很多属性的改变都会改变颜色，所以将颜色更新部分提取出来，声明一个被保护的方法：
  protected
    { Protected declarations }
    procedure UpdateColor;
　　代码部分如下：
procedure TGcxCustomEdit.UpdateColor;
begin
  if ReadOnly then
    inherited Color := FReadOnlyColor
  else
    inherited Color := FCommonColor;
end;
　　看起来很简单吧，可以看看效果了。当ReadOnly为假的时候，你修改FCommonColor属性，组件的颜色会变化；当ReadOnly为真的时候，你修改FReadOnlyColor属性，组件的颜色会变化；但是修改ReadOnly属性，不会产生变化。
　　关于如何发布组件，后面叙述，请参考1.1.5.发布 TGcxEdit。
1.1.3.修改已有属性、方法
1.1.3.1.继承只读属性ReadOnly
　　想要在修改ReadOnly属性时，颜色自动变化，就要重新声明和书写ReadOnly属性：
  private
    function GetColor: TColor;
    procedure SetColor(const Value: TColor);
  protected
    property Color: TColor read GetColor write SetColor default clInfoBk;
　　代码部分很简单，首先就是引用父类属性，并在 Set 方法中调用 UpdateColor 更新组件颜色。
function TGcxCustomEdit.GetReadOnly: Boolean;
begin
  Result := inherited ReadOnly;
end;

procedure TGcxCustomEdit.SetReadOnly(const Value: Boolean);
begin
  inherited ReadOnly := Value;
  UpdateColor;
end;
1.1.3.2.继承颜色属性Color
　　此时，修改Color会怎样呢？仅仅是改变了组件的当前颜色，因为FCommonColor和FReadOnlyColor没有变化，当你修改CommonColor、ReadOnlyColor或ReadOnly属性时，Color属性会重新改变，同样，修改Color属性避免该问题：
  private
    function GetColor: TColor;
    procedure SetColor(const Value: TColor);
  protected
    property Color: TColor read GetColor write SetColor default clInfoBk;
　　与ReadOnly属性修改类似：
function TGcxCustomEdit.GetColor: TColor;
begin
  Result := inherited Color;
end;

procedure TGcxCustomEdit.SetColor(const Value: TColor);
begin
  if ReadOnly then
    FReadOnlyColor := Value
  else
    FCommonColor := Value;
  UpdateColor;
end;
　　这里的关键点是判断ReadOnly属性，并根据该属性决定将当前颜色设置到FCommonColor还是FReadOnlyColor中。
1.1.4.设计构造器
　　当你书写了那些属性和方法之后，如果没有书写一个相应的构造器，你将面对一个很郁闷的界面，那可能是你不想看到的结果。
  public
    constructor Create(AOwner: TComponent); override;
  published
    property Width default 49;

constructor TGcxCustomEdit.Create(AOwner: TComponent);
begin
  inherited;
  FCommonColor := clInfoBk;
  FReadOnlyColor := clSkyBlue;
  UpdateColor;
  ImeName := '';
  Width := 49;
end;
　　很简单的代码，就是设置一些初始值。
　　好了，它基本完工了。当然，如果以后从它再次继承的时候，它还有一些缺陷需要修正，如果它就是终结版的话，已经够用了。
　　关于修正缺陷的描述，后面叙述。
1.1.5.发布TGcxEdit
　　TGcxCustomEdit并没有公开（Public）和公布（Published）任何属性、方法，想要在设计期间修改属性或运行期间控制该组件，就需要发布一个标准的组件出来，很简单：
  TGcxEdit = class(TGcxCustomEdit)
  published
    property CommonColor;
    property ReadOnlyColor;
　　这样就公布了新派生的属性，然后再将TTntCustomEdit原有的一些属性、方法、事件公布出来：
  TGcxEdit = class(TGcxCustomEdit)
  published
    property Align;
    property Anchors;
    property AutoSelect;
    ……
    property Text;
    property Visible;
    property OnChange;
    property OnClick;
    property OnContextPopup;
    ……
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;
  end;
　　最后一步，注册组件：
procedure Register;
begin
  RegisterComponents('GameControlX', [TGcxEdit]);
end;
1.2.设计一个数值输入组件TGcxIntEdit
　　很多时候，我们需要一个能够输入数值的对象，TEdit虽然可以完成，但需要屏蔽按键消息、考虑字符串的合法性，还要负责字符串与数值的相互转换。
　　这个组件的设计思想，很多地方参考了IOComp的TiIntegerOutput组件。
1.2.1.从TGcxCustomEdit开始继承
　　前面设计了 TGcxCustomEdit，我们可以从它开始衍生新的类型。
　　新的组件将提供整数的输入，那么需要一个Value属性，如果想限制Value范围，还要增加ValueMax、ValueMin属性。
  TGcxCustomIntEdit = class(TGcxCustomEdit)
  private
    FValueMax: Integer;
    FValue: Integer;
    FValueMin: Integer;
  protected
    property Value    : Integer read FValue    write SetValue default 0;
    property ValueMax : Integer read FValueMax write SetValueMax default 0;
    property ValueMin : Integer read FValueMin write SetValueMin default 0;
　　好了，开始填写代码：
procedure TGcxCustomIntEdit.SetValue(const Value: Integer);
var
  TempValue : Integer;
begin
  TempValue := Value;

  if not ((FValueMax = 0) and (FValueMin = 0)) and not Loading then
  begin
    if TempValue > FValueMax then
      TempValue := FValueMax;
    if TempValue < FValueMin then
      TempValue := FValueMin;
  end;

  if FValue <> TempValue then
  begin
    FValue := TempValue;
    UpdateText;
  end;
end;

procedure TGcxCustomIntEdit.SetValueMax(const Value: Integer);
begin
  if FValueMax <> Value then
  begin
    FValueMax  := Value;
    Self.Value := FValue;
  end;
end;

procedure TGcxCustomIntEdit.SetValueMin(const Value: Integer);
begin
  if FValueMin <> Value then
  begin
    FValueMin  := Value;
    Self.Value := FValue;
  end;
end;
　　在SetValue这里出现了两个关键词：Loading和UpdateText。
　　Loading用于判断组件的装载状态，避免反复更新数据并刷新显示，这个属性方法将在TGcxCustomEdit中增加。
　　UpdateText用于刷新组件的文本显示。
1.2.2.数据类型与限制
1.2.2.1.数据输入类型FormatStyle
　　为了输入、输出包括10进制、2进制、8进制、16进制数据，扩展一个FormatStyle属性，参考TiIntegerOutput组件。
type
  TIntegerFormatStyle = (ifsInteger, ifsHex, ifsBinary, ifsOctal);
  TGcxCustomIntEdit = class(TGcxCustomEdit)
  private
    FFormatStyle: TIntegerFormatStyle;
    procedure SetFormatStyle(const Value: TIntegerFormatStyle);
  protected
    property FormatStyle: TIntegerFormatStyle
      read FFormatStyle write SetFormatStyle default ifsInteger;
　　代码如下：
procedure TGcxCustomIntEdit.SetFormatStyle(const Value: TIntegerFormatStyle);
begin
  if FFormatStyle <> Value then
  begin
    FFormatStyle := Value;
    UpdateText;
  end;
end;
1.2.2.2.数据输入长度MaxLength
　　为了能够限制数据输入长度，重载 MaxLength 属性：
  private
    function GetMaxLength: Integer;
    procedure SetMaxLength(const Value: Integer);
  protected
    property MaxLength: Integer read GetMaxLength write SetMaxLength default 0;
　　代码如下：
function TGcxCustomIntEdit.GetMaxLength: Integer;
begin
  Result := inherited MaxLength;
end;

procedure TGcxCustomIntEdit.SetMaxLength(const Value: Integer);
begin
  inherited MaxLength := Value;
  UpdateText;
end;
1.2.2.3.字符“0”前缀属性LeadingZeros
  private
    FLeadingZeros: Boolean;
    procedure SetLeadingZeros(const Value: Boolean);
  protected
    property LeadingZeros: Boolean
      read FLeadingZeros write SetLeadingZeros default False;
　　代码部分：
procedure TGcxCustomIntEdit.SetLeadingZeros(const Value: Boolean);
begin
  if FLeadingZeros <> Value then
  begin
    FLeadingZeros := Value;
    UpdateText;
  end;
end;
　　同样，设置属性的最后，还是更新文本（UpdateText）。
1.2.3.数据的读写
1.2.3.1.从Value更新文本
　　此处开始大规模剽窃TiIntegerOutput，功力浅的可以不求甚解。
　　甚解不是初学者应该关心的事情，毕竟李维、侯捷那种人凤毛麟角。但一定要求解，至少要明白你在做什么、它在做什么。
  TGcxCustomIntEdit = class(TGcxCustomEdit)
  protected
    function GetText(Value: Integer): WideString;
    procedure UpdateText;

function TGcxCustomIntEdit.GetText(Value: Integer): WideString;
var
  TempMaxLength : Integer;
begin
  TempMaxLength := MaxLength;
  case FFormatStyle of
  ifsInteger:
  begin
  end;
  ifsHex:
  begin
    if (TempMaxLength > 8) or (TempMaxLength = 0) then
      TempMaxLength := 8;
  end;
  ifsBinary:
  begin
    if (TempMaxLength > 32) or (TempMaxLength = 0) then
      TempMaxLength := 32;
  end;
  ifsOctal:
  begin
    if (TempMaxLength > 10) or (TempMaxLength = 0) then
      TempMaxLength := 10;
  end;
  else
    Exit;
  end;
  Result := GcxIntToStr(Value, FFormatStyle, TempMaxLength, FLeadingZeros);
end; 
1.2.3.2.公共方法UpdateText
procedure TGcxCustomIntEdit.UpdateText;
begin
  Text := GetText(FValue);
end;
1.2.3.3.转换函数GcxIntToStr
　　这段函数来源自IOComp组件库iGPFunctions单元的iIntToStr，但是原有的“Value: Longword”显然是有问题的，因此修改类型为Int64。
function GcxIntToStr(Value: Int64; Format: TIntegerFormatStyle;
  MaxLength: Integer; LeadingZeros: Boolean): String;
var
  x               : Integer;
  ShiftMultiplier : Integer;
  DigitValue      : Integer;
  TempValue       : Longword;
begin
  Result := '';

  ShiftMultiplier := 0;
  TempValue       := Value;

  case Format of
  ifsInteger:
  begin
    Result := IntToStr(Value);
  end;
  ifsHex:
  begin
    for x := 1 to 8 do
    begin
      if ShiftMultiplier <> 0 then
        TempValue := Value shr (4 * ShiftMultiplier);
      DigitValue := TempValue and $F;
      Result := IntToHex(DigitValue, 1) + Result;
      Inc(ShiftMultiplier);
    end;
  end;
  ifsBinary:
  begin
    for x := 1 to 32 do
    begin
      if ShiftMultiplier <> 0 then
        TempValue := Value shr (1 * ShiftMultiplier);
      DigitValue := TempValue and $1;
      Result := IntToStr(DigitValue) + Result;
      Inc(ShiftMultiplier);
    end;
  end;
  ifsOctal:
  begin
    for x := 1 to 10 do
    begin
      if ShiftMultiplier <> 0 then
        TempValue := Value shr (3*ShiftMultiplier);
      DigitValue := TempValue and $7;
      Result := IntToStr(DigitValue) + Result;
      Inc(ShiftMultiplier);
    end;
  end;
  end;

  while Copy(Result, 1, 1) = '0' do
    Result := Copy(Result, 2, Length(Result) - 1);

  if LeadingZeros then
  begin
    while Length(Result) < MaxLength do
      Result := '0' + Result;
  end;

  if Result = '' then
    Result := '0';
end;
　　好了，现在可以通过修改Value属性，显示相应的数值了，但是输入呢？
1.2.3.4.重载DoExit
  protected
    procedure CompleteChange; override;
    procedure DoExit; override;
    function  GetValue(Value: WideString): Integer;
　　DoExit方法来源于TWinControl，响应的是CM_EXIT消息。实现代码如下：
procedure TGcxCustomIntEdit.CompleteChange;
begin
  inherited;
  Value := GetValue(Text);
end;

procedure TGcxCustomIntEdit.DoExit;
begin
  inherited;
  CompleteChange;
end;

function TGcxCustomIntEdit.GetValue(Value: WideString): Integer;
begin
  Result := 0;
  try
    case FFormatStyle of
      ifsInteger : Result := GcxStrToInt(      Value);
      ifsHex     : Result := GcxStrToInt('$' + Value);
      ifsBinary  : Result := GcxStrToInt('b' + Value);
      ifsOctal   : Result := GcxStrToInt('o' + Value);
    end;
  except
    on e : exception do
      begin
        if FUndoOnError then
          begin
            Undo;
            Result := FValue;
            if FBeepOnError then Beep;
          end
        else raise;
      end;
  end;
end;
1.2.3.5.转换函数GcxStrToInt
　　这段函数来源自IOComp组件库iGPFunctions单元的iStrToInt，依旧是剽窃，可贾宝玉都说了“除四书外无书，其他都是杜撰的”，我们剽窃一下也无所谓。
function GcxStrToInt(Value: String): Int64;
var
  ACharacter   : String;
  AString      : String;
  CurrentPower : Integer;

begin
  Result       := 0;
  CurrentPower := 0;
  ACharacter   := Copy(Value, 1, 1);

  if ACharacter = 'b' then
  begin
    AString := Copy(Value, 2, Length(Value) -1);
    while Length(AString) <> 0 do
    begin
      ACharacter := Copy(AString, Length(AString), 1);
      Result := Result + StrToInt(ACharacter) * Trunc(Power(2, CurrentPower) + 0.0001);
      AString := Copy(AString, 1, Length(AString) -1);
      Inc(CurrentPower);
    end;
  end
  else if ACharacter = 'o' then
  begin
    AString := Copy(Value, 2, Length(Value) -1);
    while Length(AString) <> 0 do
    begin
      ACharacter := Copy(AString, Length(AString), 1);
      Result := Result + StrToInt(ACharacter) * Trunc(Power(8, CurrentPower) + 0.0001);
      AString := Copy(AString, 1, Length(AString) -1);
      Inc(CurrentPower);
    end;
  end
  else
  begin
    Result := StrToInt(Value);
  end;
end;
1.2.3.6.关于BeepOnError与UndoOnError属性
　　这两个属性目前看来可有可无，因为从IOComp剽窃，暂时保留这两个属性。
  private
    FBeepOnError: Boolean;
    FUndoOnError: Boolean;
  protected
    property BeepOnError: Boolean read FBeepOnError write FBeepOnError default False;
    property UndoOnError: Boolean read FUndoOnError write FUndoOnError default True;
1.2.3.7.键盘响应
　　以上的设计，可以实现代码控制的数值输入及显示，但无法限制键盘输入，那么增加一个AllowKey来判断并过滤键盘输入，为了今后扩展方便，AllowKey将从TGcxCustomEdit增加，并通过KeyPress事件处理程序调用。
  protected
    { Protected declarations }
    function AllowKey(Key: Char): Boolean; override;
　　代码实现：
function TGcxCustomIntEdit.AllowKey(Key: Char): Boolean;
var
  BadKey : Boolean;
begin
  case FormatStyle of
  ifsInteger : BadKey := not (Key in [#8, '0'..'9', '-']);
  ifsHex     : BadKey := not (Key in [#8, '0'..'9', 'a'..'f', 'A'..'F']);
  ifsBinary  : BadKey := not (Key in [#8, '0'..'1']);
  ifsOctal   : BadKey := not (Key in [#8, '0'..'7']);
  else
    BadKey := True;
  end;

  if BadKey then
  begin
    if FBeepOnError then Beep;
  end;
  Result := not BadKey;
end;
1.2.4.修改父类TGcxCustomEdit
1.2.4.1.组件的csLoading标志与Loading属性设计
　　这个属性可以为组件本事和衍生的子类提供状态信息。
  TGcxCustomEdit = class(TTntCustomEdit)
  private
    FLoading: Boolean;
  protected
    function GetLoading: Boolean;
    procedure SetLoading(Value: Boolean);
    property Loading: Boolean read GetLoading;
　　代码部分：
function TGcxCustomEdit.GetLoading: Boolean;
begin
  Result := False;
  if csLoading in ComponentState then Result := True;
  if FLoading                    then Result := True;
end;
　　当组件正从资料流中读出时，它的ComponentState属性会包含csLoading标志。
procedure TGcxCustomEdit.SetLoading(Value: Boolean);
begin
  FLoading := Value
end;
1.2.4.2.键盘输入响应KeyPress及AllowKey
  TGcxCustomEdit = class(TTntCustomEdit)
  protected
    function AllowKey(Key: Char): Boolean; virtual;
    procedure KeyPress(var Key: Char); override;
　　代码部分：
function TGcxCustomEdit.AllowKey(Key: Char): Boolean;
begin
  Result := True;
end;

procedure TGcxCustomEdit.KeyPress(var Key: Char);
begin
  inherited;
  if not AllowKey(Key) then
  begin
    Key := #0;
  end;
end;

1.2.4.3.组件焦点丢失的处理CompleteChange
procedure CompleteChange; virtual;

procedure TGcxCustomEdit.CompleteChange;
begin
end;
1.2.5.设计构造器
　　同样，一个装载初始值的构造函数是必须存在的。
constructor TGcxCustomIntEdit.Create(AOwner: TComponent);
begin
  inherited;
  Self.ImeName := '';
  Self.ImeMode := imClose;

  FUndoOnError := True;
  FValueMax := 0;
  FValue := 0;
  UpdateText;
end;
1.2.6.发布TGcxIntEdit
　　参照TGcxEdit，就是将TGcxCustomIntEdit的属性、方法、事件公开。
例如：
  published
    { Published declarations }
    property CommonColor;
    property FormatStyle;
    property LeadingZeros;
    property ReadOnlyColor;
    property Value;
    property ValueMax;
    property ValueMin;