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ą...
- Pointer1.png (124 KB) - ściągnięć: 123
- pointer.png (60 KB) - ściągnięć: 101
- access.png (62 KB) - ściągnięć: 103
Delphi 
