訪問衝突TStringEditLink之後被摧毀（TVirtualStringTree） - 拉扎勒斯例如

我已經嘗試實現基於Lazarius的example一個VirtualStringTree編輯訪問衝突TStringEditLink之後被摧毀（TVirtualStringTree） - 拉扎勒斯例如

你能告訴我爲什麼我得到一個訪問衝突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-05 REALSOFO

我在末端使用的溶液是波紋管列出：

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-26 05:55:24 REALSOFO

我沒有拉撒路，但它似乎表現上XE4相同。

在我的VST安裝中，位於./VirtualTreeviewV5.3.0/Demos/Advanced有一個Editors.pas文件，我找到了下面的析構函數。注意評論casues issue #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_RETURN問題。

問題#357似乎尚未確定：見- Used fix proposed in issue #361 to fix issue #357 (AV in advanced demo - PropertiesDemo form in XE3+)。我找不到#361 fix的證據。

編輯操作後單擊未分配節點時發生另一個問題。
在開始編輯之前檢查Click.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;

來源

2016-08-05 15:05:19 fantaghirocco

現在，因爲我播下了你的答案，我記得幾個月前我播下了這段代碼。我會測試它，我會回來一個反饋。 – REALSOFO

它不能解決問題。「FTree」和表單被破壞後，控制權被破壞。如果我不放'FEdit.Free'也是一樣的。爲了查看'FEdit'何時被銷燬，我使用了一個包裝函數TAltComboBox = class（TComboBox）; ... procedure WMDestroy（var Msg：TWMDestroy）;消息WM_DESTROY;' – REALSOFO

爲什麼你使用相當古老的V5.3.0？問題在目前的V6.3.0中是否仍然存在？ –

代碼的這個僞堆棧跟蹤說明了問題：

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組件有一個指向表單的指針，所以它可以設置屬性。

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-05 23:37:17

它不起作用！我之前也曾嘗試過'如果分配（FEdit），然後FEdit.Free;'。它也有興趣，如果我在'inherited'後添加'showmessage（'...'）'，錯誤消失。也許這是編輯器被破壞之後節點的焦點。 – REALSOFO

也許還可以將'FEdit'設置爲'nil'會有幫助嗎？否則，這聽起來像是一種競爭條件。 –

它必須是關鍵按下的東西，但我想不出...... – REALSOFO

在HeidiSql源代碼中有一個很好的例子來避免這個錯誤。代碼少許改變是：

procedure TBaseEditorLink.TempWindowProc(var Message: TMessage); 
begin 
    case Message.Msg of 
    WM_CHAR: //Catch hotkeys 
     if not (TWMChar(Message).CharCode = VK_TAB) then FOldWindowProc(Message); 
    WM_GETDLGCODE: //"WantTabs" mode for main control 
     Message.Result := Message.Result or DLGC_WANTARROWS or DLGC_WANTALLKEYS or DLGC_WANTTAB; 
    else 
     begin 
     try 
      FOldWindowProc(Message); 
     except 
      on E : EAccessViolation do; //EAccessViolation occurring in some cases 
      on E : Exception do raise; 
     end; 
     end; 
    end; 
end;

來源

2016-08-07 07:57:06 REALSOFO

這並沒有解決錯誤，它只是從用戶身上隱藏它。解決問題而不是隱藏錯誤會更好。 –

一種解決方案是也以釋放先前創建的控件。

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;

來源

2016-08-10 10:52:36 REALSOFO

訪問衝突TStringEditLink之後被摧毀（TVirtualStringTree） - 拉扎勒斯例如

回答

相關問題