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.