Przeglądaj źródła

* Allow to set wasihost class so it does not need to be overridden

Michael Van Canneyt 4 miesięcy temu
rodzic
commit
7424292767
1 zmienionych plików z 14 dodań i 1 usunięć
  1. 14 1
      packages/wasi/src/wasihostapp.pas

+ 14 - 1
packages/wasi/src/wasihostapp.pas

@@ -18,6 +18,8 @@ Type
   { TBrowserWASIHostApplication }
 
   TBrowserWASIHostApplication = class(TBrowserApplication)
+  private
+    class var _WasiHostClass: TWASIHostClass;
   private
     FHost : TWASIHost;
     FPredefinedConsoleInput: TStrings;
@@ -44,6 +46,7 @@ Type
   public
     Constructor Create(aOwner : TComponent); override;
     Destructor Destroy; override;
+    class procedure SetWasiHostClass(aClass: TWASIHostClass);
     function PreLoadFiles(aFiles : Array of string) : TPreLoadFilesResult; async;
     function PreLoadFiles(aFiles : TPreLoadFileDynArray) : TPreLoadFilesResult; async;
     function PreLoadFilesIntoDirectory(aDirectory: String; aFiles: array of string): TPreLoadFilesResult; async;
@@ -172,8 +175,13 @@ end;
 
 function TBrowserWASIHostApplication.CreateHost : TWASIHost;
 
+var
+  C : TWasiHostClass;
 begin
-  Result:=TWASIHost.Create(Self);
+  C:=_WasiHostClass;
+  if C=Nil then
+    C:=TWasiHost;
+  Result:=C.Create(Self);
 end;
 
 constructor TBrowserWASIHostApplication.Create(aOwner: TComponent);
@@ -188,6 +196,11 @@ begin
   inherited Destroy;
 end;
 
+class procedure TBrowserWASIHostApplication.SetWasiHostClass(aClass: TWASIHostClass);
+begin
+  _WasiHostClass:=aClass;
+end;
+
 function TBrowserWASIHostApplication.PreLoadFiles(aFiles: array of string): TPreLoadFilesResult;
 
 begin