|
- unit uvkuSurfaceFactory;
-
- {$mode objfpc}{$H+}
- {$I Vulkan.inc}
-
- interface
-
- uses
- Classes, SysUtils, Controls,
- Vulkan, uvkuSurface, uvkuFactoryBase;
-
- type
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TvkuSurfaceFactory = class(TvkuInstanceObjFactory)
- {$IF DEFINED(VK_USE_PLATFORM_WIN32_KHR)}
- private
- fHInstance: Vulkan.HINSTANCE;
- fHwnd: Vulkan.HWND;
- procedure SetHwnd(const aValue: Vulkan.HWND);
- public
- property HInstance: Vulkan.HINSTANCE read fHInstance write fHInstance;
- property Hwnd: Vulkan.HWND read fHwnd write SetHwnd;
-
- function GetStructure: TVkWin32SurfaceCreateInfoKHR;
- procedure SetStructure(const aData: TVkWin32SurfaceCreateInfoKHR);
- {$ENDIF}
-
- private
- fFlags: VkFlags;
- fWinControl: TWinControl;
- procedure SetWinControl(aValue: TWinControl);
- public
- property WinControl: TWinControl read fWinControl write SetWinControl;
- property Flags: VkFlags read fFlags write fFlags;
-
- function CreateSurface: TvkuSurface;
-
- procedure AfterConstruction; override;
- end;
-
- implementation
-
- {$IF DEFINED(VK_USE_PLATFORM_WIN32_KHR)}
- uses Windows;
- {$ENDIF}
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TvkuSurfaceFactory/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- {$IF DEFINED(VK_USE_PLATFORM_WIN32_KHR)}
- procedure TvkuSurfaceFactory.SetHwnd(const aValue: Vulkan.HWND);
- begin
- SetWinControl(nil);
- fHwnd := aValue;
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TvkuSurfaceFactory.GetStructure: TVkWin32SurfaceCreateInfoKHR;
- begin
- FillByte(result, SizeOf(result), 0);
- result.sType := VK_STRUCTURE_TYPE_WIN32_SURFACE_CREATE_INFO_KHR;
- result.pNext := nil;
- result.flags := fFlags;
- result.hinstance := fHInstance;
- result.hwnd := fHwnd;
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TvkuSurfaceFactory.SetStructure(const aData: TVkWin32SurfaceCreateInfoKHR);
- begin
- fFlags := aData.flags;
- fHInstance := aData.hinstance;
- fHwnd := aData.hwnd;
- end;
- {$ENDIF}
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TvkuSurfaceFactory.SetWinControl(aValue: TWinControl);
- begin
- if fWinControl = aValue then
- exit;
- fWinControl := aValue;
- {$IF DEFINED(VK_USE_PLATFORM_WIN32_KHR)}
- fHwnd := Vulkan.HWND(fWinControl.Handle);
- {$ELSE}
- {$ERROR 'unknown or unsupported system'}
- {$ENDIF}
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TvkuSurfaceFactory.CreateSurface: TvkuSurface;
- begin
- result := TvkuSurface.Create(GetStructure, InstanceCommands, AllocCallbacks);
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TvkuSurfaceFactory.AfterConstruction;
- begin
- inherited AfterConstruction;
- {$IF DEFINED(VK_USE_PLATFORM_WIN32_KHR)}
- fHInstance := Vulkan.HINSTANCE(GetModuleHandle(nil));
- {$ENDIF}
- fFlags := 0;
- end;
-
- end.
-
|