components - 如何防止 DFM 中不需要的对象

Question

我在我正在编写的组件中复制了带有 TBoundLabel 的源 LabeledEdit 示例，以附加一个方便的标签。它们工作正常，但我在加载 .dfm 表单时遇到问题（似乎当我的组件位于另一个组件上时，例如 CategoryPanel）：

找不到类 TBoundLabel

测试表格：

object Form2: TForm2
  Left = 0
  Top = 0
  Caption = 'Form2'
  ClientHeight = 518
  ClientWidth = 635
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object CategoryPanelGroup1: TCategoryPanelGroup
    Left = 0
    Top = 70
    Width = 635
    Height = 448
    VertScrollBar.Tracking = True
    Align = alClient
    HeaderFont.Charset = DEFAULT_CHARSET
    HeaderFont.Color = clWindowText
    HeaderFont.Height = -11
    HeaderFont.Name = 'Tahoma'
    HeaderFont.Style = []
    TabOrder = 0
    object CategoryPanel1: TCategoryPanel
      Top = 0
      Caption = 'CategoryPanel1'
      TabOrder = 0
    end
    object CategoryPanel2: TCategoryPanel
      Top = 200
      Caption = 'CategoryPanel2'
      TabOrder = 1
      object SubLabel: TBoundLabel
        Width = 78
        Height = 13
        Caption = 'LabelledCombo1'
      end
      object LabelledCombo1: TLabelledCombo
        Left = 152
        Top = 80
        Width = 145
        Height = 21
        LabelRotulo.Width = 78
        LabelRotulo.Height = 13
        LabelRotulo.Caption = 'LabelledCombo1'
        TabOrder = 0
      end
    end
  end
  object Panel1: TPanel
    Left = 0
    Top = 0
    Width = 635
    Height = 41
    Align = alTop
    Caption = 'Panel1'
    TabOrder = 1
  end
  object ToolBar1: TToolBar
    Left = 0
    Top = 41
    Width = 635
    Height = 29
    Caption = 'ToolBar1'
    TabOrder = 2
  end
end

LabelledCombo 的来源：

unit LabelledComboU;

interface

uses
  WinApi.Windows,
  WinApi.Messages,
  System.SysUtils,
  System.Math,
  System.UITypes,
  System.StrUtils,
  System.Classes,
  System.Types,
  VCL.Forms,
  VCL.ExtCtrls,
  VCL.Controls,
  VCL.Consts,
  VCL.Dialogs,
  VCL.ImgList,
  VCL.Samples.Spin,
  VCL.StdCtrls,
  VCL.GraphUtil,
  VCL.Graphics,
  VCL.THemes,
  VCL.Styles;

type
  TLabelledCombo = class(TCustomComboBox)
  private
    FLabel: TBoundLabel;
    FLabelPosition: TLabelPosition;
    FLabelSpacing: Integer;
    procedure SetLabelPosition(const Value: TLabelPosition);
    procedure SetLabelSpacing(const Value: integer);
  protected
    procedure SetParent(AParent: TWinControl); override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure SetName(const Value: TComponentName); override;
    procedure CMVisiblechanged(var Message: TMessage);
      message CM_VISIBLECHANGED;
    procedure CMEnabledchanged(var Message: TMessage);
      message CM_ENABLEDCHANGED;
    procedure CMBidimodechanged(var Message: TMessage);
      message CM_BIDIMODECHANGED;
  public
    constructor Create(AOwner: TComponent); override;
    procedure SetBounds(ALeft: Integer; ATop: Integer; AWidth: Integer; AHeight: Integer); override;
    procedure SetupInternalLabel;
  published
    property LabelRotulo: TBoundLabel read FLabel;
    property LabelPosition: TLabelPosition read FLabelPosition write SetLabelPosition default lpAbove;
    property LabelSpacing: Integer read FLabelSpacing write SetLabelSpacing default 3;
    property Align;
    property AutoComplete default True;
    property AutoCompleteDelay default 500;
    property AutoDropDown default False;
    property AutoCloseUp default False;
    property BevelEdges;
    property BevelInner;
    property BevelKind default bkNone;
    property BevelOuter;
    property Style; { Must be published before Items }
    property Anchors;
    property BiDiMode;
    property CharCase;
    property Color;
    property Constraints;
    property Ctl3D;
    property DoubleBuffered;
    property DragCursor;
    property DragKind;
    property DragMode;
    property DropDownCount;
    property Enabled;
    property ExtendedUI default False;
    property Font;
    property ImeMode;
    property ImeName;
    property ItemHeight;
    property ItemIndex default -1;
    property MaxLength;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentDoubleBuffered;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Sorted;
    property TabOrder;
    property TabStop;
    property Text;
    property TextHint;
    property Touch;
    property Visible;
    property StyleElements;
    property StyleName;
    property OnChange;
    property OnClick;
    property OnCloseUp;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnDrawItem;
    property OnDropDown;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnGesture;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMeasureItem;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnSelect;
    property OnStartDock;
    property OnStartDrag;
    property Items; { Must be published after OnMeasureItem }
  end;

implementation

{ TLabelledCombo }

procedure TLabelledCombo.CMBidimodechanged(var Message: TMessage);
begin
  if FLabel <> nil then
    FLabel.BiDiMode := BiDiMode;
end;

procedure TLabelledCombo.CMEnabledchanged(var Message: TMessage);
begin
  inherited;
  if FLabel <> nil then
    FLabel.Enabled := Enabled;
end;

procedure TLabelledCombo.CMVisiblechanged(var Message: TMessage);
begin
  inherited;
  if FLabel <> nil then
    FLabel.Visible := Visible;
end;

constructor TLabelledCombo.Create(AOwner: TComponent);
begin
  inherited;
  FLabelPosition := lpAbove;
  FLabelSpacing := 3;
  SetupInternalLabel;
end;

procedure TLabelledCombo.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (AComponent = FLabel) and (Operation = opRemove) then
    FLabel := nil;
end;

procedure TLabelledCombo.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);
  SetLabelPosition(FLabelPosition);
end;

procedure TLabelledCombo.SetLabelPosition(const Value: TLabelPosition);
var
  P: TPoint;
begin
  if FLabel = nil then Exit;
  FLabelPosition := Value;
  case Value of
    lpAbove:
      P := Point(Left, Top - FLabel.Height - FLabelSpacing);
    lpBelow:
      P := Point(Left, Top + Height + FLabelSpacing);
    lpLeft : P := Point(Left - FLabel.Width - FLabelSpacing,
                    Top + ((Height - FLabel.Height) div 2));
    lpRight: P := Point(Left + Width + FLabelSpacing,
                    Top + ((Height - FLabel.Height) div 2));
  end;
  FLabel.SetBounds(P.x, P.y, FLabel.Width, FLabel.Height);
end;

procedure TLabelledCombo.SetLabelSpacing(const Value: integer);
begin
  FLabelSpacing := Value;
  SetLabelPosition(FLabelPosition);
end;

procedure TLabelledCombo.SetName(const Value: TComponentName);
var
  LClearText: Boolean;
begin
  if (csDesigning in ComponentState) and (FLabel <> nil) and
     ((Flabel.GetTextLen = 0) or
     (CompareText(FLabel.Caption, Name) = 0)) then
    FLabel.Caption := Value;
  LClearText := (csDesigning in ComponentState) and (Text = '');
  inherited SetName(Value);
  if LClearText then
    Text := '';
end;

procedure TLabelledCombo.SetParent(AParent: TWinControl);
begin
  inherited SetParent(AParent);
  if FLabel = nil then exit;
  FLabel.Parent := AParent;
  FLabel.Visible := True;
end;

procedure TLabelledCombo.SetupInternalLabel;
begin
  if Assigned(FLabel) then exit;
  FLabel := TBoundLabel.Create(Self);
  FLabel.FreeNotification(Self);
//  FLabel.FocusControl := Self;
end;

end.

这是重现问题的最简单的测试，CategoryPanel 上的 LabelledCombo。（在表格上我不会感到悲伤。）

我尝试删除对子标签的引用并重新保存 .DFM 但它又回来了。我看不出要修复什么：源与 TLabeledEdit 的源相同，只是 TBoundLabel 不在我的单元中。我是否也需要将其源代码复制到我的组件单元中？

麦克风

score 1 · Accepted Answer

Delphi Sydney 中有一个错误，放置在 TCategoryPanel 上的 TLabeledEdit 给出了我在查询中提出的错误。

如何体验

在表单上放置一个 TCategoryPanelGroup，在其上创建几个 TCategoryPanel
在窗体上放置一个普通面板。
在步骤 2 的面板上放置一个 TLabeledEdit。
查看为文本然后查看为表单（Alt/F12）应该没有问题。
将 TLabeledEdit 从面板上移到 TCategoryPanel 之一上。
重复步骤 4。

尝试将其移动到其中一个 TCategoryPanel 上的另一个 TPanel 上：再次没有问题。

难怪我的标签组件有问题......

score 1 · Accepted Answer

问题是您正在尝试重新使用 TBoundLabel - 它专门设计用于仅在 TCustomLabeledEdit 中使用。在其他地方使用它会导致不必要的副作用。在下面的代码中（取自 VCL.ExtCtrls.pas），您可以很容易地看到 TBoundLabel 基本上绑定到 TCustomLabeledEdit。

如果这是一个聪明的设计，那是一个不同的问题。

procedure TBoundLabel.AdjustBounds;
begin
  inherited AdjustBounds;
  if Owner is TCustomLabeledEdit then
    with Owner as TCustomLabeledEdit do
      SetLabelPosition(LabelPosition);
end;

components - 如何防止 DFM 中不需要的对象

2 回答 2

Related

Reference