Delphi 组件渐进开发浅谈（四）——举重若轻

4.举重若轻

4.1.源于一个简单的框架TFrame

　　在04年的时候，为了方便书写游戏修改器，曾经做过一个框架，由三个组件组成，两个T[x]Edit和一个T[x]SpeedButton，前两个T[x]Edit分别显示编号与信息，后面的T[x]SpeedButton用于调用修改功能，界面如下：

 　　

　　实际上，就算不是书写游戏修改器，很多地方都可能用得上它，比如数据库系统……

　　它的定义很简单：

  TfPubSimple = class(TfFrameGameEditor)

    edtNo: TTntEdit;

    edtName: TTntEdit;

    sbChange: TTntSpeedButton;

  private

    function GetNo: Integer;

    procedure SetNo(const Value: Integer);

    function GetSimpleName: WideString;

    procedure SetSimpleName(const Value: WideString);

  public

    property No: Integer read GetNo write SetNo;

    property SimpleName: WideString read GetSimpleName write SetSimpleName;

  end;

　　先不要考虑它的基础类TfFrameGameEditor做了些什么，那不是我们现在关心的重点，先看它的代码吧，其实超级简单。

function TfPubSimple.GetNo: Integer;

begin

  Result := StrToIntDef(edtNo.Text, 0);

end;

 

procedure TfPubSimple.SetNo(const Value: Integer);

begin

  edtNo.Text := IntToStr(Value);

end;

 

function TfPubSimple.GetSimpleName: WideString;

begin

  Result := edtName.Text;

end;

 

procedure TfPubSimple.SetSimpleName(const Value: WideString);

begin

  edtName.Text := Value;

end;

　　为什么没有使用TTntLabeledEdit呢？在没有仔细阅读TTntLabeledEdit代码之前，我实在不知道怎么控制好那个Label，就算是现在，它也是一个让人费神经的话题。

那么，如何把它变成一个组件呢？

4.2.定义我们的TGcxCustomValueInfoEdit

　　首先是需求分析，它有一个数值输入输出，一个文本输入输出，还有一个控制按钮。为了使用更加方便，我们再增加一个标签。

　　好了，我们开始从TWinControl继承，并增加三个必要对象，定义如下：

  TGcxCustomValueInfoEdit = class(TWinControl)

  private

    FValueEdit: TGcxCustomIntLabeledEditX;

    FInfoEdit: TGcxCustomEditX;

    FSubBtn: TTntSpeedButton;

  public

    constructor Create(AOwner: TComponent); override;

    property ValueEdit: TGcxCustomIntLabeledEditX read FValueEdit;

    property InfoEdit: TGcxCustomEditX read FInfoEdit;

    property SubBtn: TTntSpeedButton read FSubBtn;

　　这里出现了两个新的类：TGcxCustomIntLabeledEditX和TGcxCustomEditX，他们从哪里来的呢？

　　实际上它们是TGcxCustomIntLabeledEdit和TGcxCustomEdit的另外一个面孔。

　　为什么没有用TGcxIntLabeledEdit和TGcxEdit呢？因为他们公开的属性、事件太多了，如果把它们放入TGcxCustomValueInfoEdit中，估计我们很快就会被眼花缭乱的属性弄晕的。

4.2.1.TGcxCustomIntLabeledEditX的定义

  TGcxCustomIntLabeledEditX = class(TGcxCustomIntLabeledEdit)

  published

    property Alignment;

    property CharCase;

    property Constraints;

    property EditLabel;

    property FormatStyle;

    property HideSelection;

    property LabelPosition;

    property LabelSpacing;

    property LeadingZeros;

    property Margin;

    property MaxLength;

    property ParentShowHint;

    property PopupMenu;

    property ShowHint;

    property Value;

    property ValueMax;

    property ValueMin;

  published

    property OnChange;

    property OnClick;

    property OnDblClick;

    property OnEnter;

    property OnExit;

    property OnKeyDown;

    property OnKeyPress;

    property OnKeyUp;

    property OnMouseDown;

    property OnMouseMove;

    property OnMouseUp;

  end;

4.2.2.TGcxCustomEditX的定义

  TGcxCustomEditX = class(TGcxCustomEdit)

  published

    property Alignment;

    property Constraints;

    property HideSelection;

    property ImeMode;

    property ImeName;

    property Margin;

    property MaxLength;

    property ParentShowHint;

    property PopupMenu;

    property ShowHint;

    property Text;

  published

    property OnChange;

    property OnClick;

    property OnDblClick;

    property OnEnter;

    property OnExit;

    property OnKeyDown;

    property OnKeyPress;

    property OnKeyUp;

    {$IFDEF COMPILER_9_UP}

    property OnMouseActivate;

    {$ENDIF}

    property OnMouseDown;

    {$IFDEF COMPILER_10_UP}

    property OnMouseEnter;

    property OnMouseLeave;

    {$ENDIF}

    property OnMouseMove;

    property OnMouseUp;

  end;

4.3.简化常用属性

4.3.1.引出CommonColor、ReadOnlyColor与ReadOnly

　　这三个属性是TGcxCustomIntLabeledEdit和TGcxCustomEdit共有的属性，我们在TGcxCustomIntLabeledEditX和TGcxCustomEditX中并没有公布出来，在这里一并引出。

  private

    function GetCommonColor: TColor;

    procedure SetCommonColor(const Value: TColor);

    function GetReadOnly: Boolean;

    procedure SetReadOnly(const Value: Boolean);

    function GetReadOnlyColor: TColor;

    procedure SetReadOnlyColor(const Value: TColor);

  protected

    property CommonColor: TColor

      read GetCommonColor write SetCommonColor default clInfoBk;

    property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;

    property ReadOnlyColor: TColor

      read GetReadOnlyColor write SetReadOnlyColor default clSkyBlue;

 

function TGcxCustomValueInfoEdit.GetCommonColor: TColor;

begin

  Result := FValueEdit.CommonColor;

end;

 

procedure TGcxCustomValueInfoEdit.SetCommonColor(const Value: TColor);

begin

  FValueEdit.CommonColor := Value;

  FInfoEdit.CommonColor := Value;

end;

 

function TGcxCustomValueInfoEdit.GetReadOnly: Boolean;

begin

  Result := FValueEdit.ReadOnly;

end;

 

procedure TGcxCustomValueInfoEdit.SetReadOnly(const Value: Boolean);

begin

  FValueEdit.ReadOnly := Value;

  FInfoEdit.ReadOnly := Value;

end;

 

function TGcxCustomValueInfoEdit.GetReadOnlyColor: TColor;

begin

  Result := FValueEdit.ReadOnlyColor;

end;

 

procedure TGcxCustomValueInfoEdit.SetReadOnlyColor(const Value: TColor);

begin

  FValueEdit.ReadOnlyColor := Value;

  FInfoEdit.ReadOnlyColor := Value;

end;

4.3.2.引出FSubBtn的Caption属性——ButtonCaption

　　实际上这个引出不是必须的，但是为了设计时修改方便，添加代码如下：

  private

    function GetButtonCaption: WideString;

    procedure SetButtonCaption(const Value: WideString);

  protected

    property ButtonCaption: WideString read GetButtonCaption write SetButtonCaption;

 

function TGcxCustomValueInfoEdit.GetButtonCaption: WideString;

begin

  Result := Self.FSubBtn.Caption;

end;

 

procedure TGcxCustomValueInfoEdit.SetButtonCaption(const Value: WideString);

begin

  Self.FSubBtn.Caption := Value;

end;

4.3.3.引出EditLabel的Caption

TGcxCustomIntLabeledEdit的EditLabel对象在TGcxCustomIntLabeledEditX中虽然公布，但在设计期间，甚至在书写代码访问TGcxCustomIntLabeledEdit.EditLabel.Caption也是让人头痛的事情，它的层次太深了。

  private

    function GetCaption: WideString;

    procedure SetCaption(const Value: WideString);

  protected

    property Caption: WideString read GetCaption write SetCaption;

 

function TGcxCustomValueInfoEdit.GetCaption: WideString;

begin

  Result := Self.FValueEdit.FEditLabel.Caption;

end;

 

procedure TGcxCustomValueInfoEdit.SetCaption(const Value: WideString);

begin

  Self.FValueEdit.FEditLabel.Caption := Value;

end;

4.3.4.引出FormatStyle、LabelPosition、Text、Value

　　同样为了方便访问TGcxCustomIntLabeledEdit的FormatStyle、LabelPosition、Value属性，以及TGcxCustomEdit的Text属性，我们将他们引出：

  private

    function GetFormatStyle: TIntegerFormatStyle;

    procedure SetFormatStyle(const Value: TIntegerFormatStyle);

    function GetLabelPosition: TLabelPosition;

    procedure SetLabelPosition(const Value: TLabelPosition);

    function GetText: WideString;

    procedure SetText(const Value: WideString);

    function GetValue: Integer;

    procedure SetValue(const Value: Integer);

  protected

    property FormatStyle: TIntegerFormatStyle

      read GetFormatStyle write SetFormatStyle default ifsInteger;

    property LabelPosition: TLabelPosition

      read GetLabelPosition write SetLabelPosition default lpLeft;

    property Text: WideString read GetText write SetText;

    property Value: Integer read GetValue write SetValue default 0;

 

function TGcxCustomValueInfoEdit.GetFormatStyle: TIntegerFormatStyle;

begin

  Result := FValueEdit.FormatStyle;

end;

 

procedure TGcxCustomValueInfoEdit.SetFormatStyle(

  const Value: TIntegerFormatStyle);

begin

  FValueEdit.FormatStyle := Value;

end;

 

function TGcxCustomValueInfoEdit.GetLabelPosition: TLabelPosition;

begin

  Result := FValueEdit.LabelPosition;

end;

 

procedure TGcxCustomValueInfoEdit.SetLabelPosition(

  const Value: TLabelPosition);

begin

  FValueEdit.LabelPosition := Value;

end;

 

function TGcxCustomValueInfoEdit.GetText: WideString;

begin

  Result := Self.FInfoEdit.Text;

end;

 

procedure TGcxCustomValueInfoEdit.SetText(const Value: WideString);

begin

  Self.FInfoEdit.Text := Value;

end;

 

function TGcxCustomValueInfoEdit.GetValue: Integer;

begin

  Result := Self.FValueEdit.Value;

end;

 

procedure TGcxCustomValueInfoEdit.SetValue(const Value: Integer);

begin

  Self.FValueEdit.Value := Value;

end;

4.4.定制构造函数Create

　　因为需要在构造事件代码中构造三个不同对象，并进行位置设置，所以需要设计一个略微复杂的构造方法：

const

  IDI_SubEditMinWidth = 40;

  IDI_SubBtnMinWidth = 22;

 

constructor TGcxCustomValueInfoEdit.Create(AOwner: TComponent);

var

  AWidth, AHeight: Integer;

  iTop, iHeight: Integer;

begin

  inherited Create(AOwner);

  FSpace := 2;

 

  Self.ParentFont := True;

  iTop := 0;

  AWidth := 0;

 

  FValueEdit := TGcxCustomIntLabeledEditX.Create(Self);

  with FValueEdit do

  begin

    Name := 'ValueEdit';

    SetSubComponent(True);

    Parent := Self;

    Top := iTop;

    Left := AWidth;

    iHeight := Height;

    AWidth := AWidth + Width + FSpace;

    FreeNotification(Self);

    OnResize := DoValueEditResize;

    EditLabel.SetBind(Self);

    Constraints.MinWidth := IDI_SubEditMinWidth;

    TabOrder := 0;

  end;

　　这里首先设置了FValueEdit的位置，并通过SetSubComponent通知Object Inspector自己是个子组件；

　　从TCustomEdit.Create代码中可以看到“FAutoSize := True;”，所以我们可以在OnResize的时候修改Self的高度，因此在这里我们声明一个DoValueEditResize处理方法；

　　关于FreeNotification的说明，请参考“4.8.1消息通知Notification与FreeNotification”；

　　最后是设置FValueEdit.EditLabel的Bind属性，这是为FValueEdit.SetLabelPosition服务的。（参见“2.3.5.最后一个重要属性Bind”）

  FInfoEdit := TGcxCustomEditX.Create(Self);

  with FInfoEdit do

  begin

    Name := 'InfoEdit';

    SetSubComponent(True);

    Parent := Self;

    Text := '';

    Top := iTop;

    Left := AWidth;

    AWidth := AWidth + Width + FSpace;

    FreeNotification(Self);

    Constraints.MinWidth := IDI_SubEditMinWidth;

    TabOrder := 1;

  end;

 

  FSubBtn := TTntSpeedButton.Create(Self);

  with FSubBtn do

  begin

    Name := 'SubBtn';

    SetSubComponent(True);

    Parent := Self;

    Top := iTop;

    Left := AWidth;

    Width := 22;

    Height := iHeight;

    AWidth := AWidth + Width;

    FreeNotification(Self);

    Constraints.MinWidth := IDI_SubBtnMinWidth;

    TabOrder := 2;

  end;

 

  TabStop := True;

  AWidth := AWidth + Self.BorderWidth * 2;

  AHeight := iHeight + Self.BorderWidth * 2;

  SetBounds(Self.Left, Self.Top, AWidth, AHeight);

end;

　　后面这段没有太多悬念，一个是调用重载的SetBounds方法（参考“4.8.4.覆盖SetBounds”），一个是引用Self.BorderWidth属性。

　　其实在这段代码中，因为Self.BorderWidth默认值是0，所以Self.BorderWidth可以不参加计算。但是如果有人愿意在“inherited Create(AOwner);”后面设置BorderWidth属性，这段代码就是必须存在的了。

4.5.新的属性Space

　　这个属性的用处主要是隔离三个组件，让他们之间有一些空隙，便于在设计期间通过鼠标拖拽调整子组件的宽度。

  private

    FSpace: Integer;

    procedure SetSpace(const Value: Integer);

  protected

    property Space: Integer read FSpace write SetSpace default 2;

 

procedure TGcxCustomValueInfoEdit.SetSpace(const Value: Integer);

begin

  FSpace := Value;

  Self.SetBounds(Left, Top, Width, Height);

end;

　　代码很简单，关键点在SetBounds，参考“4.8.4.覆盖SetBounds”。

4.6.关于SetSubComponent方法与csSubComponent标志

　　这个方法来源于Delphi 6，组件可以拥有子组件。举例来说，一个组件可以有一个组件引用的属性，这个被引用的组件，可以是内部的(也就是一个子组件)，也可以是外部的(普通的组件引用)。如果引用的是内部的组件，则这个子组件的不被Form所拥有，而是被放置在Form上的组件所拥有。这意味着组件可以将其内部的子组件发布出来，并且能够被正确的流化。并且，对象检视器已经被修改为支持查看组件内部的子组件属性(比如Font属性)。要创建一个有子组件的组件，需要调用TComponent.SetSubComponent方法。

　　抱歉，这段话也是剽窃来的，有点晦涩，好像翻译的差强人意。让我们看看他做了些什么吧。

procedure TComponent.SetSubComponent(IsSubComponent: Boolean);

begin

  if IsSubComponent then

    Include(FComponentStyle, csSubComponent)

  else

    Exclude(FComponentStyle, csSubComponent);

end;

　　看明白了吗？就是设置了一个csSubComponent标志。这下清晰了吧，设置或者判断一个组件是否为子组件（SubComponents），就看这个标志。

　　谁在利用这个标志呢？TReader.ReadComponent、TReader.ReadPropValue、TWriter.WriteComponent、TWriter.WriteProperty、IsDefaultPropertyValue。可以看出来，主要就是组件以及属性的读写时需要它。

　　所以在前面的构造函数中，为每一个子组件调用SetSubComponent，这样才可以在Object Inspector中找到它们的事件属性。

4.7.事件处理方法DoValueEditResize

　　在构造函数中提及的DoValueEditResize方法，定义如下：

  private

    procedure DoValueEditResize (Sender: TObject);

　　代码如下：

procedure TGcxCustomValueInfoEdit. DoValueEditResize (Sender: TObject);

var

  iHeight: Integer;

begin

  if (Sender is TCustomEdit) then

  begin

    iHeight := (Sender as TCustomEdit).Height;

    Self.SubBtn.Height := iHeight;

    Inc(iHeight, Self.BorderWidth shl 1);

    if Self.Height <> iHeight then

      Self.Height := iHeight;

  end;

end;

　　这段代码就是根据FValueEdit的Height设置自身和SubBtn的Height，FInfoEdit的Height不需要理会，因为它的AutoSize默认也是True。

4.8.覆盖基类的方法函数

　　不可避免的，我们需要覆盖来自TWinControl和TControl的部分方法函数，声明如下定义：

  protected

    procedure Notification(AComponent: TComponent;

      Operation: TOperation); override;

    procedure SetName(const Value: TComponentName); override;

    procedure SetParent(AParent: TWinControl); override;

  public

    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;

4.8.1.消息通知Notification与FreeNotification

　　实际上这两个方法在设计TGcxCustomLabeledEdit和TGcxCustomIntLabeledEdit的时候就已经使用了，因为当时是完全剽窃，所以当时没有提及。

　　这里我引用一段当年陈宽达翻译John M. Miano的《Delphi 组件撰写常问问题》中的一段话，虽然年代久远，但这段引文依旧值得参考：

　　TComponent类别提供了Notification方法。当一个组件被移除时，我们可以利用这个方法得到消息以进行适当的反应。你可以参考『Component Writer's Guide』内有关Notification及FreeNotification这两个方法的说明。

　　当你的组件参考到另一个组件，例如，你的组件中有一个TDataSource型态的属性。那你必须改写此组件的Notification方法，在其中检查被移除的组件是否就是本身所参考的组件。预设情况下，当组件被移除时，所有其它在同一个表格上的组件才会收到消息，如果参考组件位于另一个表格上时，你的组件无法得知这件事情。Delphi 2.0推出了TDataModule，参考组件位于另一个表格上的机会大幅增加，所以你应该利用FreeNotification方法来确定当参考组件移除时，你一定可以得到消息。

　　如果你不改写Notification方法来处理参考组件被移除的讯息，这会让Delphi整合环境陷入十分不稳定的状态。它可能不会立刻当掉，但你也不能再正常地继续其它工作了。

　　阅读上述引文，可以知道FreeNotification用于声明销毁时将通知谁，Notification用于获得消息时应该如何做。

　　FreeNotification已经在构造函数中使用了，现在我们来覆盖Notification，如果你认真阅读了上面的那段引文，可以看出代码部分不算复杂。

procedure TGcxCustomValueInfoEdit.Notification(AComponent: TComponent;

  Operation: TOperation);

begin

  inherited Notification(AComponent, Operation);

  if (Operation = opRemove) then

  begin

    if (AComponent = FValueEdit) then

      FValueEdit := nil;

 

    if (AComponent = FInfoEdit) then

      FInfoEdit := nil;

 

    if (AComponent = FSubBtn) then

      FSubBtn := nil;

  end;

end;

4.8.2.覆盖SetName

　　你可以把FValueEdit.EditLabel看做这个组件的Label，这段代码的主要目的就是在设计期间设置FValueEdit.EditLabel.Caption。

procedure TGcxCustomValueInfoEdit.SetName(const Value: TComponentName);

begin

  if (csDesigning in ComponentState) and ((FValueEdit.EditLabel.GetTextLen = 0) or

     (CompareText(FValueEdit.EditLabel.Caption, FValueEdit.Name) = 0) or

     (CompareText(FValueEdit.EditLabel.Caption, Name) = 0)) then

    FValueEdit.EditLabel.Caption := Value;

  inherited SetName(Value);

  if csDesigning in ComponentState then

    Text := '';

end;

4.8.3.覆盖SetParent

　　这段代码的关键点在于设置FValueEdit.FEditLabel.Parent，实际上就是让FValueEdit.FEditLabel与自身（Self）属于一个Parent所有，这样等同于将FValueEdit.FEditLabel放在了Self的外面，而不是FValueEdit的外面。这样才便于后面的SetBounds计算FEditLabel的位置。

procedure TGcxCustomValueInfoEdit.SetParent(AParent: TWinControl);

begin

  inherited SetParent(AParent);

  if FValueEdit = nil then Exit;

  FValueEdit.Parent := Self;

  if FValueEdit.EditLabel = nil then Exit;

  FValueEdit.FEditLabel.Parent := AParent;

  FValueEdit.FEditLabel.Visible := True;

end;

4.8.4.覆盖SetBounds

　　这段代码看起来很冗长，不必吃惊，也不要害怕，实际上很简单，就是位置计算。

　　在这个新设计的组件里面，三个子对象排成一条线，高度相同，所以这个计算公式并不复杂。

type

  TCtrlBoundInfo = record

    Obj: TControl;

    CtrlRect: TRect;

    WidthEx: Integer;

  end;

 

procedure TGcxCustomValueInfoEdit.SetBounds(ALeft, ATop, AWidth,

  AHeight: Integer);

var

  i: Integer;

  iMinWidth: TConstraintSize;

  iLeft, iHeight, iWidth, iSumWidth, iDiffWidth: Integer;

  mBorderWidth: Integer;

  mCtrlBoundInfo: array of TCtrlBoundInfo;

begin

  mBorderWidth := Self.BorderWidth;

 

  SetLength(mCtrlBoundInfo, 3);

  mCtrlBoundInfo[0].Obj := FValueEdit;

  mCtrlBoundInfo[1].Obj := FInfoEdit;

  mCtrlBoundInfo[2].Obj := FSubBtn;

 

  iHeight := FValueEdit.Height;

  iSumWidth := 0;

  for i := Low(mCtrlBoundInfo) to High(mCtrlBoundInfo) do

  begin

    with mCtrlBoundInfo[i] do

    begin

      // 检查并设置子对象的最小宽度

      if Obj.Constraints.MinWidth = 0 then

      begin

        if Obj = FSubBtn then

          Obj.Constraints.MinWidth := IDI_SubBtnMinWidth

        else

          Obj.Constraints.MinWidth := IDI_SubEditMinWidth;

      end;

      // 检查并重新计算子对象宽度

      iMinWidth := Obj.Constraints.MinWidth;

      if Obj.Width < iMinWidth then

        iWidth := iMinWidth

      else

        iWidth := Obj.Width;

      // 保留子对象的范围空间、可缩小宽度

      mCtrlBoundInfo[i].CtrlRect := Bounds(Obj.Left, 0, iWidth, iHeight);

      mCtrlBoundInfo[i].WidthEx := iWidth - iMinWidth;

      // 累计宽度

      Inc(iSumWidth, iWidth + FSpace);

    end;

  end;

  Inc(iSumWidth, mBorderWidth shl 1 - FSpace);  // 计算内部的宽度

 

  iDiffWidth := AWidth - iSumWidth;             // 计算内外宽度差

  if iDiffWidth >= 0 then

  begin // 外部宽，增加 FInfoEdit 宽度

    for i := Low(mCtrlBoundInfo) to High(mCtrlBoundInfo) do

    begin

      with mCtrlBoundInfo[i] do

        if Obj = FInfoEdit then

        begin

          Inc(CtrlRect.Right, iDiffWidth);

          Break;

        end;

    end;

  end else

  begin // 内部宽，减少内部控件宽度

    iSumWidth := - iDiffWidth;

    for i := Low(mCtrlBoundInfo) to High(mCtrlBoundInfo) do

    begin

      with mCtrlBoundInfo[i] do

      begin

        if WidthEx <= iSumWidth then

          iDiffWidth := WidthEx

        else

          iDiffWidth := iSumWidth;

        Dec(CtrlRect.Right, iDiffWidth);

        Dec(iSumWidth, iDiffWidth);

        Dec(WidthEx, iDiffWidth);

        if iSumWidth = 0 then

          Break;

      end;

    end;

    Inc(AWidth, iSumWidth);

  end; 

  // 重新计算并设置子对象的位置

  mCtrlBoundInfo[0].Obj.BoundsRect := mCtrlBoundInfo[0].CtrlRect;

  for i := Low(mCtrlBoundInfo) + 1 to High(mCtrlBoundInfo) do

  begin

    iLeft := mCtrlBoundInfo[i - 1].CtrlRect.Right + FSpace;

    Types.OffsetRect(mCtrlBoundInfo[i].CtrlRect,

      iLeft - mCtrlBoundInfo[i].CtrlRect.Left, 0);

    mCtrlBoundInfo[i].Obj.BoundsRect := mCtrlBoundInfo[i].CtrlRect;

  end;

 

  AHeight := iHeight + mBorderWidth * 2;

  inherited SetBounds(ALeft, ATop, AWidth, AHeight);

  FValueEdit.SetLabelPosition(FValueEdit.LabelPosition);

end;

　　在这段算法中，会重新修正Self的Width、Height，然后调用基类的SetBounds，最后调用FValueEdit.SetLabelPosition来设置FValueEdit.FEditLabel的位置。

　　因为我们在TGcxBoundLabel中扩展了Bind属性，并在TGcxCustomValueInfoEdit的构造函数中设置了这个属性，所以FValueEdit.SetLabelPosition可以计算出正确的结果。

4.9.关于BorderWidth属性

　　因为BorderWidth属性与组件的Width、Height息息相关，所以在修改BorderWidth属性时，应该同时修正组件的Width、Height属性。

　　那么有两种方法：

4.9.1.修改BorderWidth属性的读写函数

  private

    function GetBorderWidth: TBorderWidth;

    procedure SetBorderWidth(const Value: TBorderWidth);

  protected

    property BorderWidth: TBorderWidth read GetBorderWidth write SetBorderWidth default 0;

 

function TGcxCustomValueInfoEdit.GetBorderWidth: TBorderWidth;

begin

  Result := inherited BorderWidth;

end;

 

procedure TGcxCustomValueInfoEdit.SetBorderWidth(const Value: TBorderWidth);

var

  DiffValue: Integer;

begin

  DiffValue := (Value - BorderWidth) * 2;

  inherited BorderWidth := Value;

  SetBounds(Left, Top, Width + DiffValue, Height + DiffValue);

end;

4.9.2.拦截CM_BORDERCHANGED消息

　　CM_BORDERCHANGED消息是Delphi内部定义消息，分别来源自TWinControl的SetBorderWidth、SetBevelCut、SetBevelEdges、SetBevelKind、SetBevelWidth函数，如：

procedure TWinControl.SetBorderWidth(Value: TBorderWidth);

begin

  if FBorderWidth <> Value then

  begin

    FBorderWidth := Value;

    Perform(CM_BORDERCHANGED, 0, 0);

  end;

end;

　　所以拦截CM_BORDERCHANGED消息应该是比较好的方式，我们选择这种方案，定义及代码如下：

  protected

    procedure CMBorderWidthChanged(var Message: TMessage); message CM_BORDERCHANGED;

 

procedure TGcxCustomValueInfoEdit.CMBorderWidthChanged(var Message: TMessage);

begin

  SetBounds(Left, Top, Width, Height);

end;

　　因为组件的SetBounds中进行了内部组件Width、Height的重计算，所以这里代码可以简化到直接调用即可。

4.10.通知子对象

　　当你设置组件的BiDiMode属性时，会引发CM_BIDIMODECHANGED消息；当你设置组件的Enabled属性时，会引发CM_ENABLEDCHANGED消息；当你设置组件的Visible属性时，会引发CM_VISIBLECHANGED消息。

4.10.1.源自TControl的消息

procedure TControl.SetBiDiMode(Value: TBiDiMode);

begin

  if FBiDiMode <> Value then

  begin

    FBiDiMode := Value;

    FParentBiDiMode := False;

    Perform(CM_BIDIMODECHANGED, 0, 0);

  end;

end;

 

procedure TControl.SetEnabled(Value: Boolean);

begin

  if FEnabled <> Value then

  begin

    FEnabled := Value;

    Perform(CM_ENABLEDCHANGED, 0, 0);

  end;

end;

 

procedure TControl.SetVisible(Value: Boolean);

begin

  if FVisible <> Value then

  begin

    VisibleChanging;

    FVisible := Value;

    Perform(CM_VISIBLECHANGED, Ord(Value), 0);

    RequestAlign;

  end;

end;

　　充分利用这几个消息，设置子对象的相应属性。

4.10.2.拦截三大消息

    procedure CMBidimodeChanged(var Message: TMessage); message CM_BIDIMODECHANGED;

    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;

    procedure CMVisibleChanged(var Message: TMessage); message CM_VISIBLECHANGED;

4.10.3.处理三大消息

procedure TGcxCustomValueInfoEdit.CMBidimodeChanged(var Message: TMessage);

var

  i: Integer;

begin

  for I := 0 to ControlCount - 1 do

    Controls[I].BiDiMode := BiDiMode;

end;

 

procedure TGcxCustomValueInfoEdit.CMEnabledChanged(var Message: TMessage);

var

  i: Integer;

begin

  for I := 0 to ControlCount - 1 do

    Controls[I].Enabled := Enabled;

end;

 

procedure TGcxCustomValueInfoEdit.CMVisibleChanged(var Message: TMessage);

var

  i: Integer;

begin

  for I := 0 to ControlCount - 1 do

    Controls[I].Visible := Visible;

end;

4.10.4.焦点问题——TabStop

　　当组件获得焦点的时候，应该将焦点传递到FValueEdit，所以要拦截WM_SETFOCUS消息。

　　而是否通过Tab键获得焦点，就需要设置子控件的TabStop属性，可以覆盖组件的TabStop属性，并重写SetTabStop函数，或者拦截CM_TABSTOPCHANGED消息。

  Protected

    procedure CMTabStopChanged(var Message: TMessage); message CM_TABSTOPCHANGED;

    procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;

    property TabStop default True;

 

procedure TGcxCustomValueInfoEdit.CMTabStopChanged(var Message: TMessage);

var

  i: Integer;

begin

  for I := 0 to ControlCount - 1 do

    if (Controls[I] is TWinControl) then

      (Controls[I] as TWinControl).TabStop := TabStop;

end;

 

procedure TGcxCustomValueInfoEdit.WMSetFocus(var Message: TWMSetFocus);

begin

  FValueEdit.SetFocus;

end;

4.11.设计期间利用鼠标调整子组件宽度

　　这是一个复杂的工作，为了它，我翻书、上网忙了好几天。

4.11.1.检查鼠标所在区间

　　为了识别鼠标在组件上的位置，将组件空间划分为6个区间，定义如下：

  TGcxValueInfoEditArea = (vieaNone, vieaValue,

    vieaValueToInfo, vieaInfo,

    vieaInfoToButton, vieaButton);

　　书写一组区间计算的代码，定义如下：

  protected

    function HitTest(P: TPoint): TGcxValueInfoEditArea; overload;

    function HitTest(X, Y: Integer): TGcxValueInfoEditArea; overload;

　　代码的实现部分如下：

function TGcxCustomValueInfoEdit.HitTest(P: TPoint): TGcxValueInfoEditArea;

var

  ValueRect, ValueToInfoRect, InfoRect: TRect;

  InfoToButtonRect, ButtonRect: TRect;

  iLeft, iRight: Integer;

begin

  iLeft             := 0;

  iRight            := FValueEdit.Width;

  ValueRect         := Rect(iLeft, 0, iRight, Height);

 

  iLeft             := iRight;

  iRight            := FInfoEdit.Left;

  ValueToInfoRect   := Rect(iLeft, 0, iRight, Height);

 

  iLeft             := FInfoEdit.Left;

  iRight            := iLeft + FInfoEdit.Width;

  InfoRect          := Rect(iLeft, 0, iRight, Height);

 

  iLeft             := iRight;

  iRight            := FSubBtn.Left;

  InfoToButtonRect  := Rect(iLeft, 0, iRight, Height);

 

  iLeft             := FSubBtn.Left;

  iRight            := iLeft + FSubBtn.Width;

  ButtonRect        := Rect(iLeft, 0, iRight, Height);

 

  if PtInRect(ValueRect, P) then

    Result := vieaValue

  else if PtInRect(ValueToInfoRect, P) then

    Result := vieaValueToInfo

  else if PtInRect(InfoRect, P) then

    Result := vieaInfo

  else if PtInRect(InfoToButtonRect, P) then

    Result := vieaInfoToButton

  else if PtInRect(ButtonRect, P) then

    Result := vieaButton

  else

    Result := vieaNone;

end;

　　该函数先计算ValueRect、ValueToInfoRect、InfoRect、InfoToButtonRect、ButtonRect这五个区间的范围，然后调用Types.PtInRect函数计算P在那个区间。

function TGcxCustomValueInfoEdit.HitTest(X, Y: Integer): TGcxValueInfoEditArea;

begin

  Result := HitTest(Point(X, Y));

end;

　　上面这段是HitTest函数的另一个重载版本。

4.11.2.消息以及TCMDesignHitTest结构

　　CM_DESIGNHITTEST 消息是Delphi内部消息，在Controls单元中定义如下：

const

  CM_BASE                   = $B000;

  CM_DESIGNHITTEST          = CM_BASE + 28;

　　该消息传递的参数类型为TCMDesignHitTest，在Controls单元中定义如下：

type

  TCMDesignHitTest = TWMMouse;

　　TWMMouse在Messages单元中定义如下：

type

  TWMMouse = packed record

    Msg: Cardinal;

    Keys: Longint;

    case Integer of

      0: (

        XPos: Smallint;

        YPos: Smallint);

      1: (

        Pos: TSmallPoint;

        Result: Longint);

  end;

　　TCMDesignHitTest的返回值为0或1。在设计期间，当鼠标移到组件上面时，IDE环境会送给此组件这个消息。此消息的目的用来决定组件在设计期间是否要处理鼠标消息。

　　如果返回值是1，则IDE环境就让组件自行处理鼠标消息；

　　如果返回值永远是1，那么组件的弹出菜单则永远不会出现；

　　拦截该消息的事件方法定义如下：

　　  protected

    procedure CMDesignHitTest(var Message: TCMDesignHitTest); message CM_DESIGNHITTEST;

　　实现代码如下：

procedure TGcxCustomValueInfoEdit.CMDesignHitTest(

  var Message: TCMDesignHitTest);

begin

  with Message do

  begin

    if (Self.HitTest(Message.XPos, Message.YPos)

      in [vieaValueToInfo, vieaInfoToButton])

      or FDraging then

    begin

      Screen.Cursor := crHSplit;

      Message.Result := 1;

    end

    else

    begin

      Screen.Cursor := crDefault;

    end;

  end;

end;

　　这段代码调用HitTest函数检测鼠标所在区域。

　　如果在vieaValueToInfo（FValueEdit和FInfoEdit之间）或者vieaValueToInfo（FInfoEdit和FSubBtn之间）区间，再或者拖动标志FDraging为True，改变鼠标的光标为crHSplit，并返回1由组件代码对鼠标消息进行处理；

　　否则设置鼠标的光标为crDefault，由IDE管理鼠标消息，比如拖动组件、弹出菜单等。

　　好了，当我们将鼠标在该组件上从左至右缓慢划过的时候，会看到鼠标光标的变化。

　　FDraging标志的定义及使用将在稍后介绍，参看“4.11.4.拖动并改变子组件的宽度”。

　　注意：因为该组件上有三个子组件，就算在这里让Message.Result永远为1，也可以在子组件上弹出菜单，或者拖动组件。

　　另：记得这里一定是修改Screen.Cursor，而不是该组件的Self.Cursor，我就非常痛苦的面对Self. Cursor好几天。

4.11.3.覆盖WndProc和拦截CM_MOUSELEAVE消息

　　因为在CMDesignHitTest函数中修改了Screen.Cursor，在IDE环境中，当我们的鼠标从vieaValueToInfo或者vieaValueToInfo区间移出时，可能会导致光标无法从crHSplit切换到crDefault。

　　那么，我们可以通过覆盖WndProc函数做一些事情。

  protected

    procedure WndProc(var Message: TMessage); override;

 

procedure TGcxCustomValueInfoEdit.WndProc(var Message: TMessage);

begin

  if (csDesigning in ComponentState) then

  case Message.Msg of

  CM_MOUSELEAVE:

    Self.CMMouseLeave(Message);

  else

  end;

  inherited;

end;

　　判断ComponentState是否包含csDesigning（设计期间状态）特性，如果是设计期间得到了CM_MOUSELEAVE消息，则调用CMMouseLeave函数。

　　说实在的，我不清楚为什么不能在设计期间直接拦截CM_MOUSELEAVE，反正我是没拦截成功，而覆盖WndProc函数就可以得到这个消息。

　　不可以在WndProc函数使用中Perform发送消息，否则会产生消息循环、堆栈溢出。

　　下面这段代码实际上可以在WndProc函数中书写，我丢在CMMouseLeave中只是为了方便今后扩展罢了。

　　拦截CM_MOUSELEAVE消息的处理函数如下定义：

  protected

    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;

 

procedure TGcxCustomValueInfoEdit.CMMouseLeave(var Message: TMessage);

begin

  if (csDesigning in ComponentState) then

  begin

    Screen.Cursor := crDefault;

  end;

  inherited;

end;

　　判断ComponentState是否包含csDesigning（设计期间状态）特性，如果是设计期间，修正鼠标光标为crDefault。

4.11.4.拖动并改变子组件的宽度

　　现在我们开始研究如何通过鼠标的拖动改变子组件的宽度。

　　在“4.5.新的属性Space”中，我们增加了Space属性，有了它，每个子组件之间就有了空隙，而在“4.11.2.使用CM_DESIGNHITTEST消息以及TCMDesignHitTest结构” 和“4.11.3.覆盖WndProc和拦截CM_MOUSELEAVE消息”中，我们改变了鼠标的光标状态。

　　我们现在需要覆盖鼠标的三个事件——MouseDown 、MouseMove和MouseUp，定义如下：

  private

    FDraging: Boolean;

    FDragArea: TGcxValueInfoEditArea;

    FMouseDownPoint: TPoint;

    procedure StopDrag;

  protected

    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;

      X, Y: Integer); override;

    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;

    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;

      X, Y: Integer); override;

4.11.4.1.覆盖MouseDown事件

　　第一个覆盖就是MouseDown事件，当鼠标按下的时候引发。

　　在这段代码中也是先判断是否在设计期间，我们不关心运行期间；

　　第二件事就是调用HitTest函数，获取并备份当前的鼠标所在区间FDragArea；

　　第三件事判断FDragArea是否属于vieaValueToInfo或者vieaInfoToButton，由此设置拖动标志FDraging；

　　当FDraging为True的时候，备份当前的鼠标位置到FMouseDownPoint。

procedure TGcxCustomValueInfoEdit.MouseDown(Button: TMouseButton;

  Shift: TShiftState; X, Y: Integer);

begin

  inherited;

  if (csDesigning in ComponentState) then

  begin

    FDragArea := HitTest(X, Y);

    FDraging := FDragArea in [vieaValueToInfo, vieaInfoToButton];

    if not FDraging  then

      Exit;

    FMouseDownPoint := Point(X, Y);

  end;

end;

4.11.4.2.覆盖MouseUp事件

　　第二个覆盖是MouseUp事件，当鼠标抬起按钮时引发。

　　非常简单，就算调用了一个私有函数StopDrag，用于停止拖动。

procedure TGcxCustomValueInfoEdit.MouseUp(Button: TMouseButton;

  Shift: TShiftState; X, Y: Integer);

begin

  inherited;

  StopDrag;

end;

4.11.4.3.覆盖MouseMove事件

　　第三个覆盖是MouseMove事件，当鼠标移动时引发。

　　在这段代码中先判断是否在设计期间，我们不关心运行期间；

　　然后判断鼠标左按钮是否按下，如果没有按下，调用StopDrag停止拖动并退出；

　　第三件事就是判断拖动状态，如果FDraging为True，则重新计算子组件的宽度；

　　最后就是备份当前的鼠标位置到FMouseDownPoint。

procedure TGcxCustomValueInfoEdit.MouseMove(Shift: TShiftState; X,

  Y: Integer);

var

  iOldWidth1, iOldWidth2, iNewWidth1, iNewWidth2, iDiffWidth: Integer;

  mWinCtl1, mWinCtl2: TControl;

begin

  inherited;

  if not (csDesigning in ComponentState) then

    Exit;

 

  if not (ssLeft in Shift) then

  begin

    StopDrag;

    Exit;

  end;

 

  if FDraging then

  begin

    case FDragArea of

    vieaValueToInfo:

    begin

      mWinCtl1 := FValueEdit;

      mWinCtl2 := FInfoEdit;

    end;

    vieaInfoToButton:

    begin

      mWinCtl1 := FInfoEdit;

      mWinCtl2 := FSubBtn;

    end;

    else

      Exit;

    end;

 

    iOldWidth1 := mWinCtl1.Width;

    iOldWidth2 := mWinCtl2.Width;

    iDiffWidth := FMouseDownPoint.X - X;

 

    iNewWidth1 := iOldWidth1 - iDiffWidth;

    iNewWidth2 := iOldWidth2 + iDiffWidth;

 

    if iNewWidth1 <= mWinCtl1.Constraints.MinWidth then

    begin

      iNewWidth1 := mWinCtl1.Constraints.MinWidth;

      iNewWidth2 := iOldWidth1 + iOldWidth2 - iNewWidth1;

    end;

    if iNewWidth2 <= mWinCtl2.Constraints.MinWidth then

    begin

      iNewWidth2 := mWinCtl2.Constraints.MinWidth;

      iNewWidth1 := iOldWidth1 + iOldWidth2 - iNewWidth2;

    end;

 

    mWinCtl1.Width := iNewWidth1;

 

    mWinCtl2.Left := mWinCtl2.Left - (iOldWidth1 - iNewWidth1);

    mWinCtl2.Width := iNewWidth2;

   

    FMouseDownPoint := Point(X, Y);

  end;

end;

4.11.4.4.停止拖动的私有方法——StopDrag

　　首先，检测FDraging标志，如果为False则退出；

　　然后设置FDraging以及FDragArea两个私有成员；

　　最后是给组件所在的窗体发送一个改变消息。

procedure TGcxCustomValueInfoEdit.StopDrag;

var

  frm: TCustomForm;

begin

  if not FDraging then

    Exit;

 

  FDraging := False;

  FDragArea := vieaNone;

 

  frm := Forms.GetParentForm(Self);

  if Assigned(frm) then

  begin

    frm.Designer.Modified;

  end;

end;

　　GetParentForm是Forms单元公开的一个函数，用于返回指定控件的窗口；

　　Designer是隶属于TCustomForm 的IDesignerHook接口；

　　Modified方法就是通知设计器（Designer）——有东西改变了。

　　如果不增加最后这段代码，你拖动鼠标修改子对象后，设计器并不知道有东西改变，Object Inspector并没有更新显示子对象的宽度属性，也没有通知窗体文件——它已经更新了，需要保存。