简体   繁体   English

如何在 DFM 中防止不需要的 object

[英]How to prevent unwanted object in DFM

I copied the source LabeledEdit example with a TBoundLabel in components I'm writing to attach a convenient label to.我在我正在编写的组件中复制了带有 TBoundLabel 的源 LabeledEdit 示例,以便将方便的 label 附加到。 They work fine but I'm getting issues loading the.dfm form (seemingly when my component is on another such as a CategoryPanel):它们工作正常,但我在加载 .dfm 表单时遇到问题(似乎是当我的组件位于另一个组件上时,例如 CategoryPanel):

Class TBoundLabel not found Class TBoundLabel 未找到

在此处输入图像描述 Test form:测试表格:

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

Source for the LabelledCombo: 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.

This is the barest test which reproduces the problem, a LabelledCombo on a CategoryPanel.这是重现问题的最简单的测试,CategoryPanel 上的 LabelledCombo。 (On a form I am not getting grief.) (在表格上我不会感到悲伤。)

I tried deleting the reference to Sublabel and resaving the.DFM but it comes back again.我尝试删除对子标签的引用并重新保存.DFM,但它又回来了。 I can't see what to fix: the source is identical to that of TLabeledEdit except that TBoundLabel is not in my Unit.我看不出要修复什么:源与 TLabeledEdit 的源相同,只是 TBoundLabel 不在我的单元中。 Do I need to copy the source of that too into my component unit?我是否也需要将其源代码复制到我的组件单元中?

Mike麦克风

The problem is that you are trying to re-use TBoundLabel - which has been designed specifically to be used from within TCustomLabeledEdit only.问题是您正在尝试重新使用 TBoundLabel - 它专门设计用于仅在 TCustomLabeledEdit 中使用。 Using it elsewhere will lead to unwanted side effects.在其他地方使用它会导致不必要的副作用。 In the code below (taken from VCL.ExtCtrls.pas) you can easily see that TBoundLabel is basically bound to TCustomLabeledEdit.在下面的代码中(取自 VCL.ExtCtrls.pas),您可以很容易地看到 TBoundLabel 基本上绑定到 TCustomLabeledEdit。

If that is a smart design, is a different question though.如果这是一个聪明的设计,那是一个不同的问题。

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

There is a bug in Delphi Sydney, whereby a TLabeledEdit placed on a TCategoryPanel gives the fault I raised in my query. Delphi Sydney 中有一个错误,放置在 TCategoryPanel 上的 TLabeledEdit 给出了我在查询中提出的错误。

How to experience it如何体验

  1. Place a TCategoryPanelGroup on a form, create a couple of TCategoryPanels on it在表单上放置一个 TCategoryPanelGroup,在其上创建几个 TCategoryPanel
  2. Place an ordinary Panel on the form.在窗体上放置一个普通面板。
  3. Place a TLabeledEdit on step 2's Panel.在步骤 2 的面板上放置一个 TLabeledEdit。
  4. View as Text then View as Form (Alt/F12) there should be no problem.查看为文本然后查看为表单(Alt/F12)应该没有问题。
  5. Move the TLabeledEdit off the Panel and onto one of the TCategoryPanels.将 TLabeledEdit 从面板上移到 TCategoryPanel 之一上。
  6. Repeat step 4.重复步骤 4。

Try moving it onto another TPanel on one of the TCategoryPanels: again there is no problem.尝试将其移动到其中一个 TCategoryPanel 上的另一个 TPanel 上:再次没有问题。

No wonder I had trouble with my labelled components....难怪我的标签组件有问题......

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM