自定义 DBEdit 在设计时引发异常
Custom DBEdit raises exception at design time
您好，我正在尝试使用数据库 (AbsoluteDB) 来填充 HTML div。 table 字段包括“标题”和“描述”等名称。我的 DBEdit 组件有 2 个额外的属性“Pre”和“Suff”以及一个 var“Full”。在设计时，我会填充额外的属性，例如
“Pre”值为
，“Suff”值为 </div>。</p>
<p>在运行时，onchange 事件会用“Pre”+Field.Value+“Suff”填充“Full”。</p>
<p>组件（下面的代码）可以编译，但是当我在设计时将组件添加到我的表单时，我收到此错误消息。我正在使用 Delphi 7:</p>
<blockquote>
<p>Access violation at address 40341575 in module 'dbrtl70.bpl'. Read of address 000000D2.</p>
</blockquote>
<pre><code> 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.
</code></pre>
</section>
<div>
<section class="answer">
<p>问题是您假设当您引用 <code>Field</code> 时它不是 Nil。
如果连接到您的组件的数据集使用非持久性 TFields，它们的值将
在数据集打开之前为 Nil。</p>
<p>进行如下所示的更改</p>
<pre><code>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;
</code></pre>
<p>重新编译并重新安装您的包，然后尝试将组件拖放到
一个新项目。您会立即收到一条弹出消息，而不是 AV，
<code>Change</code> 方法中的 <code>Assertion</code> 失败，并且失败的确切原因
@RemyLebeau 预测。</p>
<p>要点是，在编写可识别数据库的对象时，以下任何一项
它的属性在设计时可能为 Nil：</p>
<ul>
<li>字段</li>
<li>数据源</li>
<li>数据集</li>
<li>上述任何属性</li>
</ul>
<p>并且您需要在代码中考虑到这一点。</p>
<p>如果您养成了自己检查 Nil 引用的习惯，那么您实际上并不需要 <code>Assert</code>，但保留它们也无妨，因为它们对性能的影响微乎其微。</p>
</section>
<section class="answer">
<p>我认为尝试访问 field.text</p> 时出现问题
<pre><code>procedure TPrefEdDb.Change;
begin
inherited Change;
if Field.Text<>'' then Full:=DoFull;
end;
</code></pre>
<p>所以我修改成这个</p>
<pre><code>procedure TPrefEdDb.Change;
begin
inherited Change;
if ((DataSource<>nil) and (DataSource.DataSet.Active=True) and (Field.AsString<>''))
then Full:=DoFull;
end;
</code></pre>
<p>而且效果很好。我现在唯一要解决的问题是 onchange 的结果是来自以前的记录而不是当前的。感谢您的帮助。</p>
</section>
</div>
</div>
<div class="line"></div>
<div id="footer">©2023 WhoseBug</div>
</body>
</html>
您好，我正在尝试使用数据库 (AbsoluteDB) 来填充 HTML div。 table 字段包括“标题”和“描述”等名称。我的 DBEdit 组件有 2 个额外的属性“Pre”和“Suff”以及一个 var“Full”。在设计时，我会填充额外的属性，例如
“Pre”值为