Vulkan/projects/triangle/uMainForm.pas

unit uMainForm;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
  Vulkan, uvkuInstanceEx, uvkuPhysicalDevice, uvkuUtils;

type
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TCustomAllocHandler = class(TvkuAllocationHandler)
  protected
    function AllocateMemory(const aSize: VkSize; const aAlignment: VkSize; const aScope: TVkSystemAllocationScope): PVkVoid; override;
    function ReallocateMemory(const aOriginal: PVkVoid; const aSize: VkSize; const aAlignment: VkSize; const aScope: TVkSystemAllocationScope): PVkVoid; override;
    procedure FreeMemory(const aMemory: PVkVoid); override;
  end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TMainForm = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    fIntance: TvkuInstanceEx;
  public
    { public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.lfm}

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TCustomAllocHandler////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TCustomAllocHandler.AllocateMemory(const aSize: VkSize; const aAlignment: VkSize; const aScope: TVkSystemAllocationScope): PVkVoid;
begin
  result := inherited AllocateMemory(aSize, aAlignment, aScope);
  WriteLn(Format('%d bytes of memory allocated at %p', [ aSize, result ]));
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TCustomAllocHandler.ReallocateMemory(const aOriginal: PVkVoid; const aSize: VkSize; const aAlignment: VkSize; const aScope: TVkSystemAllocationScope): PVkVoid;
var p: PVkVoid;
begin
  p := aOriginal;
  result := inherited ReallocateMemory(aOriginal, aSize, aAlignment, aScope);
  WriteLn(Format('%d bytes of memory (from %p) reallocated at %p', [ aSize, p, result ]));
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TCustomAllocHandler.FreeMemory(const aMemory: PVkVoid);
begin
  WriteLn(Format('free memory at %p', [ aMemory ]));
  inherited FreeMemory(aMemory);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TMainForm//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TMainForm.FormCreate(Sender: TObject);
var
  i: Integer;
  d: TvkuPhysicalDevice;
begin
  WriteLn('create vulkan instance');
  fIntance := TvkuInstanceEx.Create(
    0,
    [],
    [],
    TvkuInstanceEx.DefaultApplicationInfo,
    TvkuAllocationHandler.Create,
    true);

  WriteLn('read vulkan devices:');
  for i := 0 to fIntance.PhysicalDeviceCount-1 do begin
    d := fIntance.PhysicalDevices[i];
    WriteLn(vkuMakeString(d.GetFeatures, ', '));
    WriteLn(vkuMakeString(d.GetProperties, true, true));
    WriteLn(vkuMakeString(d.GetMemoryProperties));
  end;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TMainForm.FormDestroy(Sender: TObject);
begin
  FreeAndNil(fIntance);
end;

end.