delphi - 我的组件崩溃(TCustomEdit 后代)

Question

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

在我的版本中，我使用 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;

感谢您的心理锻炼。