我的组件崩溃(TCustomEdit后代)

我正在尝试创建像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.

Toby Allen.. 7

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

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;

感谢您的心理锻炼.

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

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;

感谢您的心理锻炼.