david
2824855ea7
- Recompilación en Delphi10 de todos los paquetes de RO para generar las DCU's en Lib\D10 - Recompilación en Delphi10 de todos los paquetes de DA para generar las DCU's en Lib\D10 git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@9 b6239004-a887-0f4b-9937-50029ccdca16
643 lines
20 KiB
ObjectPascal
643 lines
20 KiB
ObjectPascal
unit uROIDEPrjWizard;
|
|
|
|
{----------------------------------------------------------------------------}
|
|
{ RemObjects SDK Library - Delphi IDE Integration
|
|
{
|
|
{ compiler: Delphi 5 and up
|
|
{ platform: Win32
|
|
{
|
|
{ (c)opyright RemObjects Software. all rights reserved.
|
|
{
|
|
{ Using this code requires a valid license of the RemObjects SDK
|
|
{ which can be obtained at http://www.remobjects.com.
|
|
{----------------------------------------------------------------------------}
|
|
|
|
{$IFDEF LINUX}
|
|
{$I RemObjects.inc}
|
|
{$ELSE}
|
|
{$I RemObjects.inc}
|
|
{$ENDIF}
|
|
interface
|
|
|
|
uses Windows, SysUtils,
|
|
{$IFDEF KYLIX1UP}DesignEditors, DesignIntf, {$ELSE}
|
|
{$IFDEF DELPHI6UP}DesignEditors, DesignIntf, {$ELSE}DsgnIntf, {$ENDIF}{$ENDIF}
|
|
ToolsApi, Graphics;
|
|
|
|
const
|
|
IconName = 'Icon.ico';
|
|
InfoName = 'Info.ini';
|
|
|
|
sect_Information = 'Information';
|
|
sect_ClassFactories = 'Class Factories';
|
|
sect_ProjectGeneration = 'Project Generation';
|
|
sect_ProjectFolderHistory = 'Project Folder History';
|
|
|
|
id_Name = 'Name';
|
|
id_Description = 'Description';
|
|
{$IFDEF LINUX}
|
|
id_MinVersion = 'KylixMinimumVersion';
|
|
{$ELSE}
|
|
id_MinVersion = 'MinimumVersion';
|
|
{$ENDIF}
|
|
id_MaxVersion = 'MaximumVersion';
|
|
id_InvalidServers = 'InvalidServers';
|
|
id_DefaultServer = 'DefaultServer';
|
|
id_FixedChannel = 'FixedChannel';
|
|
id_FixedServer = 'FixedServer';
|
|
|
|
id_SvcLibName = 'SvcLibName';
|
|
id_SvcName = 'SvcName';
|
|
id_PrjName = 'PrjName';
|
|
id_PrjDir = 'PrjDir';
|
|
id_cbSvcInstantMode = 'cbSvcInstantMode';
|
|
id_CreateClientAndGroup = 'CreateClientAndGroup';
|
|
|
|
id_WizardType = 'Wizard';
|
|
|
|
DelphiModules: array[0..8] of string =
|
|
('.dpr', '.pas', '.rodl', '.xml', '.dfm', '.xfm', '.bpg', '.bdsproj', '.bdsgroup');
|
|
|
|
type { TROIDEProjectOptions }
|
|
TROIDEProjectOptions = record
|
|
TemplateDir,
|
|
ServiceLibraryName,
|
|
ServiceName,
|
|
ProjectDir,
|
|
ProjectName,
|
|
ServerClassName,
|
|
ServerUnitName,
|
|
ChannelClassName,
|
|
ChannelUnitName,
|
|
MessageClassName,
|
|
MessageUnitName: string;
|
|
CreateClientAndGroup: boolean;
|
|
WizardEnabled: boolean;
|
|
end;
|
|
|
|
TROIDENewProjectInfo = record
|
|
Wizard: string;
|
|
ServerProject,ClientProject: IOTAProject;
|
|
ProjectOptions: TROIDEProjectOptions;
|
|
TemplateFolder: string;
|
|
TemplateName: string;
|
|
end;
|
|
TNewProjectEvent = procedure(aNewProjectInfo: TROIDENewProjectInfo);
|
|
|
|
{ TROProjectWizard }
|
|
TROProjectWizard = class(TNotifierObject,
|
|
IOTAWizard,
|
|
IOTARepositoryWizard,
|
|
{$IFDEF BDS}
|
|
IOTARepositoryWizard80,
|
|
{$ENDIF}
|
|
IOTAProjectWizard)
|
|
private
|
|
fTemplateDir,
|
|
fComment,
|
|
fName,
|
|
fPage: string;
|
|
{$IFDEF BDS}
|
|
fCategory: IOTAGalleryCategory;
|
|
{$ENDIF}
|
|
procedure CreateProject(const someProjectOptions: TROIDEProjectOptions;
|
|
const ScanExtensions: array of string);
|
|
function ReplaceCtrlStrings(const someText: string;
|
|
const someProjectOptions: TROIDEProjectOptions): string;
|
|
|
|
protected
|
|
{ support for IOTAWizard }
|
|
function GetIDString: string;
|
|
function GetName: string;
|
|
function GetState: TWizardState;
|
|
procedure Execute;
|
|
{ support for IOTARepositoryWizard }
|
|
function GetAuthor: string;
|
|
function GetComment: string;
|
|
function GetPage: string;
|
|
{$IFDEF KYLIX1UP}
|
|
function GetGlyph: Cardinal;
|
|
{$ELSE}
|
|
{$IFDEF DELPHI6UP}
|
|
function GetGlyph: Cardinal;
|
|
{$ELSE}
|
|
function GetGlyph: HIcon;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
{$IFDEF BDS}
|
|
function GetDesigner: string;
|
|
function GetGalleryCategory: IOTAGalleryCategory;
|
|
function GetPersonality: string;
|
|
{$ENDIF}
|
|
|
|
public
|
|
{$IFDEF xBDS}
|
|
constructor Create(const aTemplateDir, aName, aComment: string; aCategory: IOTAGalleryCategory);
|
|
{$ELSE}
|
|
constructor Create(const aTemplateDir, aName, aComment: string; aCategory: string);
|
|
{$ENDIF}
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
procedure Register;
|
|
procedure RunGuideWizard(aNewProjectInfo: TROIDENewProjectInfo);
|
|
procedure RegisterGuideWizard(aOnNewProject: TNewProjectEvent);
|
|
procedure UnregisterGuideWizard(aOnNewProject: TNewProjectEvent);
|
|
|
|
implementation
|
|
|
|
uses ComObj, Classes, Dialogs, Forms, Controls, uRORes, uRODL, uRODLGenTools, INIFiles, {$IFDEF LINUX}fNewProjectForm{$ELSE}fNewProjectForm{$ENDIF},
|
|
Menus, uROIDETools, uROClasses, Registry {$IFDEF DELPHI5}, FileCtrl{$ENDIF},
|
|
Contnrs;
|
|
|
|
procedure Register;
|
|
var
|
|
dirinfo: TSearchRec;
|
|
templdirname,
|
|
templname,
|
|
templcomment: string;
|
|
ini: TIniFile;
|
|
tmpcnt: integer;
|
|
thisver, minver, maxver: integer;
|
|
lTemplateDir: string;
|
|
{$IFDEF xBDS}
|
|
lGalleryManager: IOTAGalleryCategoryManager;
|
|
lRODelphiCategory: IOTAGalleryCategory;
|
|
lDADelphiCategory: IOTAGalleryCategory;
|
|
lWizardService: IOTAWizardServices;
|
|
{$ENDIF}
|
|
|
|
procedure ProcessTemplates(aTemplateFolder: string; aCategory: {$IFDEF xBDS}IOTAGalleryCategory{$ELSE}string{$ENDIF});
|
|
begin
|
|
if (FindFirst(IncludeTrailingPathDelimiter(aTemplateFolder) + {$IFDEF LINUX} '*'{$ELSE} '*.*'{$ENDIF}, faDirectory, dirinfo) = 0) then try
|
|
repeat
|
|
ini := nil;
|
|
|
|
try
|
|
if (dirinfo.Attr and faDirectory = 0) or
|
|
(Pos('.', dirinfo.Name) = 1) or
|
|
(Pos('_', dirinfo.Name) = 1) then Continue;
|
|
|
|
templdirname := IncludeTrailingBackslash(IncludeTrailingBackslash(aTemplateFolder) + dirinfo.Name);
|
|
if not FileExists(templdirname + InfoName) then Continue;
|
|
|
|
ini := TIniFile.Create(templdirname + InfoName);
|
|
minver := ini.ReadInteger(sect_Information, id_MinVersion, {$IFDEF LINUX}10{$ELSE}5{$ENDIF});
|
|
maxver := ini.ReadInteger(sect_Information, id_MaxVersion, 1000);
|
|
templname := ini.ReadString(sect_Information, id_Name, '???');
|
|
templcomment := ini.ReadString(sect_Information, id_Description, '???');
|
|
|
|
if thisver < minver then Continue;
|
|
if thisver > maxver then Continue;
|
|
|
|
{$IFDEF xBDS}
|
|
lWizardService.AddWizard(TROProjectWizard.Create(templdirname, templname, templcomment, aCategory) as IOTAProjectWizard);
|
|
{$ELSE}
|
|
RegisterPackageWizard(TROProjectWizard.Create(templdirname, templname, templcomment, aCategory) as IOTAProjectWizard);
|
|
{$ENDIF}
|
|
Inc(tmpcnt);
|
|
|
|
finally
|
|
ini.Free;
|
|
end;
|
|
|
|
until (FindNext(dirinfo) <> 0);
|
|
finally
|
|
FindClose(dirinfo);
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
{$IFDEF DELPHI5}
|
|
thisver := 5;
|
|
{$ENDIF}
|
|
{$IFDEF DELPHI6}
|
|
thisver := 6;
|
|
{$ENDIF}
|
|
{$IFDEF DELPHI7}
|
|
thisver := 7;
|
|
{$ENDIF}
|
|
{$IFDEF DELPHI9}
|
|
thisver := 9;
|
|
{$ENDIF}
|
|
{$IFDEF DELPHI10}
|
|
thisver := 10;
|
|
{$ENDIF}
|
|
|
|
lTemplateDir := IncludeTrailingPathDelimiter(GetTemplateDir);
|
|
|
|
tmpcnt := 0;
|
|
|
|
{$IFDEF xBDS}
|
|
{lWizardService := Services as IOTAWizardServices;
|
|
lGalleryManager := Services as IOTAGalleryCategoryManager;
|
|
|
|
if DirectoryExists(lTemplateDir+'RO') then begin
|
|
lRODelphiCategory := lGalleryManager.AddCategory(nil, 'RemObjectsSdkDelphi', 'RemObjects SDK for Delphi', 0);
|
|
ProcessTemplates(lTemplateDir+'RO', lRODelphiCategory);
|
|
end;
|
|
if DirectoryExists(lTemplateDir+'DA') then begin
|
|
lDADelphiCategory := lGalleryManager.AddCategory(nil, 'RemObjectsDataAbstractDelphi', 'RemObjects Data Abstract for Delphi', 0);
|
|
ProcessTemplates(lTemplateDir+'DA', lDADelphiCategory);
|
|
end;}
|
|
{$ELSE}
|
|
if DirectoryExists(lTemplateDir+'RO') then begin
|
|
ProcessTemplates(lTemplateDir+'RO','RemObjects SDK');
|
|
end;
|
|
if DirectoryExists(lTemplateDir+'DA') then begin
|
|
ProcessTemplates(lTemplateDir+'DA', 'RemObjects Data Abstract');
|
|
end;
|
|
{$ENDIF}
|
|
|
|
// Status message just in case
|
|
if (tmpcnt = 0) then
|
|
MessageDlg('No RemObject server templates were found under ' + GetTemplateDir, mtWarning, [mbOK], 0)
|
|
end;
|
|
|
|
{ TROProjectWizard }
|
|
|
|
{$IFDEF xBDS}
|
|
constructor TROProjectWizard.Create(const aTemplateDir, aName, aComment: string; aCategory: IOTAGalleryCategory);
|
|
begin
|
|
inherited Create;
|
|
|
|
fName := aName;
|
|
fTemplateDir := aTemplateDir;
|
|
fComment := aComment;
|
|
fCategory := aCategory;
|
|
end;
|
|
{$ELSE}
|
|
constructor TROProjectWizard.Create(const aTemplateDir, aName, aComment: string; aCategory: string);
|
|
begin
|
|
inherited Create;
|
|
|
|
fName := aName;
|
|
fTemplateDir := aTemplateDir;
|
|
fComment := aComment;
|
|
fPage := aCategory;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
destructor TROProjectWizard.Destroy;
|
|
begin
|
|
inherited;
|
|
end;
|
|
|
|
procedure TROProjectWizard.Execute;
|
|
var
|
|
prjopt: TROIDEProjectOptions;
|
|
lNewProjectInfo: TROIDENewProjectInfo;
|
|
i:integer;
|
|
lServices: IOTAModuleServices;
|
|
lProject: IOTAProject;
|
|
begin
|
|
if PromptProjectOptions(fTemplateDir, prjopt) then begin
|
|
CreateProject(prjopt, DelphiModules);
|
|
|
|
with prjopt do begin
|
|
{$IFDEF BDS}
|
|
if FileExists(ProjectDir + ProjectName + 'Group.bdsgroup') and prjopt.CreateClientAndGroup then
|
|
(BorlandIDEServices as IOTAActionServices).OpenProject(ProjectDir + ProjectName + 'Group.bdsgroup', FALSE)
|
|
{$ELSE}
|
|
if FileExists(ProjectDir + ProjectName + 'Group.bpg') and prjopt.CreateClientAndGroup then
|
|
(BorlandIDEServices as IOTAActionServices).OpenProject(ProjectDir + ProjectName + 'Group.bpg', FALSE)
|
|
{$ENDIF}
|
|
|
|
{$IFDEF BDS}
|
|
else if FileExists(ProjectDir + ProjectName + '.bdsproj') then
|
|
(BorlandIDEServices as IOTAActionServices).OpenProject(ProjectDir + ProjectName + '.bdsproj', FALSE)
|
|
{$ELSE}
|
|
else if FileExists(ProjectDir + ProjectName + '.dpr') then
|
|
(BorlandIDEServices as IOTAActionServices).OpenProject(ProjectDir + ProjectName + '.dpr', FALSE)
|
|
{$ENDIF}
|
|
else
|
|
raise Exception.Create('Cannot find RemObjects project');
|
|
|
|
// find projects
|
|
lServices := ModuleServices;
|
|
if not assigned(lServices) then exit;
|
|
for i := 0 to (lServices.ModuleCount - 1) do begin
|
|
if lServices.Modules[i].QueryInterface(IOTAProject, lProject) = S_OK then begin
|
|
if ChangeFileExt(ExtractFileName(lProject.FileName),'') = prjopt.ProjectName then begin
|
|
lNewProjectInfo.ServerProject := lProject;
|
|
end
|
|
else if ChangeFileExt(ExtractFileName(lProject.FileName),'') = prjopt.ProjectName+'Client' then begin
|
|
lNewProjectInfo.ClientProject := lProject;
|
|
end;
|
|
end;
|
|
end;
|
|
if not assigned(lNewProjectInfo.ServerProject) then exit;
|
|
|
|
if WizardEnabled then begin
|
|
with TMemIniFile.Create(IncludeTrailingBackslash(prjopt.TemplateDir)+'Info.ini') do try
|
|
lNewProjectInfo.Wizard := ReadString('Information', 'Wizard', '');
|
|
if lNewProjectInfo.Wizard <> '' then begin
|
|
lNewProjectInfo.TemplateFolder := fTemplateDir;
|
|
lNewProjectInfo.TemplateName := ExtractFileName(ExcludeTrailingPathDelimiter(fTemplateDir));
|
|
lNewProjectInfo.ProjectOptions := prjopt;
|
|
RunGuideWizard(lNewProjectInfo);
|
|
end;
|
|
finally
|
|
Free();
|
|
end;
|
|
end;
|
|
|
|
{if (MessageDlg(
|
|
'Your server project needs to be compiled in order to generate the additional units' + #13 +
|
|
'required for remote invocation. Do you want to do that now?', mtInformation, [mbYes, mbNo], 0) = mrYes) then begin
|
|
CompileProject;
|
|
end;}
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TROProjectWizard.CreateProject(const someProjectOptions: TROIDEProjectOptions; const ScanExtensions: array of string);
|
|
var
|
|
lIgnoreAll: boolean;
|
|
|
|
function CanWriteFile(const aFilename: string): boolean;
|
|
begin
|
|
result := (not FileExists(aFileName)) or lIgnoreAll;
|
|
if not result then begin
|
|
case MessageDlg(Format('File %s already exists. Overwrite?', [aFileName]), mtWarning, [mbYes, mbYesToAll, mbNo, mbCancel], 0) of
|
|
mrYes: result := true;
|
|
mrYesToAll: begin
|
|
result := true;
|
|
lIgnoreAll := true;
|
|
end;
|
|
mrCancel: Abort();
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function CopyTemplateFiles(const SourceDir: string):boolean;
|
|
var
|
|
s, d, templatedir: string;
|
|
dirinfo: TSearchRec;
|
|
sl: TStringList;
|
|
i: integer;
|
|
docopy: boolean;
|
|
begin
|
|
result := true;
|
|
sl := TStringList.Create;
|
|
templatedir := IncludeTrailingBackslash(SourceDir);
|
|
try
|
|
|
|
if (FindFirst(templatedir + '*.*', faArchive, dirinfo) = 0) then try
|
|
ForceDirectories(someProjectOptions.ProjectDir);
|
|
repeat
|
|
if (CompareText(dirinfo.Name, IconName) = 0) or
|
|
(CompareText(dirinfo.Name, InfoName) = 0) then Continue;
|
|
|
|
s := templatedir + dirinfo.Name;
|
|
d := someProjectOptions.ProjectDir + ReplaceCtrlStrings(dirinfo.Name, someProjectOptions);
|
|
|
|
docopy := TRUE;
|
|
for i := 0 to High(ScanExtensions) do
|
|
if (CompareText(ExtractFileExt(dirinfo.Name), ScanExtensions[i]) = 0) then begin
|
|
|
|
if not CanWriteFile(d) then Continue;
|
|
|
|
sl.LoadFromFile(s);
|
|
sl.Text := ReplaceCtrlStrings(sl.Text, someProjectOptions);
|
|
sl.SaveToFile(d);
|
|
|
|
if SameText(ExtractFileExt(s),'.rodl') then result := false;
|
|
|
|
docopy := FALSE;
|
|
Break;
|
|
end;
|
|
|
|
if docopy then begin
|
|
if CanWriteFile(d) then begin
|
|
CopyFile(PChar(s), PChar(d), FALSE);
|
|
{ Make sure copied files are not readonly, which they might be
|
|
if TEMPLATES folder is. }
|
|
SetFileAttributes(PChar(d), FILE_ATTRIBUTE_ARCHIVE);
|
|
end;
|
|
end;
|
|
|
|
until (FindNext(dirinfo) <> 0);
|
|
finally
|
|
FindClose(dirinfo);
|
|
end;
|
|
finally
|
|
sl.Free;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
lNeedsRodl: boolean;
|
|
lClientFolder: string;
|
|
begin
|
|
lNeedsRodl := CopyTemplateFiles(someProjectOptions.TemplateDir);
|
|
if lNeedsRodl then CopyTemplateFiles(GetTemplateDir);
|
|
{$IFDEF BDS}
|
|
CopyTemplateFiles(IncludeTrailingBackslash(GetTemplateDir)+'_BDS\Server');
|
|
{$ENDIF}
|
|
|
|
if someProjectOptions.CreateClientAndGroup then begin
|
|
lClientFolder := IncludeTrailingBackslash(someProjectOptions.TemplateDir)+'_CLIENT';
|
|
if not DirectoryExists(lClientFolder) then
|
|
lClientFolder := IncludeTrailingBackslash(GetTemplateDir)+'_CLIENT';
|
|
CopyTemplateFiles(lClientFolder);
|
|
{$IFDEF BDS}
|
|
CopyTemplateFiles(IncludeTrailingBackslash(GetTemplateDir)+'_BDS\Client');
|
|
{$ENDIF}
|
|
end;
|
|
|
|
end;
|
|
|
|
function GuidReplace(const S, OldPattern: string; Flags: TReplaceFlags): string;
|
|
var
|
|
SearchStr, Patt, NewStr: string;
|
|
Offset: Integer;
|
|
begin
|
|
if rfIgnoreCase in Flags then begin
|
|
SearchStr := UpperCase(S);
|
|
Patt := UpperCase(OldPattern);
|
|
end
|
|
else begin
|
|
SearchStr := S;
|
|
Patt := OldPattern;
|
|
end;
|
|
NewStr := S;
|
|
Result := '';
|
|
while SearchStr <> '' do begin
|
|
Offset := AnsiPos(Patt, SearchStr);
|
|
if Offset = 0 then begin
|
|
Result := Result + NewStr;
|
|
Break;
|
|
end;
|
|
Result := Result + Copy(NewStr, 1, Offset - 1) + NewGuidAsString();
|
|
NewStr := Copy(NewStr, Offset + Length(OldPattern), MaxInt);
|
|
if not (rfReplaceAll in Flags) then begin
|
|
Result := Result + NewStr;
|
|
Break;
|
|
end;
|
|
SearchStr := Copy(SearchStr, Offset + Length(Patt), MaxInt);
|
|
end;
|
|
end;
|
|
|
|
function TROProjectWizard.ReplaceCtrlStrings(const someText: string; const someProjectOptions: TROIDEProjectOptions): string;
|
|
var
|
|
cs: string;
|
|
lRoFolder, lDaFolder:string;
|
|
begin
|
|
cs := UpperCase(someText);
|
|
with TRegistry.Create do try
|
|
RootKey := HKEY_CURRENT_USER;
|
|
OpenKey('\Software\RemObjects\RemObjects SDK for Delphi',false);
|
|
lRoFolder := ReadString('InstallDir');
|
|
OpenKey('\Software\RemObjects\Data Abstract',false);
|
|
lDaFolder := ReadString('InstallDir');
|
|
finally
|
|
Free();
|
|
end;
|
|
if lRoFolder = '' then lRoFolder := ExpandFileName(IncludeTrailingBackslash(GetBinDir)+'..\');
|
|
if lDaFolder = '' then lDaFolder := ExpandFileName(IncludeTrailingBackslash(GetBinDir)+'..\..\Data Abstract\');
|
|
lRoFolder := IncludeTrailingBackslash(lRoFolder);
|
|
lDaFolder := IncludeTrailingBackslash(lDaFolder);
|
|
|
|
result := StringReplace(someText, '$ROFOLDER', lRoFolder , [rfReplaceAll, rfIgnoreCase]);
|
|
result := StringReplace(someText, '$DAFOLDER', lDaFolder , [rfReplaceAll, rfIgnoreCase]);
|
|
result := StringReplace(result, '$PRJNAME', someProjectOptions.ProjectName, [rfReplaceAll, rfIgnoreCase]);
|
|
result := StringReplace(result, '$SVCNAME', someProjectOptions.ServiceName, [rfReplaceAll, rfIgnoreCase]);
|
|
result := StringReplace(result, '$SERVICENAME', someProjectOptions.ServiceName, [rfReplaceAll, rfIgnoreCase]);
|
|
result := StringReplace(result, '$SVCLIBNAME', someProjectOptions.ServiceLibraryName, [rfReplaceAll, rfIgnoreCase]);
|
|
result := StringReplace(result, '$LIBRARYNAME', someProjectOptions.ServiceLibraryName, [rfReplaceAll, rfIgnoreCase]);
|
|
result := GuidReplace(result, '$NEWID', [rfReplaceAll, rfIgnoreCase]);
|
|
result := StringReplace(result, '$MSGCLSNAME', someProjectOptions.MessageClassName, [rfReplaceAll, rfIgnoreCase]);
|
|
result := StringReplace(result, '$MSGCLSNAME', someProjectOptions.MessageClassName, [rfReplaceAll, rfIgnoreCase]);
|
|
result := StringReplace(result, '$SRVCLSNAME', someProjectOptions.ServerClassName, [rfReplaceAll, rfIgnoreCase]);
|
|
result := StringReplace(result, '$CHNCLSNAME', someProjectOptions.ChannelClassName, [rfReplaceAll, rfIgnoreCase]);
|
|
|
|
result := StringReplace(result, '$CHANNELUNIT', someProjectOptions.ChannelUnitName, [rfReplaceAll, rfIgnoreCase]);
|
|
result := StringReplace(result, '$SERVERUNIT', someProjectOptions.ServerUnitName, [rfReplaceAll, rfIgnoreCase]);
|
|
result := StringReplace(result, '$MESSAGEUNIT', someProjectOptions.MessageUnitName, [rfReplaceAll, rfIgnoreCase]);
|
|
end;
|
|
|
|
function TROProjectWizard.GetAuthor: string;
|
|
begin
|
|
Result := str_Author;
|
|
end;
|
|
|
|
function TROProjectWizard.GetComment: string;
|
|
begin
|
|
Result := fComment
|
|
end;
|
|
|
|
{$IFDEF KYLIX1UP}
|
|
|
|
function TROProjectWizard.GetGlyph: Cardinal;
|
|
var
|
|
icon: Graphics.TIcon;
|
|
begin
|
|
if FileExists(fTemplateDir + IconName) then begin
|
|
icon := Graphics.TIcon.Create;
|
|
icon.LoadFromFile(fTemplateDir + IconName);
|
|
result := icon.Handle;
|
|
end
|
|
else
|
|
result := 0;
|
|
end;
|
|
{$ELSE}
|
|
{$IFDEF DELPHI6UP}
|
|
|
|
function TROProjectWizard.GetGlyph: Cardinal;
|
|
var
|
|
icon: TIcon;
|
|
begin
|
|
if FileExists(fTemplateDir + IconName) then begin
|
|
icon := TIcon.Create;
|
|
icon.LoadFromFile(fTemplateDir + IconName);
|
|
result := icon.Handle;
|
|
end
|
|
else
|
|
result := 0;
|
|
end;
|
|
{$ELSE}
|
|
|
|
function TROProjectWizard.GetGlyph: HICON;
|
|
var
|
|
icon: TIcon;
|
|
begin
|
|
if FileExists(fTemplateDir + IconName) then begin
|
|
icon := TIcon.Create;
|
|
icon.LoadFromFile(fTemplateDir + IconName);
|
|
result := icon.Handle;
|
|
end
|
|
else
|
|
result := 0;
|
|
end;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
{$IFDEF BDS}
|
|
function TROProjectWizard.GetDesigner: string;
|
|
begin
|
|
result := '';
|
|
end;
|
|
|
|
function TROProjectWizard.GetGalleryCategory: IOTAGalleryCategory;
|
|
begin
|
|
result := fCategory;
|
|
end;
|
|
|
|
function TROProjectWizard.GetPersonality: string;
|
|
begin
|
|
result := sDelphiPersonality;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
|
|
function TROProjectWizard.GetIDString: string;
|
|
begin
|
|
Result := GUIDToString(NewGUID)
|
|
end;
|
|
|
|
function TROProjectWizard.GetName: string;
|
|
begin
|
|
Result := fName
|
|
end;
|
|
|
|
function TROProjectWizard.GetPage: string;
|
|
begin
|
|
Result := fPage;
|
|
end;
|
|
|
|
function TROProjectWizard.GetState: TWizardState;
|
|
begin
|
|
Result := [];
|
|
end;
|
|
|
|
var
|
|
fGuideWizardList: TList;
|
|
|
|
procedure RunGuideWizard(aNewProjectInfo: TROIDENewProjectInfo);
|
|
var
|
|
i: integer;
|
|
begin
|
|
for i := 0 to fGuideWizardList.Count-1 do
|
|
TNewProjectEvent(fGuideWizardList[i])(aNewProjectInfo);
|
|
end;
|
|
|
|
procedure RegisterGuideWizard(aOnNewProject: TNewProjectEvent);
|
|
begin
|
|
fGuideWizardList.Add(@aOnNewProject);
|
|
end;
|
|
|
|
procedure UnregisterGuideWizard(aOnNewProject: TNewProjectEvent);
|
|
begin
|
|
if assigned(fGuideWizardList) then
|
|
fGuideWizardList.Remove(@aOnNewProject);
|
|
end;
|
|
|
|
initialization
|
|
fGuideWizardList := TList.Create();
|
|
finalization
|
|
FreeAndNil(fGuideWizardList);
|
|
end.
|
|
|