Delphi TStringEditLink被破坏后的访问冲突（TVirtualStringTree）-Lazarus示例

我试图实现一个基于Lazarius的VirtualStringTree编辑器

你能告诉我为什么在

TStringEditLink

被销毁后我会遇到访问冲突吗

很奇怪，只有按ESCAPE或ENTER键时才会出现错误。如果我从一个单元格单击到另一个单元格，则没有错误

像观察一样，我知道如果我从

析构函数TStringEditLink.Destroy中删除
FEdit.Free
代码，错误就会消失

你有解决这个问题的办法吗

下面是完整的代码：

unit Unit2;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, VirtualTrees, EditorLink, Vcl.StdCtrls,
  Vcl.ExtCtrls, Vcl.Imaging.jpeg;

type
  TTreeData = record
    Fields: array of String;
  end;
  PTreeData = ^TTreeData;

const
  SizeVirtualTree = SizeOf(TTreeData);

type
  TForm2 = class(TForm)
    VirtualTree: TVirtualStringTree;
    procedure FormCreate(Sender: TObject);
    procedure VirtualTreeClick(Sender: TObject);
    procedure VirtualTreeCreateEditor(Sender: TBaseVirtualTree;
      Node: PVirtualNode; Column: TColumnIndex; out EditLink: IVTEditLink);
    procedure VirtualTreeEditing(Sender: TBaseVirtualTree; Node: PVirtualNode;
      Column: TColumnIndex; var Allowed: Boolean);
    procedure VirtualTreeFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
    procedure VirtualTreeGetNodeDataSize(Sender: TBaseVirtualTree;
      var NodeDataSize: Integer);
    procedure VirtualTreeGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
      Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
    procedure VirtualTreeNewText(Sender: TBaseVirtualTree; Node: PVirtualNode;
      Column: TColumnIndex; NewText: string);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

procedure TForm2.FormCreate(Sender: TObject);
var
  Node: PVirtualNode;
  LTreeData: PTreeData;
begin
  VirtualTree.Clear;
  VirtualTree.BeginUpdate;

  //node 1
  Node:= VirtualTree.AddChild(nil,nil);
  VirtualTree.ValidateNode(Node,False);

  LTreeData:= VirtualTree.GetNodeData(Node);
  SetLength(LTreeData^.Fields,3);

  LTreeData^.Fields[0]:= 'John';
  LTreeData^.Fields[1]:= '2500';
  LTreeData^.Fields[2]:= 'Production';

  //node 2
  Node:= VirtualTree.AddChild(nil,nil);
  VirtualTree.ValidateNode(Node,False);

  LTreeData:= VirtualTree.GetNodeData(Node);
  SetLength(LTreeData^.Fields,3);

  LTreeData^.Fields[0]:= 'Mary';
  LTreeData^.Fields[1]:= '2100';
  LTreeData^.Fields[2]:= 'HR';

  VirtualTree.EndUpdate;
end;

procedure TForm2.VirtualTreeClick(Sender: TObject);
var
  VT: TVirtualStringTree;
  Click: THitInfo;
begin
  VT:= Sender as TVirtualStringTree;
  VT.GetHitTestInfoAt(Mouse.CursorPos.X-VT.ClientOrigin.X, Mouse.CursorPos.Y-VT.ClientOrigin.Y, True, Click);
  VT.EditNode(Click.HitNode,Click.HitColumn);
end;

procedure TForm2.VirtualTreeCreateEditor(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex; out EditLink: IVTEditLink);
begin
  EditLink := TStringEditLink.Create;
end;

procedure TForm2.VirtualTreeEditing(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean);
begin
  Allowed:= True;
end;

procedure TForm2.VirtualTreeFreeNode(Sender: TBaseVirtualTree;
  Node: PVirtualNode);
var
  LTreeData: PTreeData;
begin
  LTreeData:= Sender.GetNodeData(Node);
  Finalize(LTreeData^);
end;

procedure TForm2.VirtualTreeGetNodeDataSize(Sender: TBaseVirtualTree;
  var NodeDataSize: Integer);
begin
  NodeDataSize:= SizeVirtualTree;
end;

procedure TForm2.VirtualTreeGetText(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
  var CellText: string);
var
  LTreeData: PTreeData;
begin
  if Assigned(Node) and (Column > NoColumn) then
    begin
      LTreeData:= Sender.GetNodeData(Node);
      CellText:= LTreeData^.Fields[Column];
    end;
end;

procedure TForm2.VirtualTreeNewText(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex; NewText: string);
var
  LTreeData: PTreeData;
begin
  LTreeData:= Sender.GetNodeData(Node);
  LTreeData^.Fields[Column]:= NewText;
end;

end.

以及
EditorLink
单元

unit EditorLink;

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs,
  VirtualTrees, Messages, Windows, StdCtrls, Vcl.ExtCtrls;

type

  TStringEditLink = class(TInterfacedObject, IVTEditLink)
  private
    FEdit: TWinControl;
    FTree: TVirtualStringTree;
    FNode: PVirtualNode;
    FColumn: Integer;
    FStopping: Boolean;
  protected
    procedure EditKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  public
    destructor Destroy; override;
    function BeginEdit: Boolean; stdcall;
    function CancelEdit: Boolean; stdcall;
    function EndEdit: Boolean; stdcall;
    function GetBounds: TRect; stdcall;
    function PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex): Boolean; stdcall;
    procedure ProcessMessage(var Message: TMessage); stdcall;
    procedure SetBounds(R: TRect); stdcall;
  end;

implementation

uses unit2;

destructor TStringEditLink.Destroy;
begin
  FEdit.Free;  //--> seems that due to this I get the access violation
  inherited;
end;

procedure TStringEditLink.EditKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  case Key of
    VK_ESCAPE:
      begin
        FTree.CancelEditNode;
        Key := 0;
        FTree.setfocus;
      end;
    VK_RETURN:
      begin
       PostMessage(FTree.Handle, WM_KEYDOWN, VK_DOWN, 0);
       Key := 0;
       FTree.EndEditNode;
       FTree.setfocus;
      end;
  end; //case
end;

function TStringEditLink.BeginEdit: Boolean;
begin
  Result := not FStopping;
  if Result then
    begin
      FEdit.Show;
      FEdit.SetFocus;
    end;
end;

function TStringEditLink.CancelEdit: Boolean;
begin
  Result := True;
  FEdit.Hide;
end;

function TStringEditLink.EndEdit: Boolean;
var
  s: String;
begin
  Result := True;
  s := TComboBox(FEdit).Text;
  FTree.Text[FNode, FColumn] := s;

  FTree.InvalidateNode(FNode);
  FEdit.Hide;
  FTree.SetFocus;
end;

function TStringEditLink.GetBounds: TRect;
begin
  Result := FEdit.BoundsRect;
end;

function TStringEditLink.PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex): Boolean;
var
  FCellText: String;
  FCellTextBounds: TRect;
  FCellFont: TFont;
begin
  Result := True;
  FTree := Tree as TVirtualStringTree;

  FNode := Node;
  FColumn := Column;

  FCellFont:= TFont.Create;
  FTree.GetTextInfo(FNode, FColumn, FCellFont, FCellTextBounds, FCellText);

  FEdit := TComboBox.Create(nil);
  with FEdit as TComboBox do
    begin
      Visible := False;
      Parent := Tree;
      Items.Add('Google');
      Items.Add('Yahoo');
      Items.Add('Altavista');
      OnKeyDown := EditKeyDown;
      Text:= FCellText;
    end;
end;

procedure TStringEditLink.ProcessMessage(var Message: TMessage);
begin
  FEdit.WindowProc(Message);
end;

procedure TStringEditLink.SetBounds(R: TRect);
var
  Dummy: Integer;
begin
  FTree.Header.Columns.GetColumnBounds(FColumn, Dummy, R.Right);
  FEdit.BoundsRect := R;
end;

end.

我没有Lazarus，但它在XE4上的表现似乎相同

在我的VST安装中，位于
/VirtualTreeviewV5.3.0/Demos/Advanced
中有一个
Editors.pas
文件，我在其中找到了下面的析构函数。注意注释
原因问题357
：

destructor TPropertyEditLink.Destroy;
begin
  //FEdit.Free; casues issue #357. Fix:
  if FEdit.HandleAllocated then
    PostMessage(FEdit.Handle, CM_RELEASE, 0, 0);
  inherited;
end;

此外，
FEdit.Free
在新创建之前在
PrepareEdit
方法中执行：

function TStringEditLink.PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex): Boolean;
var
  FCellText: String;
  FCellTextBounds: TRect;
  FCellFont: TFont;
begin
  Result := True;
  FTree := Tree as TVirtualStringTree;

  FNode := Node;
  FColumn := Column;

  FEdit.Free;
  FEdit := nil;

  FCellFont:= TFont.Create;
  FTree.GetTextInfo(FNode, FColumn, FCellFont, FCellTextBounds, FCellText);

  FEdit := TComboBox.Create(nil);
  with FEdit as TComboBox do
  . . .

这解决了XE4和XE7安装中的
VK_ESC
和
VK_返回问题


问题似乎尚未解决：请参阅。我没有发现
#361补丁的证据


在编辑操作后单击未分配的节点时，我会遇到另一个问题。

在开始编辑之前，检查
单击.HitNode
是否不是
nil
，可以解决上述问题

procedure TForm2.VirtualTreeClick(Sender: TObject);
var
  VT: TVirtualStringTree;
  Click: THitInfo;
begin
  VT:= Sender as TVirtualStringTree;
  VT.GetHitTestInfoAt(Mouse.CursorPos.X-VT.ClientOrigin.X, Mouse.CursorPos.Y-VT.ClientOrigin.Y, True, Click);

  if Assigned(Click.HitNode) then
    VT.EditNode(Click.HitNode,Click.HitColumn);
end;


请注意，
EditorLink
单元中还有一个循环引用：

uses Unit2;

我没有Lazarus，但它在XE4上的表现似乎相同

在我的VST安装中，位于
/VirtualTreeviewV5.3.0/Demos/Advanced
中有一个
Editors.pas
文件，我在其中找到了下面的析构函数。注意注释
原因问题357
：

destructor TPropertyEditLink.Destroy;
begin
  //FEdit.Free; casues issue #357. Fix:
  if FEdit.HandleAllocated then
    PostMessage(FEdit.Handle, CM_RELEASE, 0, 0);
  inherited;
end;

此外，
FEdit.Free
在新创建之前在
PrepareEdit
方法中执行：

function TStringEditLink.PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex): Boolean;
var
  FCellText: String;
  FCellTextBounds: TRect;
  FCellFont: TFont;
begin
  Result := True;
  FTree := Tree as TVirtualStringTree;

  FNode := Node;
  FColumn := Column;

  FEdit.Free;
  FEdit := nil;

  FCellFont:= TFont.Create;
  FTree.GetTextInfo(FNode, FColumn, FCellFont, FCellTextBounds, FCellText);

  FEdit := TComboBox.Create(nil);
  with FEdit as TComboBox do
  . . .

这解决了XE4和XE7安装中的
VK_ESC
和
VK_返回问题


问题似乎尚未解决：请参阅。我没有发现
#361补丁的证据


在编辑操作后单击未分配的节点时，我会遇到另一个问题。

在开始编辑之前，检查
单击.HitNode
是否不是
nil
，可以解决上述问题

procedure TForm2.VirtualTreeClick(Sender: TObject);
var
  VT: TVirtualStringTree;
  Click: THitInfo;
begin
  VT:= Sender as TVirtualStringTree;
  VT.GetHitTestInfoAt(Mouse.CursorPos.X-VT.ClientOrigin.X, Mouse.CursorPos.Y-VT.ClientOrigin.Y, True, Click);

  if Assigned(Click.HitNode) then
    VT.EditNode(Click.HitNode,Click.HitColumn);
end;


请注意，
EditorLink
单元中还有一个循环引用：

uses Unit2;

代码的伪堆栈跟踪说明了问题：

FEdit.EditKeyDown()
  -- calls --
FTree.EndEditNode()  { or FTree.CancelEditNode }
  -- which calls --
TStringEditLink.Destroy()
  -- which calls --
FEdit.Free()

FEdit.EditKeyDown（）的事件处理程序中的代码在向下键事件处理程序代码完成运行之前释放
FEdit
。因此，访问冲突是错误的

我们通过设置一个信号机制来处理这个问题，这样
TStringEditLink
可以在完成时向主窗体发出信号，主窗体可以运行代码来销毁
TStringEditLink
（因为它首先创建了
TStringEditLink
）。我们在主窗体中添加了一个
TTimer
，以及一个接收信号的属性。
TTimer
监视属性。
TStringEditLink
组件有一个指向表单的指针，因此它可以设置属性

单元1；
接口
使用
Winapi.Windows、Winapi.Messages、System.SysUtils、System.Variants、System.Classes、Vcl.Graphics、，
控件、窗体、对话框、文本、虚拟树；
类型
TEditorAction=（eaCancel、eaAccept、eaNotSet）；
TForm1=类（TForm）
vstTree:TVirtualStringTree；
过程vstTreeCreateEditor（发送方：TBaseVirtualTree；节点：PVirtualNode；列：TColumnIndex；输出编辑链接：IVTEditLink）；
程序DoWatchTreeEditorTimer（发送方：TObject）；
过程表单创建（发送方：ToObject）；
销毁程序表（发送方：TObject）；
私有的
定时器：TTimer；
FEditorAction：TEditorAction；
过程SetEditorAction（常量值：TEditorAction）；
公众的
属性EditorAction:TEditorAction read FEditorAction write SetEditorAction；
结束；
TPropertyEdit=class（TInterfacedObject，IVTEditLink）
程序EditKeyDown（发送方：ToObject；变量关键字：Word；Shift:TShiftState）；
私有的
FEdit：双控制；
FTree:TVirtualStringTree；
FNode:PVirtualNode；
FColumn：整数；
公众的
FForm:TForm1；
毁灭者毁灭；推翻
函数BeginEdit:Boolean；stdcall；
函数取消编辑：布尔；stdcall；
函数EndEdit：布尔型；stdcall；
函数GetBounds:TRect；stdcall；
函数PrepareEdit（树：TBaseVirtualTree；节点：PVirtualNode；列：TColumnIndex）：布尔；stdcall；
过程ProcessMessage（var消息：TMessage）；stdcall；
程序设定点（R:TRCT）；stdcall；
结束；
变量
表1:TForm1；
实施
{$R*.dfm}
{TForm1}
过程TForm1.FormCreate（发送方：TObject）；
开始
FEndEditTimer:=TTimer.Create（无）；
FEndEditTimer.Enabled:=False；
时间间隔：=100；
FEndEditTimer.OnTimer:=DoWatchTreeEditorTimer；
结束；
程序TForm1.FormDestroy（发送方：ToObject）；
开始
FreeAndNil（FEndEditTimer）；
结束；
过程TForm1.vstTreeCreateEditor（发送方：TBaseVirtualTree；节点：PVirtualNode；列：TColumnIndex；输出编辑链接：IVTEditLink）；
开始
EditLink:=TPropertyEdit.Create；
TPropertyEdit（EditLink）.FForm:=Self；{让我们在需要销毁编辑器时发出窗体信号}
FEditorAction:=eaNotSet；
结束；
过程TForm1.SetEditorAction（常量值：TEditorAction）；
开始
如果是FEditorAction值，则
开始
FEditorAction:=值；
FEndEditTimer.Enabled:=真；
结束；
结束；
程序TForm1.DoWatchTreeEditorTimer（发送方：TObject）；
开始
FEndEditTimer.Enabled:=False；
Application.ProcessMessages；
案例二
eaCancel：
开始
vstTree.CancelEditNode；
vstTree.SetFocu