Question

我正在尝试创建一个像Delphi 2009的TButtonedEdit这样的组件。它是一个自定义的TEdit，左右两个按钮。

在我的版本中，我使用2个TSpeedButton对象作为左右按钮。

请看下面的简单代码。

可以安装它，我可以在组件托盘中看到它。

但是，由于某些未知原因，我无法保存我的申请。一旦我添加了组件，并开始更改属性或编写事件，Delphi将立即退出（崩溃？）。

我不知道什么是错的...但这是我的第一个组件，我肯定不对。

请问你能找出有什么问题吗？

如果我使用这个组件，似乎Delphi 7.0在保存.dfm时遇到了问题。

当我将此组件添加到表单中时，保存它，Delphi将要求保存“Unit1.pas”，然后立即退出。

谢谢。

unit MyButtonedEdit;

interface

uses
  Windows, Buttons, Classes, Controls, Forms, Graphics, Messages, StdCtrls;

type
  TMyCustomButtonedEdit = class(TCustomEdit)
  private
     FLeftButton: TSpeedButton;
     FRightButton: TSpeedButton;

     procedure LeftButtonClick(Sender: TObject);
     procedure RightButtonClick(Sender: TObject);

     function  GetLeftGlyph: TBitmap;
     function  GetRightGlyph: TBitmap;

     procedure SetLeftGlyph(const g: TBitmap);
     procedure SetRightGlyph(const g: TBitmap);

  protected
     procedure CreateParams(var Params: TCreateParams); override;
     procedure DoLeftButtonClick; virtual; abstract;
     procedure DoRightButtonClick; virtual; abstract;
     function  GetEnabled: boolean; override;
     procedure SetEnabled(e: boolean); override;
     procedure WMSize(var Message: TWMSize); message WM_SIZE;
     property  LeftButton: TSpeedButton read FLeftButton write FLeftButton;
     property  RightButton: TSpeedButton read FRightButton write FRightButton;
     property  Enabled: boolean read GetEnabled write SetEnabled;
     property  LeftGlyph: TBitmap read GetLeftGlyph write SetLeftGlyph;
     property  RightGlyph: TBitmap read GetRightGlyph write SetRightGlyph;

  public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
  published
  end;


  TMyButtonedEdit = class(TMyCustomButtonedEdit)
  private
     FOnLeftButtonClick: TNotifyEvent;
     FOnRightButtonClick: TNotifyEvent;
  protected
     procedure DoLeftButtonClick; override;
     procedure DoRightButtonClick; override;
  public
  published
     property LeftButton;
     property RightButton;
     property AutoSelect;
     property BorderStyle;
     property Color;
     property Ctl3d;
     property DragCursor;
     property DragMode;
     property Enabled;
     property Font;
     property LeftGlyph;
     property RightGlyph;
     property HideSelection;
     property ParentColor;
     property ParentCtl3D;
     property ParentFont;
     property ParentShowHint;
     property PopupMenu;
     property ReadOnly;
     property ShowHint;
     property TabOrder;
     property Text;
     property Visible;
     property OnLeftButtonClick: TNotifyEvent read FOnLeftButtonClick write FOnLeftButtonClick;
     property OnRightButtonClick: TNotifyEvent read FOnRightButtonClick write FOnRightButtonClick;       
     property OnChange;
     property OnClick;
     property OnDblClick;
     property OnDragDrop;
     property OnDragOver;
     property OnEndDrag;
     property OnEnter;
     property OnExit;
     property OnKeyDown;
     property OnKeyPress;
     property OnKeyUp;
     property OnMouseDown;
     property OnMouseMove;
     property OnMouseUp;
     property OnStartDrag;
  end;  

procedure Register;

implementation

procedure Register;
begin
   RegisterComponents('MyComponents',[TMyButtonedEdit]);
end;

{ TMyCustomButtonedEdit }

constructor TMyCustomButtonedEdit.Create(AOwner: TComponent);
begin
  inherited;
  ControlStyle := ControlStyle - [csSetCaption];

  FLeftButton := TSpeedButton.Create(self);
  with FLeftButton do begin
     Parent := self;
     TabStop := false;
     Visible := true;
     OnClick := LeftButtonClick;
  end;

  FRightButton := TSpeedButton.Create(self);
  with FRightButton do begin
     Parent := self;
     TabStop := false;
     Visible := true;
     OnClick := RightButtonClick;
  end;
end;

destructor TMyCustomButtonedEdit.Destroy;
begin
  FLeftButton.Free;
  FRightButton.Free;
  inherited;
end;

procedure TMyCustomButtonedEdit.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.Style := Params.Style or WS_CLIPCHILDREN;
end;

function TMyCustomButtonedEdit.GetEnabled: boolean;
begin
  result := inherited Enabled;
end;

function TMyCustomButtonedEdit.GetLeftGlyph: TBitmap;
begin
  result := FLeftButton.Glyph;
end;

function TMyCustomButtonedEdit.GetRightGlyph: TBitmap;
begin
  result := FRightButton.Glyph;
end;

procedure TMyCustomButtonedEdit.LeftButtonClick(Sender: TObject);
begin
  DoLeftButtonClick;
  SetFocus;
end;

procedure TMyCustomButtonedEdit.RightButtonClick(Sender: TObject);
begin
  DoRightButtonClick;
  SetFocus;
end;

procedure TMyCustomButtonedEdit.SetEnabled(e: boolean);
begin
  inherited Enabled := e;
  FLeftButton.Enabled := e;
  FRightButton.Enabled := e;
end;

procedure TMyCustomButtonedEdit.SetLeftGlyph(const g: TBitmap);
begin
  FLeftButton.Glyph := g;
end;

procedure TMyCustomButtonedEdit.SetRightGlyph(const g: TBitmap);
begin
  FRightButton.Glyph := g;
end;

procedure TMyCustomButtonedEdit.WMSize(var Message: TWMSize);
var
  b: integer;
begin
  if (BorderStyle = bsSingle) and not Ctl3d then
     b := 1
  else
     b := 0;
  FLeftButton.Top    := b;
  FLeftButton.Height := ClientHeight - b * 2;
  FLeftButton.Width  := FLeftButton.Height;
  FLeftButton.Left   := b;

  FRightButton.Top    := b;
  FRightButton.Height := ClientHeight - b * 2;
  FRightButton.Width  := FRightButton.Height;
  FRightButton.Left   := ClientWidth - FRightButton.Width - b;
end;

{ TMyButtonedEdit }

procedure TMyButtonedEdit.DoLeftButtonClick;
begin
  inherited;
  if Assigned(FOnLeftButtonClick) then
    FOnLeftButtonClick(Self);
end;

procedure TMyButtonedEdit.DoRightButtonClick;
begin
  inherited;
  if Assigned(FOnRightButtonClick) then
    FOnRightButtonClick(Self);
end;

end.

Answer 1

您的问题是打电话来启用。恰好在崩溃之前你实际收到的错误是

Project Project1a.exe raised exception class EStackOverflow with message 
'Stack overflow'. Process stopped. Use Step or Run to continue.

你已陷入无限循环。

要调试组件，最好的办法是在运行时创建它们。这比在设计时尝试更容易调试。为了在运行时进行调试，我做到了这一点。

var
BE : TMyButtonedEdit;
begin
BE :=  TMyButtonedEdit.Create(self);
be.Parent := self;
be.Visible := true;

当我创建你的控件时，我花了很长时间才得到stackoverflow错误，这通常意味着无限循环。我还没弄清楚为什么，但我正在努力。

解。

你不能继承属性（你可以 - 看评论），所以你的电话

inherited Enabled;

实际上是在呼唤自己。你需要做的是

 inherited GetEnabled;

感谢您的心理锻炼。

Answer 2

自从我进行任何组件开发以来已经很长时间了，但我似乎记得组件的所有者通常应该是父级的所有者，而不是父级本身，所以

 FLeftButton := TSpeedButton.Create(self);

应该是：

 FLeftButton := TSpeedButton.Create( AOwner);

我的组件崩溃（TCustomEdit后代）

2 个答案: