unit XData.Wizard.Vcl;

interface

uses
  ToolsAPI, TMS.ServerWizard.Application, PlatformApi;

type
  TTMSXDataVclApplicationWizard = class(TTMSBCLCustomApplicationWizard)
  strict protected
    procedure Execute; override;
    function GetComment: string; override;
    function GetDefaultPage: string; override;
    function GetFrameworkTypes: TArray<string>; override;
    function GetGlyph: Cardinal; override;
    function GetIDString: string; override;
    function GetName: string; override;
    function GetPlatforms: TArray<string>; override;
  end;

  TTMSVclProjectCreator = class(TTMSBCLCustomProjectCreator)
  strict protected
    function GetCreatorType: string; override;
    function GetFrameworkType: string; override;
    function GetPlatforms: TArray<string>; override;
    function GetPreferredPlatform: string; override;
    procedure NewDefaultProjectModule(const AProject: IOTAProject); override;
    function NewProjectSource(const AProjectName: string): IOTAFile; override;
  end;

  TTMSXDataVclUnitCreator = class(TTMSBCLCustomUnitCreator)
  strict private
    FServerUnitIdent: string;
  strict protected
    function GetAncestorName: string; override;
    function NewFormFile(const AFormIdent, AAncestorIdent: string): IOTAFile; override;
    function NewImplSource(const AModuleIdent, AFormIdent, AAncestorIdent: string): IOTAFile; override;
  public
    constructor Create(const AOwner: IOTAModule; const AUnitIdent, AClassName, AFileName: string; const AIsMainForm: Boolean; const AServerUnitIdent: string);
  end;

  TTMSXDataModuleUnitCreator = class(TTMSBCLCustomUnitCreator)
  strict protected
    function GetAncestorName: string; override;
    function NewFormFile(const AFormIdent, AAncestorIdent: string): IOTAFile; override;
    function NewImplSource(const AModuleIdent, AFormIdent, AAncestorIdent: string): IOTAFile; override;
  end;

  TTMSXDataVclUnitFile = class(TTMSBCLBaseUnitFile)
  strict private
    FServerModuleUnit: string;
  strict protected
    function InternalGetSource(const ACode: string): string; override;
  public
    constructor Create(const AModuleName, AResName, AServerModuleUnit: string; const ALibHandle: HINST);
  end;

implementation

uses
  System.SysUtils, System.Classes, System.IOUtils, Winapi.Windows,
  Vcl.Forms, XData.Resource;

{ TTMSXDataVclApplicationWizard }

procedure TTMSXDataVclApplicationWizard.Execute;
const
  cFormPrefix = 'TForm';
  cUnitPrefix = 'Unit';
var
{$IF COMPILERVERSION > 31}
  lCreator: IOTAProjectCreator190;
{$ELSE}
  lCreator: IOTAProjectCreator160;
{$IFEND}
  lProjectDir: string;
  lProjectName: string;
  lUnitIdent: string;
  lClassName: string;
  lFileName: string;
  lModuleServices: IOTAModuleServices;
//  lAutoCreate: Variant;
  lProject: IOTAModule;
begin
  if Supports(BorlandIDEServices, IOTAModuleServices, lModuleServices) then
  begin
//    lAutoCreate := StartAutoCreateForms;
    try
      lModuleServices.GetNewModuleAndClassName('', lUnitIdent, lClassName, lFileName);
      lProjectDir := TPath.GetDirectoryName(lFileName);
      lProjectName := FindNewProjectName(TTMSBCLUtility.GetActiveProjectGroup, lProjectDir);
      lClassName := cFormPrefix + Copy(lUnitIdent, Length(cUnitPrefix) + 1, MaxInt);

      lCreator := TTMSVclProjectCreator.Create(lProjectName, lProjectDir, lUnitIdent, lClassName, lFileName);
      lProject := lModuleServices.CreateModule(lCreator);
    finally
//      StopAutoCreateForms(lAutoCreate);
    end;
  end;
end;

function TTMSXDataVclApplicationWizard.GetComment: string;
begin
  Result := TMSWebXDataIDEResources.SNewXDataVclServer;
end;

function TTMSXDataVclApplicationWizard.GetDefaultPage: string;
const
  cDefaultPage = 'TMS XData';
begin
  Result := cDefaultPage;
end;

function TTMSXDataVclApplicationWizard.GetFrameworkTypes: TArray<string>;
begin
  Result := TArray<string>.Create(sFrameworkTypeVCL);
end;

function TTMSXDataVclApplicationWizard.GetGlyph: Cardinal;
const
  cIconName = 'XDATAWIZARDSERVERVCLICON';
begin
  Result := LoadIcon(HInstance, MakeIntResource(cIconName));
end;

function TTMSXDataVclApplicationWizard.GetIDString: string;
const
  cIdString = 'TMS.XData.Server.Vcl';
begin
  Result := cIdString;
end;

function TTMSXDataVclApplicationWizard.GetName: string;
begin
  Result := TMSWebXDataIDEResources.SXDataVclServer;
end;

function TTMSXDataVclApplicationWizard.GetPlatforms: TArray<string>;
begin
  Result := TArray<string>.Create(cWin32Platform, cWin64Platform);
end;

{ TTMSVclProjectCreator }

function TTMSVclProjectCreator.GetCreatorType: string;
begin
  Result := sApplication;
end;

function TTMSVclProjectCreator.GetFrameworkType: string;
begin
  Result := sFrameworkTypeVCL;
end;

function TTMSVclProjectCreator.GetPlatforms: TArray<string>;
begin
  Result := TArray<string>.Create(cWin32Platform, cWin64Platform);
end;

function TTMSVclProjectCreator.GetPreferredPlatform: string;
begin
  Result := cWin32Platform;
end;

procedure TTMSVclProjectCreator.NewDefaultProjectModule(const AProject: IOTAProject);
var
  lModuleServices: IOTAModuleServices;
  lDataModuleUnit: string;
  lFormUnit: string;
  lModuleFile: string;
  lModuleClass: string;
begin
  if Supports(BorlandIDEServices, IOTAModuleServices, lModuleServices) then
  begin
    lModuleServices.GetNewModuleAndClassName('', lDataModuleUnit, lModuleClass, lModuleFile);
    lModuleServices.CreateModule(TTMSXDataModuleUnitCreator.Create(AProject, lDataModuleUnit, lModuleClass, lModuleFile, False));
    lModuleServices.GetNewModuleAndClassName('', lFormUnit, lModuleClass, lModuleFile);
    lModuleServices.CreateModule(TTMSXDataVclUnitCreator.Create(AProject, lFormUnit, lModuleClass, lModuleFile, False, lDataModuleUnit));
  end;
end;

function TTMSVclProjectCreator.NewProjectSource(const AProjectName: string): IOTAFile;
const
  cResName = 'XDATAVCLPROJECT';
begin
  Result := TTMSBCLBaseProjectFile.Create(AProjectName, cResName, HInstance);
end;

{ TTMSXDataVclUnitCreator }

constructor TTMSXDataVclUnitCreator.Create(const AOwner: IOTAModule; const AUnitIdent, AClassName, AFileName: string; const AIsMainForm: Boolean; const AServerUnitIdent: string);
begin
  inherited Create(AOwner, AUnitIdent, AClassName, AFileName, AIsMainForm);
  FServerUnitIdent := AServerUnitIdent;
end;

function TTMSXDataVclUnitCreator.GetAncestorName: string;
begin
  Result := TForm.ClassName;
end;

function TTMSXDataVclUnitCreator.NewFormFile(const AFormIdent, AAncestorIdent: string): IOTAFile;
const
  cResName = 'XDATAVCLDFM';
begin
  Result := TTMSBCLBaseFormFile.Create(cResName, HInstance);
end;

function TTMSXDataVclUnitCreator.NewImplSource(const AModuleIdent, AFormIdent, AAncestorIdent: string): IOTAFile;
const
  cResName = 'XDATAVCLFORM';
begin
  Result := TTMSXDataVclUnitFile.Create(AModuleIdent, cResName, FServerUnitIdent, HInstance);
end;

{ TTMSXDataModuleUnitCreator }

function TTMSXDataModuleUnitCreator.GetAncestorName: string;
begin
  Result := TDataModule.ClassName;
end;

function TTMSXDataModuleUnitCreator.NewFormFile(const AFormIdent, AAncestorIdent: string): IOTAFile;
const
  cResName = 'XDATAXDATADFM';
begin
  Result := TTMSBCLBaseFormFile.Create(cResName, HInstance);
end;

function TTMSXDataModuleUnitCreator.NewImplSource(const AModuleIdent, AFormIdent, AAncestorIdent: string): IOTAFile;
const
  cResName = 'XDATAXDATAMODULE';
begin
  Result := TTMSBCLBaseUnitFile.Create(AModuleIdent, cResName, HInstance);
end;

{ TTMSXDataVclUnitFile }

constructor TTMSXDataVclUnitFile.Create(const AModuleName, AResName, AServerModuleUnit: string; const ALibHandle: HINST);
begin
  inherited Create(AModuleName, AResName, ALibHandle);
  FServerModuleUnit := AServerModuleUnit;
end;

function TTMSXDataVclUnitFile.InternalGetSource(const ACode: string): string;
const
  cOriginalModuleUnit = 'ServerContainerUnit';
begin
  Result := inherited InternalGetSource(ACode);
  Result := StringReplace(Result, cOriginalModuleUnit, FServerModuleUnit, [rfIgnoreCase]);
end;

end.
