自定义 DBEdit 在设计时引发异常答案

【问题标题】：Custom DBEdit raises exception at design time自定义 DBEdit 在设计时引发异常
【发布时间】：2021-04-18 06:21:30
【问题描述】：

您好，我正在尝试使用数据库 (AbsoluteDB) 来填充 HTML div。表字段包括“标题”和“描述”等名称。我的 DBEdit 组件有 2 个额外的属性“Pre”和“Suff”以及一个 var“Full”。在设计时，我会填写额外的属性，例如

“Pre”值为

，“Suff”值为

。

在运行时，onchange 事件将用“Pre”+Field.Value+“Suff”填充“Full”。

组件（下面的代码）可以编译，但是当我在设计时将组件添加到我的表单时，我会收到此错误消息。我正在使用 Delphi 7：

模块“dbrtl70.bpl”中地址 40341575 的访问冲突。读取地址 000000D2。

 unit PrefEdDb;

interface

uses WinTypes, WinProcs, Messages, SysUtils, Classes, Controls, 
     Forms, Graphics, Dbctrls, Windows, ExtCtrls, StdCtrls, Variants;

type
  TPrefEdDb = class(TDBEdit)
    private
        FPre : String;
        FSuff : String;
        procedure AutoInitialize;
        procedure AutoDestroy;
        function GetPre : String;
        procedure SetPre(Value : String);
        function GetSuff : String;
        procedure SetSuff(Value : String);
        function DoFull:string;

    protected
        procedure Change; override;
        procedure Click; override;
        procedure DoExit; override;
        procedure KeyPress(var Key : Char); override;
        procedure Loaded; override;

    public
        Full : String;
        constructor Create(AOwner: TComponent); override;
        destructor Destroy; override;

    published
        property OnChange;
        property OnClick;
        property OnDblClick;
        property OnDragDrop;
        property OnEnter;
        property OnExit;
        property OnKeyDown;
        property OnKeyPress;
        property OnKeyUp;
        property OnMouseDown;
        property OnMouseMove;
        property OnMouseUp;
        property Pre : String read GetPre write SetPre;
        property Suff : String read GetSuff write SetSuff;

  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TPrefEdDb]);
end;

function TPrefEdDb.DoFull:string;
var
  s:string;
begin
  result:='';
  if ((Field.Text<>'') or (Field.Value<>null)) then
    begin
      s:='';
      if FPre<>'' then s:=FPre;
      s:=s+field.Text;
      if FSuff<>'' then s:=s+FSuff;
      Result:=s;
    end;
end;

procedure TPrefEdDb.AutoInitialize;
begin
  Full := '';
  FPre := '';
  FSuff := '';
end;

procedure TPrefEdDb.AutoDestroy;
begin
     { No objects from AutoInitialize to free }
end;

function TPrefEdDb.GetPre : String;
begin
  Result := FPre;
end;

procedure TPrefEdDb.SetPre(Value : String);
begin
  FPre := Value;
end;

function TPrefEdDb.GetSuff : String;
begin
  Result := FSuff;
end;

procedure TPrefEdDb.SetSuff(Value : String);
begin
   FSuff := Value;
end;

procedure TPrefEdDb.Change;
begin
  inherited Change;
  if Field.Text<>'' then Full:=DoFull;
end;

procedure TPrefEdDb.Click;
begin
   inherited Click;
end;


procedure TPrefEdDb.DoExit;
begin
   inherited DoExit;
 end;

procedure TPrefEdDb.KeyPress(var Key : Char);
const
  TabKey = Char(VK_TAB);
  EnterKey = Char(VK_RETURN);
begin
     inherited KeyPress(Key);
end;

constructor TPrefEdDb.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  AutoInitialize;
end;

destructor TPrefEdDb.Destroy;
begin
  AutoDestroy;
  inherited Destroy;
end;

procedure TPrefEdDb.Loaded;
begin
  inherited Loaded;
end;


end.

标签： delphi

【解决方案1】：

问题是您假设当您引用Field 时，它不是Nil。如果连接到您的组件的数据集使用非持久 TField，它们的值将在数据集打开之前为 Nil。

进行如下所示的更改

function TPrefEdDb.DoFull:string;
var
  s:string;
begin
  result:='';
  Assert(Field <> Nil);      //  MA
  if Field = Nil then exit;  //  MA
  if ((Field.Text<>'') or (Field.Value<>null)) then
    begin
      s:='';
      if FPre<>'' then s:=FPre;
      s:=s+field.Text;
      if FSuff<>'' then s:=s+FSuff;
      Result:=s;
    end;
end;

procedure TPrefEdDb.Change;
begin
  inherited Change;

  Assert(Field <> Nil);      //  MA
  if Field = Nil then exit;  //  MA
  if Field.Text<>'' then Full:=DoFull;
end;

重新编译并重新安装你的包，然后尝试将组件放到一个新项目。您将立即收到一条弹出消息，而不是 AV， Change 方法中的 Assertion 失败了，失败的确切原因 @RemyLebeau 预测。

带回家的信息是，在编码 db-aware 对象时，以下任何它的属性在设计时可能为 Nil：

字段
数据源
数据集
以上任何属性

您需要在代码中考虑到这一点。

如果您养成了自己检查 Nil 引用的习惯，那么您实际上并不需要 Asserts，但将它们留在其中并没有什么坏处，因为它们对性能的影响很小。

【讨论】：

谢谢你 - 我们同时发布 - 但我已经记下了你的 cmets/帮助以备将来使用

【解决方案2】：

我认为尝试访问 field.text 的问题

procedure TPrefEdDb.Change;
begin
  inherited Change;
  if Field.Text<>'' then Full:=DoFull;
end;

所以我把它修改成了这个

procedure TPrefEdDb.Change;
begin
  inherited Change;
  if ((DataSource<>nil) and (DataSource.DataSet.Active=True) and (Field.AsString<>'')) 
  then Full:=DoFull;
end;

而且效果很好。我现在必须解决的唯一问题是 onchange 结果来自上一个记录而不是当前记录。感谢您的帮助。

【讨论】：

重新。我的 onchange 结果问题我通过将继承的 Change 移到 if 语句之后解决了这个问题