Access Violation po wejściu do okienka

0

Witam,

Raz za pierwszym razem, raz za drugim razem po uruchomieniu programu i wejściu do okna otrzymuję Access Violation i tak samo przy próbie wyjścia z okna dostaję Invalidpointer operation.

Kod okna:

unit Settings;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, InheritedForm, Vcl.StdCtrls, intfPlugins,
  JvExControls, JvGradientHeaderPanel, Vcl.ExtCtrls, Vcl.ComCtrls, VirtualTrees;

type
  TfrmSettings = class(TfrmInherited, IPlugsApplication)
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    VST: TVirtualStringTree;
    PageControl1: TPageControl;
    TabSheet2: TTabSheet;
    Label1: TLabel;
    procedure VSTGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
      Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
    procedure VSTGetNodeDataSize(Sender: TBaseVirtualTree;
      var NodeDataSize: Integer);
    procedure VSTPaintText(Sender: TBaseVirtualTree;
      const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
      TextType: TVSTTextType);
    procedure Button1Click(Sender: TObject);
    procedure VSTCollapsing(Sender: TBaseVirtualTree; Node: PVirtualNode;
      var Allowed: Boolean);
    procedure VSTFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure VSTFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode;
      Column: TColumnIndex);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    procedure ShowPage(ANode: PVirtualNode);
    procedure BuildTree;
    //IPlugsApplication
    function ChangeColor(NewColor: TColorRef): HResult; stdcall;
    function GetHandle(out hwnd: HWND): HResult; stdcall;
  public
    { Public declarations }
  end;

type
  PMenu = ^TMenu;
  TMenu = record
    Caption: string;
    IsPlugin: Boolean;
  end;

var
  frmSettings: TfrmSettings;

implementation

uses intfPluginManager, intfLicenseManager, implLicenseManager;

{$R *.dfm}

procedure TfrmSettings.BuildTree;
var
  Node, Child: PVirtualNode;
  Data, ChildData: PMenu;
  i: Integer;
  Plugin: TPlugs;
begin
  VST.BeginUpdate;
  Node := VST.AddChild(nil);
  Data := VST.GetNodeData(Node);
  Data.Caption := 'Moduły';
  Data.IsPlugin := False;


  for i := 0 to PluginManager.Plugins.Count -1 do
  begin
    Plugin := TPlugs(PluginManager.Plugins.Objects[i]);

    if LicenseManager.PluginAvailable(Plugin.CLSID) then
    begin
      Child := VST.AddChild(Node);
      ChildData := VST.GetNodeData(Child);


      ChildData.Caption := Plugin.Name;
      ChildData.IsPlugin := True;

      if not Plugin.Loaded then
        PluginManager.LoadPlugin(ChildData.Caption, PageControl1, self);
    end;

  end;

  for i := 0 to PageControl1.PageCount -1 do
    PageControl1.Pages[i].TabVisible := False;

  ShowPage(VST.GetFirst());

  VST.EndUpdate;
  VST.FullExpand();
end;

procedure TfrmSettings.Button1Click(Sender: TObject);
begin
  Close;
end;

function TfrmSettings.ChangeColor(NewColor: TColorRef): HResult;
begin
//
end;

procedure TfrmSettings.FormClose(Sender: TObject; var Action: TCloseAction);
var
  Node: PVirtualNode;
  Data: PMenu;
begin
  inherited;

  Node := VST.GetFirst();
  while Assigned(Node) do
  begin
    Data := VST.GetNodeData(Node);

    if Data.IsPlugin then
      PluginManager.UnloadPlugin(Data.Caption);

    Node := VST.GetNext(Node);
  end;
  VST.Clear;
end;

procedure TfrmSettings.FormCreate(Sender: TObject);
begin
  inherited;
  BuildTree;
end;

function TfrmSettings.GetHandle(out hwnd: HWND): HResult;
begin
//
end;

procedure TfrmSettings.ShowPage(ANode: PVirtualNode);
var
  Data: PMenu;
  i: Integer;
begin
  Data := VST.GetNodeData(ANode);

  VST.FocusedNode := ANode;
  VST.Selected[ANode] := True;

  for i := 0 to PageControl1.PageCount -1 do
    if PageControl1.Pages[i].Caption = Data.Caption then
    begin
      PageControl1.ActivePage := PageControl1.Pages[i];
      Break;
    end;
end;

procedure TfrmSettings.VSTCollapsing(Sender: TBaseVirtualTree;
  Node: PVirtualNode; var Allowed: Boolean);
begin
  Allowed := False;
end;

procedure TfrmSettings.VSTFocusChanged(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex);
begin
  if Assigned(Node) then
    ShowPage(Node);
end;

procedure TfrmSettings.VSTFreeNode(Sender: TBaseVirtualTree;
  Node: PVirtualNode);
var
  Data: PMenu;
begin
  Data := VST.GetNodeData(Node);

  if not Assigned(Data) then
    exit;

  Data.Caption := '';
end;

procedure TfrmSettings.VSTGetNodeDataSize(Sender: TBaseVirtualTree;
  var NodeDataSize: Integer);
begin
  NodeDataSize := SizeOf(PMenu);
end;

procedure TfrmSettings.VSTGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
  Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
var
  Data: PMenu;
begin
  Data := VST.GetNodeData(Node);

  CellText := Data.Caption;
end;

procedure TfrmSettings.VSTPaintText(Sender: TBaseVirtualTree;
  const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
  TextType: TVSTTextType);
begin
  case VST.GetNodeLevel(Node) of
    0:
      begin
        TargetCanvas.Font.Style := [TFontStyle.fsBold];
      end;

    1:
      begin

      end;
  end;
end;

end.

Po kliknięciu Break przy Invalid pointer operation przenosi mnie do unitu widocznego na screenie Pointer1

Nie mam pojęcia co może być przyczyną... Podejrzewam, że coś z pamięcią...

0

Dodam, że jak wyremuję ciało procedury Build Tree - to problem znika.
Co dziwne, w przypadku, gdy uda się otworzyć okno bez Accessa, to w oknie rodzica, po najechaniu kursorem na komponent TJVGradientHeader, pojawia się Access. Oczywiście accessa nie ma jeżeli wcześniej nie otworzę okna z ustawieniami... Magia.

W zalaczniku callstack Accessa po otwarciu okienka

1

na pewno błąd masz tu
NodeDataSize := SizeOf(PMenu);
powinno być
NodeDataSize := SizeOf(TMenu);

ale czy to rozwiąże sprawę to nie mam pojęcia bo takie błędy tylko patrząc na kod ciężko znaleźć

0

@abrakadaber: Miałeś rację! Działa! Nie wiem czemu podałem wskaźnik zamiast obiektu... tyle czasu szukałem błędu tam gdzie nie trzeba. Wielkie dzięki!

1 użytkowników online, w tym zalogowanych: 0, gości: 1