我尝试实现了一个基于Lazarius的example的VirtualStringTree编辑器
你能告诉我为什么在TStringEditLink
被销毁后我会遇到访问冲突吗?
奇怪的是,只有当我按下ESCAPE或ENTER时才会出现错误。如果我从一个单元格单击到另一个单元格,则没有错误。
就像观察一样,我提出如果从destructor 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.
发布于 2016-08-26 13:55:24
我在最后使用的解决方案如下所示:
TBasePanel = class(TPanel)
private
procedure CMRelease(var Message: TMessage); message CM_RELEASE;
protected
public
procedure Release; virtual;
end;
TStringEditLink = class(TInterfacedObject, IVTEditLink)
private
FBasePanel: TBasePanel;
...
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
procedure TBasePanel.CMRelease(var Message: TMessage);
begin
Free;
end;
procedure TBasePanel.Release;
begin
if HandleAllocated then
PostMessage(Handle, CM_RELEASE, 0, 0);
end;
destructor TStringEditLink.Destroy;
begin
if Assigned(FBasePanel) then FBasePanel.Release;
inherited;
end;
对于希望同时显示的任意多个组件编辑器,应该将FBasePanel
用作owner
和parent
。
发布于 2016-08-06 07:37:17
代码的伪堆栈跟踪说明了这个问题:
FEdit.EditKeyDown()
-- calls --
FTree.EndEditNode() { or FTree.CancelEditNode }
-- which calls --
TStringEditLink.Destroy()
-- which calls --
FEdit.Free()
在按键事件处理程序代码完成运行之前,FEdit.EditKeyDown()
的事件处理程序中的代码将释放FEdit
。从而导致访问冲突错误。
我们通过设置一个信号机制来处理这个问题,这样TStringEditLink
就可以在完成时向main form发送信号,main form就可以运行代码来销毁TStringEditLink
(因为它是最初创建TStringEditLink
的那个)。我们向主窗体添加了一个TTimer
,并添加了一个接收信号的属性。TTimer
监视该属性。TStringEditLink
组件有一个指向窗体的指针,因此它可以设置该属性。
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, VirtualTrees;
type
TEditorAction = (eaCancel, eaAccept, eaNotSet);
TForm1 = class(TForm)
vstTree: TVirtualStringTree;
procedure vstTreeCreateEditor(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; out EditLink: IVTEditLink);
procedure DoWatchTreeEditorTimer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
FEndEditTimer: TTimer;
FEditorAction: TEditorAction;
procedure SetEditorAction(const Value: TEditorAction);
public
property EditorAction: TEditorAction read FEditorAction write SetEditorAction;
end;
TPropertyEdit = class(TInterfacedObject, IVTEditLink)
procedure EditKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
private
FEdit: TWinControl;
FTree: TVirtualStringTree;
FNode: PVirtualNode;
FColumn: Integer;
public
FForm: TForm1;
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;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
FEndEditTimer := TTimer.Create(nil);
FEndEditTimer.Enabled := False;
FEndEditTimer.Interval := 100;
FEndEditTimer.OnTimer := DoWatchTreeEditorTimer;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FreeAndNil(FEndEditTimer);
end;
procedure TForm1.vstTreeCreateEditor(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; out EditLink: IVTEditLink);
begin
EditLink := TPropertyEdit.Create;
TPropertyEdit(EditLink).FForm := Self; { lets us signal the form when the editor needs to be destroyed }
FEditorAction := eaNotSet;
end;
procedure TForm1.SetEditorAction(const Value: TEditorAction);
begin
if FEditorAction <> Value then
begin
FEditorAction := Value;
FEndEditTimer.Enabled := True;
end;
end;
procedure TForm1.DoWatchTreeEditorTimer(Sender: TObject);
begin
FEndEditTimer.Enabled := False;
Application.ProcessMessages;
case FEditorAction of
eaCancel:
begin
vstTree.CancelEditNode;
vstTree.SetFocus;
end;
eaAccept:
begin
vstTree.EndEditNode;
vstTree.SetFocus;
end;
end;
end;
{ TPropertyEdit }
function TPropertyEdit.BeginEdit: Boolean;
begin
Result := True;
FEdit.Show;
end;
function TPropertyEdit.CancelEdit: Boolean;
begin
Result := True;
FEdit.Hide;
FForm.FEditorAction := eaCancel;
end;
destructor TPropertyEdit.Destroy;
begin
if FEdit <> nil then
FreeAndNil(FEdit);
inherited;
end;
procedure TPropertyEdit.EditKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
case Key of
VK_ESCAPE:
begin
Key := Word(0); { some versions of Delphi throw random A/V errors if '0' is not cast as a Word() }
FForm.EditorAction := eaCancel;
end;
VK_RETURN:
begin
Key := Word(0); { some versions of Delphi throw random A/V errors if '0' is not cast as a Word() }
FForm.EditorAction := eaAccept
end;
end;
end;
function TPropertyEdit.EndEdit: Boolean;
begin
Result := True;
{ Do something with the value provided by the user }
FEdit.Hide;
FForm.EditorAction := eaAccept;
end;
function TPropertyEdit.GetBounds: TRect;
begin
Result := FEdit.BoundsRect;
end;
function TPropertyEdit.PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex): Boolean;
begin
Result := True;
FTree := Tree as TVirtualStringTree;
FNode := Node;
FColumn := Column;
{ Setup the editor for user }
FEdit := TSomeWinControl.Create(nil);
FEdit.Properties := Values;
{ Capture keystrokes }
FEdit.OnKeyDown := EditKeyDown;
end;
procedure TPropertyEdit.ProcessMessage(var Message: TMessage);
begin
FEdit.WindowProc(Message);
end;
procedure TPropertyEdit.SetBounds(R: TRect);
var
Dummy: Integer;
begin
FTree.Header.Columns.GetColumnBounds(FColumn, Dummy, R.Right);
FEdit.BoundsRect := R;
end;
end.
我们的代码做了很多额外的事情,所以上面的代码是基本部分的复制/粘贴,以演示如何克服竞争条件。这是未经测试的,但应该会让你朝着正确的方向前进。
发布于 2016-08-10 18:52:37
一种解决方案也是释放以前创建的控件。
function TStringEditLink.PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex): Boolean;
var
FCellText: String;
FCellTextBounds: TRect;
FCellFont: TFont;
i: Integer;
Item: TControl;
begin
Result := True;
FTree := Tree as TVirtualStringTree;
FNode := Node;
FColumn := Column;
FCellFont:= TFont.Create;
FTree.GetTextInfo(FNode, FColumn, FCellFont, FCellTextBounds, FCellText);
//----->> free previuous created control <<----------
for i := (FTree.ControlCount - 1) downto 0 do
begin
Item := FTree.controls[i];
if assigned(item) then
begin
if item is TComboBox then FreeAndNil(item);
end;
end;
//---------------------------------------------------
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;
https://stackoverflow.com/questions/38790920
复制相似问题