paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-16 04:49:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

ideintf, ide: make project resources pluggable

Browse Source 
git-svn-id: trunk@23430 -
This commit is contained in:
paul 2010-01-13 07:05:16 +00:00
parent 3f2cb70256
commit 7145aff4ca
7 changed files with 467 additions and 303 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
ide/frames/project_application_options.pas
View File

@ -7,7 +7,8 @@ interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
ExtCtrls, StdCtrls, Buttons, ComCtrls, ExtDlgs, Math, LCLType, IDEOptionsIntf,
Project, LazarusIDEStrConsts, EnvironmentOpts, ApplicationBundle;
Project, LazarusIDEStrConsts, EnvironmentOpts, ApplicationBundle, ProjectIcon,
W32Manifest;
type
@ -199,8 +200,8 @@ begin
TitleEdit.Text := Title;
TargetFileEdit.Text := TargetFilename;
UseAppBundleCheckBox.Checked := UseAppBundle;
UseXPManifestCheckBox.Checked := Resources.XPManifest.UseManifest;
AStream := Resources.ProjectIcon.GetStream;
UseXPManifestCheckBox.Checked := TProjectXPManifest(Resources[TProjectXPManifest]).UseManifest;
AStream := TProjectIcon(Resources[TProjectIcon]).GetStream;
try
SetIconFromStream(AStream);
finally
@ -218,18 +219,17 @@ begin
Title := TitleEdit.Text;
AStream := GetIconAsStream;
try
Resources.ProjectIcon.SetStream(AStream);
TProjectIcon(Resources[TProjectIcon]).SetStream(AStream);
finally
AStream.Free;
end;
TargetFilename := TargetFileEdit.Text;
UseAppBundle := UseAppBundleCheckBox.Checked;
Resources.XPManifest.UseManifest := UseXPManifestCheckBox.Checked;
TProjectXPManifest(Resources[TProjectXPManifest]).UseManifest := UseXPManifestCheckBox.Checked;
end;
end;
class function TProjectApplicationOptionsFrame.SupportedOptionsClass:
TAbstractIDEOptionsClass;
class function TProjectApplicationOptionsFrame.SupportedOptionsClass: TAbstractIDEOptionsClass;
begin
Result := TProject;
end;

70
ide/frames/project_versioninfo_options.pas
View File

@ -39,7 +39,7 @@ type
procedure AdditionalInfoButtonClick(Sender: TObject);
procedure UseVersionInfoCheckBoxChange(Sender: TObject);
private
FProject: TProject;
FVersionInfo: TProjectVersionInfo;
procedure EnableVersionInfo(UseVersionInfo: boolean);
public
function GetTitle: string; override;
@ -60,7 +60,7 @@ end;
procedure TProjectVersionInfoOptionsFrame.AdditionalInfoButtonClick(Sender: TObject);
begin
ShowVersionInfoAdditionailInfoForm(FProject.Resources.VersionInfo);
ShowVersionInfoAdditionailInfoForm(FVersionInfo);
end;
procedure TProjectVersionInfoOptionsFrame.EnableVersionInfo(UseVersionInfo: boolean);
@ -96,47 +96,43 @@ end;
procedure TProjectVersionInfoOptionsFrame.ReadSettings(AOptions: TAbstractIDEOptions);
begin
FProject := AOptions as TProject;
with FProject do
begin
UseVersionInfoCheckBox.Checked := Resources.VersionInfo.UseVersionInfo;
VersionSpinEdit.Value := Resources.VersionInfo.VersionNr;
MajorRevisionSpinEdit.Value := Resources.VersionInfo.MajorRevNr;
MinorRevisionSpinEdit.Value := Resources.VersionInfo.MinorRevNr;
BuildSpinEdit.Value := Resources.VersionInfo.BuildNr;
FVersionInfo := TProjectVersionInfo((AOptions as TProject).Resources[TProjectVersionInfo]);
EnableVersionInfo(Resources.VersionInfo.UseVersionInfo);
UseVersionInfoCheckBox.Checked := FVersionInfo.UseVersionInfo;
VersionSpinEdit.Value := FVersionInfo.VersionNr;
MajorRevisionSpinEdit.Value := FVersionInfo.MajorRevNr;
MinorRevisionSpinEdit.Value := FVersionInfo.MinorRevNr;
BuildSpinEdit.Value := FVersionInfo.BuildNr;
if Resources.VersionInfo.AutoIncrementBuild then
AutomaticallyIncreaseBuildCheckBox.Checked := True;
LanguageSelectionComboBox.Items.Assign(MSLanguages);
LanguageSelectionComboBox.ItemIndex :=
MSHexLanguages.IndexOf(Resources.VersionInfo.HexLang);
LanguageSelectionComboBox.Sorted := True;
CharacterSetComboBox.Items.Assign(MSCharacterSets);
CharacterSetComboBox.ItemIndex :=
MSHexCharacterSets.IndexOf(Resources.VersionInfo.HexCharSet);
CharacterSetComboBox.Sorted := True;
DescriptionEdit.Text := Resources.VersionInfo.DescriptionString;
CopyrightEdit.Text := Resources.VersionInfo.CopyrightString;
end;
EnableVersionInfo(FVersionInfo.UseVersionInfo);
if FVersionInfo.AutoIncrementBuild then
AutomaticallyIncreaseBuildCheckBox.Checked := True;
LanguageSelectionComboBox.Items.Assign(MSLanguages);
LanguageSelectionComboBox.ItemIndex := MSHexLanguages.IndexOf(FVersionInfo.HexLang);
LanguageSelectionComboBox.Sorted := True;
CharacterSetComboBox.Items.Assign(MSCharacterSets);
CharacterSetComboBox.ItemIndex := MSHexCharacterSets.IndexOf(FVersionInfo.HexCharSet);
CharacterSetComboBox.Sorted := True;
DescriptionEdit.Text := FVersionInfo.DescriptionString;
CopyrightEdit.Text := FVersionInfo.CopyrightString;
end;
procedure TProjectVersionInfoOptionsFrame.WriteSettings(AOptions: TAbstractIDEOptions);
var
VersionInfo: TProjectVersionInfo;
begin
with AOptions as TProject do
begin
Resources.VersionInfo.UseVersionInfo := UseVersionInfoCheckBox.Checked;
Resources.VersionInfo.AutoIncrementBuild := AutomaticallyIncreaseBuildCheckBox.Checked;
Resources.VersionInfo.VersionNr := VersionSpinEdit.Value;
Resources.VersionInfo.MajorRevNr := MajorRevisionSpinEdit.Value;
Resources.VersionInfo.MinorRevNr := MinorRevisionSpinEdit.Value;
Resources.VersionInfo.BuildNr := BuildSpinEdit.Value;
Resources.VersionInfo.DescriptionString := DescriptionEdit.Text;
Resources.VersionInfo.CopyrightString := CopyrightEdit.Text;
Resources.VersionInfo.HexLang := MSLanguageToHex(LanguageSelectionComboBox.Text);
Resources.VersionInfo.HexCharSet := MSCharacterSetToHex(CharacterSetComboBox.Text);
end;
VersionInfo := TProjectVersionInfo((AOptions as TProject).Resources[TProjectVersionInfo]);
VersionInfo.UseVersionInfo := UseVersionInfoCheckBox.Checked;
VersionInfo.AutoIncrementBuild := AutomaticallyIncreaseBuildCheckBox.Checked;
VersionInfo.VersionNr := VersionSpinEdit.Value;
VersionInfo.MajorRevNr := MajorRevisionSpinEdit.Value;
VersionInfo.MinorRevNr := MinorRevisionSpinEdit.Value;
VersionInfo.BuildNr := BuildSpinEdit.Value;
VersionInfo.DescriptionString := DescriptionEdit.Text;
VersionInfo.CopyrightString := CopyrightEdit.Text;
VersionInfo.HexLang := MSLanguageToHex(LanguageSelectionComboBox.Text);
VersionInfo.HexCharSet := MSCharacterSetToHex(CharacterSetComboBox.Text);
end;
class function TProjectVersionInfoOptionsFrame.SupportedOptionsClass: TAbstractIDEOptionsClass;

22
ide/projecticon.pas
View File

@ -35,7 +35,7 @@ interface
uses
Classes, SysUtils, FileUtil, Process, LCLProc, Controls, Forms,
CodeToolManager, LazConf, LResources, resource, groupiconresource,
CodeToolManager, LazConf, Laz_XMLCfg, LResources, resource, groupiconresource,
ProjectIntf, ProjectResourcesIntf;
type
@ -59,6 +59,9 @@ type
function UpdateResources(AResources: TAbstractProjectResources;
const MainFilename: string): Boolean; override;
procedure WriteToProjectFile(AConfig: {TXMLConfig}TObject; Path: String); override;
procedure ReadFromProjectFile(AConfig: {TXMLConfig}TObject; Path: String); override;
function CreateIconFile: Boolean;
property IconData: TIconData read FData write SetIconData;
@ -134,6 +137,20 @@ begin
AResources.AddSystemResource(ARes);
end;
procedure TProjectIcon.WriteToProjectFile(AConfig: TObject; Path: String);
begin
TXMLConfig(AConfig).SetDeleteValue(Path+'General/Icon/Value', BoolToStr(IsEmpty), '-1');
end;
procedure TProjectIcon.ReadFromProjectFile(AConfig: TObject; Path: String);
begin
with TXMLConfig(AConfig) do
begin
IcoFileName := ChangeFileExt(FileName, '.ico');
IsEmpty := StrToBoolDef(GetValue(Path+'General/Icon/Value', '-1'), False);
end;
end;
function TProjectIcon.CreateIconFile: Boolean;
var
FileStream, AStream: TStream;
@ -221,5 +238,8 @@ begin
Result := FData = nil;
end;
initialization
RegisterProjectResource(TProjectIcon);
end.

162
ide/projectresources.pas
View File

@ -37,11 +37,10 @@ unit ProjectResources;
interface
uses
Classes, SysUtils, Controls, LCLProc, LResources, FileUtil, Laz_XMLCfg,
Classes, SysUtils, Contnrs, Controls, LCLProc, LResources, FileUtil, Laz_XMLCfg,
Dialogs, ProjectIntf, ProjectResourcesIntf, LazarusIDEStrConsts, AvgLvlTree,
KeywordFuncLists, BasicCodeTools,
W32VersionInfo, W32Manifest, ProjectIcon, IDEProcs, DialogProcs,
CodeToolManager, CodeCache, resource, reswriter;
KeywordFuncLists, BasicCodeTools, IDEProcs, DialogProcs, CodeToolManager,
CodeCache, resource, reswriter;
type
{ TProjectResources }
@ -53,6 +52,7 @@ type
FInModified: Boolean;
FLrsIncludeAllowed: Boolean;
FResources: TObjectList;
FSystemResources: TResources;
FLazarusResources: TStringList;
@ -61,21 +61,19 @@ type
LastResFilename: String;
LastLrsFileName: String;
FVersionInfo: TProjectVersionInfo;
FXPManifest: TProjectXPManifest;
FProjectIcon: TProjectIcon;
procedure SetFileNames(const MainFileName, TestDir: String);
procedure SetModified(const AValue: Boolean);
procedure EmbeddedObjectModified(Sender: TObject);
function Update: Boolean;
function UpdateMainSourceFile(const AFileName: string): Boolean;
procedure UpdateFlagLrsIncludeAllowed(const AFileName: string);
function Save(SaveToTestDir: string): Boolean;
procedure UpdateCodeBuffers;
procedure DeleteLastCodeBuffers;
procedure OnResourceModified(Sender: TObject);
protected
procedure SetResourceType(const AValue: TResourceType); override;
function GetProjectResource(AIndex: TAbstractProjectResourceClass): TAbstractProjectResource; override;
public
constructor Create(AProject: TLazProject); override;
destructor Destroy; override;
@ -97,10 +95,6 @@ type
procedure WriteToProjectFile(AConfig: TXMLConfig; Path: String);
procedure ReadFromProjectFile(AConfig: TXMLConfig; Path: String);
property VersionInfo: TProjectVersionInfo read FVersionInfo;
property XPManifest: TProjectXPManifest read FXPManifest;
property ProjectIcon: TProjectIcon read FProjectIcon;
property Modified: Boolean read FModified write SetModified;
property OnModified: TNotifyEvent read FOnModified write FOnModified;
end;
@ -321,6 +315,8 @@ begin
end;
procedure TProjectResources.SetModified(const AValue: Boolean);
var
i: integer;
begin
if FInModified then
Exit;
@ -330,9 +326,8 @@ begin
FModified := AValue;
if not FModified then
begin
VersionInfo.Modified := False;
XPManifest.Modified := False;
ProjectIcon.Modified := False;
for i := 0 to FResources.Count - 1 do
TAbstractProjectResource(FResources[i]).Modified := False;
end;
if Assigned(FOnModified) then
OnModified(Self);
@ -341,31 +336,28 @@ begin
end;
function TProjectResources.Update: Boolean;
var
i: integer;
begin
Clear;
// handle versioninfo
Result := VersionInfo.UpdateResources(Self, resFileName);
if not Result then
Exit;
// handle manifest
Result := XPManifest.UpdateResources(Self, resFileName);
if not Result then
Exit;
// handle project icon
Result := ProjectIcon.UpdateResources(Self, resFileName);
for i := 0 to FResources.Count - 1 do
begin
Result := TAbstractProjectResource(FResources[i]).UpdateResources(Self, resFileName);
if not Result then
Exit;
end;
end;
procedure TProjectResources.EmbeddedObjectModified(Sender: TObject);
procedure TProjectResources.OnResourceModified(Sender: TObject);
begin
Modified :=
VersionInfo.Modified or
XPManifest.Modified or
ProjectIcon.Modified;
Modified := Modified or TAbstractProjectResource(Sender).Modified;
end;
constructor TProjectResources.Create(AProject: TLazProject);
var
i: integer;
L: TList;
R: TAbstractProjectResource;
begin
inherited Create(AProject);
@ -375,25 +367,21 @@ begin
FSystemResources := TResources.Create;
FLazarusResources := TStringList.Create;
FVersionInfo := TProjectVersionInfo.Create;
FVersionInfo.OnModified := @EmbeddedObjectModified;
FXPManifest := TProjectXPManifest.Create;
FXPManifest.UseManifest := True;
FXPManifest.OnModified := @EmbeddedObjectModified;
FProjectIcon := TProjectIcon.Create;
FProjectIcon.OnModified := @EmbeddedObjectModified;
FResources := TObjectList.Create;
L := GetRegisteredResources;
for i := 0 to L.Count - 1 do
begin
R := TAbstractProjectResourceClass(L[i]).Create;
R.OnModified := @OnResourceModified;
FResources.Add(R);
end;
end;
destructor TProjectResources.Destroy;
begin
DeleteResourceBuffers;
FreeAndNil(FVersionInfo);
FreeAndNil(FXPManifest);
FreeAndNil(FProjectIcon);
FreeAndNil(FResources);
FreeAndNil(FSystemResources);
FreeAndNil(FLazarusResources);
@ -419,11 +407,25 @@ begin
end;
end;
procedure TProjectResources.DoBeforeBuild(SaveToTestDir: boolean);
function TProjectResources.GetProjectResource(AIndex: TAbstractProjectResourceClass): TAbstractProjectResource;
var
i: integer;
begin
VersionInfo.DoBeforeBuild(Self,SaveToTestDir);
XPManifest.DoBeforeBuild(Self,SaveToTestDir);
ProjectIcon.DoBeforeBuild(Self,SaveToTestDir);
for i := 0 to FResources.Count - 1 do
begin
Result := TAbstractProjectResource(FResources[i]);
if Result.InheritsFrom(AIndex) then
Exit;
end;
Result := nil;
end;
procedure TProjectResources.DoBeforeBuild(SaveToTestDir: boolean);
var
i: integer;
begin
for i := 0 to FResources.Count - 1 do
TAbstractProjectResource(FResources[i]).DoBeforeBuild(Self,SaveToTestDir);
end;
procedure TProjectResources.Clear;
@ -480,61 +482,21 @@ begin
end;
procedure TProjectResources.WriteToProjectFile(AConfig: TXMLConfig; Path: String);
var
i: integer;
begin
// todo: further split by classes
with AConfig do
begin
SetDeleteValue(Path+'General/ResourceType/Value', ResourceTypeNames[ResourceType], ResourceTypeNames[rtLRS]);
SetDeleteValue(Path+'General/Icon/Value', BoolToStr(ProjectIcon.IsEmpty), '-1');
SetDeleteValue(Path+'General/UseXPManifest/Value', XPManifest.UseManifest, False);
SetDeleteValue(Path+'VersionInfo/UseVersionInfo/Value', VersionInfo.UseVersionInfo,false);
SetDeleteValue(Path+'VersionInfo/AutoIncrementBuild/Value', VersionInfo.AutoIncrementBuild,false);
SetDeleteValue(Path+'VersionInfo/CurrentVersionNr/Value', VersionInfo.VersionNr,0);
SetDeleteValue(Path+'VersionInfo/CurrentMajorRevNr/Value', VersionInfo.MajorRevNr,0);
SetDeleteValue(Path+'VersionInfo/CurrentMinorRevNr/Value', VersionInfo.MinorRevNr,0);
SetDeleteValue(Path+'VersionInfo/CurrentBuildNr/Value', VersionInfo.BuildNr,0);
SetDeleteValue(Path+'VersionInfo/ProjectVersion/Value', VersionInfo.ProductVersionString,'1.0.0.0');
SetDeleteValue(Path+'VersionInfo/Language/Value', VersionInfo.HexLang,DefaultLanguage);
SetDeleteValue(Path+'VersionInfo/CharSet/Value', VersionInfo.HexCharSet,DefaultCharset);
SetDeleteValue(Path+'VersionInfo/Comments/Value', VersionInfo.CommentsString,'');
SetDeleteValue(Path+'VersionInfo/CompanyName/Value', VersionInfo.CompanyString,'');
SetDeleteValue(Path+'VersionInfo/FileDescription/Value', VersionInfo.DescriptionString,'');
SetDeleteValue(Path+'VersionInfo/InternalName/Value', VersionInfo.InternalNameString,'');
SetDeleteValue(Path+'VersionInfo/LegalCopyright/Value', VersionInfo.CopyrightString,'');
SetDeleteValue(Path+'VersionInfo/LegalTrademarks/Value', VersionInfo.TrademarksString,'');
SetDeleteValue(Path+'VersionInfo/OriginalFilename/Value', VersionInfo.OriginalFilenameString,'');
SetDeleteValue(Path+'VersionInfo/ProductName/Value', VersionInfo.ProdNameString,'');
end;
AConfig.SetDeleteValue(Path+'General/ResourceType/Value', ResourceTypeNames[ResourceType], ResourceTypeNames[rtLRS]);
for i := 0 to FResources.Count - 1 do
TAbstractProjectResource(FResources[i]).WriteToProjectFile(AConfig, Path);
end;
procedure TProjectResources.ReadFromProjectFile(AConfig: TXMLConfig; Path: String);
var
i: integer;
begin
// todo: further split by classes
with AConfig do
begin
ProjectIcon.IcoFileName := ChangeFileExt(FileName, '.ico');
ResourceType := StrToResourceType(GetValue(Path+'General/ResourceType/Value', ResourceTypeNames[rtLRS]));
ProjectIcon.IsEmpty := StrToBoolDef(GetValue(Path+'General/Icon/Value', '-1'), False);
XPManifest.UseManifest := GetValue(Path+'General/UseXPManifest/Value', False);
VersionInfo.UseVersionInfo := GetValue(Path+'VersionInfo/UseVersionInfo/Value', False);
VersionInfo.AutoIncrementBuild := GetValue(Path+'VersionInfo/AutoIncrementBuild/Value', False);
VersionInfo.VersionNr := GetValue(Path+'VersionInfo/CurrentVersionNr/Value', 0);
VersionInfo.MajorRevNr := GetValue(Path+'VersionInfo/CurrentMajorRevNr/Value', 0);
VersionInfo.MinorRevNr := GetValue(Path+'VersionInfo/CurrentMinorRevNr/Value', 0);
VersionInfo.BuildNr := GetValue(Path+'VersionInfo/CurrentBuildNr/Value', 0);
VersionInfo.ProductVersionString := GetValue(Path+'VersionInfo/ProjectVersion/Value', '1.0.0.0');
VersionInfo.HexLang := GetValue(Path+'VersionInfo/Language/Value', DefaultLanguage);
VersionInfo.HexCharSet := GetValue(Path+'VersionInfo/CharSet/Value', DefaultCharset);
VersionInfo.CommentsString := LineBreaksToSystemLineBreaks(GetValue(Path+'VersionInfo/Comments/Value', ''));
VersionInfo.CompanyString := LineBreaksToSystemLineBreaks(GetValue(Path+'VersionInfo/CompanyName/Value', ''));
VersionInfo.DescriptionString := LineBreaksToSystemLineBreaks(GetValue(Path+'VersionInfo/FileDescription/Value', ''));
VersionInfo.InternalNameString := LineBreaksToSystemLineBreaks(GetValue(Path+'VersionInfo/InternalName/Value', ''));
VersionInfo.CopyrightString := LineBreaksToSystemLineBreaks(GetValue(Path+'VersionInfo/LegalCopyright/Value', ''));
VersionInfo.TrademarksString := LineBreaksToSystemLineBreaks(GetValue(Path+'VersionInfo/LegalTrademarks/Value', ''));
VersionInfo.OriginalFilenameString := GetValue(Path+'VersionInfo/OriginalFilename/Value', '');
VersionInfo.ProdNameString := LineBreaksToSystemLineBreaks(GetValue(Path+'VersionInfo/ProductName/Value', ''));
end;
ResourceType := StrToResourceType(AConfig.GetValue(Path+'General/ResourceType/Value', ResourceTypeNames[rtLRS]));
for i := 0 to FResources.Count - 1 do
TAbstractProjectResource(FResources[i]).ReadFromProjectFile(AConfig, Path);
end;
function TProjectResources.UpdateMainSourceFile(const AFileName: string): Boolean;

24
ide/w32manifest.pas
View File

@ -38,7 +38,7 @@ interface
uses
Classes, SysUtils, FileUtil, Process, LCLProc, Controls, Forms,
CodeToolManager, CodeCache, LazConf, DialogProcs, LResources,
CodeToolManager, CodeCache, LazConf, Laz_XMLCfg, DialogProcs, LResources,
ProjectResourcesIntf, resource;
type
@ -49,7 +49,10 @@ type
FUseManifest: boolean;
procedure SetUseManifest(const AValue: boolean);
public
constructor Create; override;
function UpdateResources(AResources: TAbstractProjectResources; const MainFilename: string): Boolean; override;
procedure WriteToProjectFile(AConfig: {TXMLConfig}TObject; Path: String); override;
procedure ReadFromProjectFile(AConfig: {TXMLConfig}TObject; Path: String); override;
property UseManifest: boolean read FUseManifest write SetUseManifest;
end;
@ -83,6 +86,12 @@ begin
Modified := True;
end;
constructor TProjectXPManifest.Create;
begin
inherited Create;
UseManifest := True;
end;
function TProjectXPManifest.UpdateResources(AResources: TAbstractProjectResources;
const MainFilename: string): Boolean;
var
@ -102,5 +111,18 @@ begin
end;
end;
procedure TProjectXPManifest.WriteToProjectFile(AConfig: TObject; Path: String);
begin
TXMLConfig(AConfig).SetDeleteValue(Path+'General/UseXPManifest/Value', UseManifest, False);
end;
procedure TProjectXPManifest.ReadFromProjectFile(AConfig: TObject; Path: String);
begin
UseManifest := TXMLConfig(AConfig).GetValue(Path+'General/UseXPManifest/Value', False);
end;
initialization
RegisterProjectResource(TProjectXPManifest);
end.

452
ide/w32versioninfo.pas
View File

@ -2,7 +2,7 @@
/***************************************************************************
w32versioninfo.pas - Lazarus IDE unit
---------------------------------------
TVersionInfo is responsible for the inclusion of the
TVersionInfo is responsible for the inclusion of the
version information in windows executables.
@ -38,9 +38,9 @@ interface
uses
Classes, SysUtils, Process, LCLProc, Controls, Forms, FileUtil,
CodeToolManager, LazConf, ProjectResourcesIntf, resource, versionresource,
versiontypes;
CodeToolManager, LazConf, Laz_XMLCfg, IDEProcs, ProjectResourcesIntf,
resource, versionresource, versiontypes;
type
{ TProjectVersionInfo }
@ -82,11 +82,15 @@ type
function ExtractProductVersion: TFileProductVersion;
public
procedure DoBeforeBuild(AResources: TAbstractProjectResources;
SaveToTestDir: boolean); override;
function UpdateResources(AResources: TAbstractProjectResources; const MainFilename: string): Boolean; override;
SaveToTestDir: boolean); override;
function UpdateResources(AResources: TAbstractProjectResources;
const MainFilename: string): boolean; override;
procedure WriteToProjectFile(AConfig: {TXMLConfig}TObject; Path: string); override;
procedure ReadFromProjectFile(AConfig: {TXMLConfig}TObject; Path: string); override;
property UseVersionInfo: boolean read FUseVersionInfo write SetUseVersionInfo;
property AutoIncrementBuild: boolean read FAutoIncrementBuild write SetAutoIncrementBuild;
property AutoIncrementBuild: boolean read FAutoIncrementBuild
write SetAutoIncrementBuild;
property VersionNr: integer index 0 read GetVersion write SetVersion;
property MajorRevNr: integer index 1 read GetVersion write SetVersion;
@ -95,15 +99,19 @@ type
property HexLang: string read FHexLang write SetHexLang;
property HexCharSet: string read FHexCharSet write SetHexCharSet;
property DescriptionString: string read FDescriptionString write SetDescriptionString;
property DescriptionString: string read FDescriptionString
write SetDescriptionString;
property CopyrightString: string read FCopyrightString write SetCopyrightString;
property CommentsString: string read FCommentsString write SetCommentsString;
property CompanyString: string read FCompanyString write SetCompanyString;
property InternalNameString: string read FInternalNameString write SetInternalNameString;
property InternalNameString: string read FInternalNameString
write SetInternalNameString;
property TrademarksString: string read FTrademarksString write SetTrademarksString;
property OriginalFilenameString: string read FOriginalFilenameString write SetOriginalFilenameString;
property OriginalFilenameString: string
read FOriginalFilenameString write SetOriginalFilenameString;
property ProdNameString: string read FProdNameString write SetProdNameString;
property ProductVersionString: string read FProductVersionString write SetProductVersionString;
property ProductVersionString: string read FProductVersionString
write SetProductVersionString;
end;
function MSLanguageToHex(const s: string): string;
@ -117,8 +125,8 @@ function MSCharacterSets: TStringList;
function MSHexCharacterSets: TStringList;
const
DefaultLanguage = '0409';
DefaultCharSet = '04E4';
DefaultLanguage = '0409';
DefaultCharSet = '04E4';
implementation
@ -133,210 +141,323 @@ var
procedure CreateCharSets;
begin
if fCharSets<>nil then exit;
if fCharSets <> nil then
exit;
fCharSets := TStringList.Create;
fHexCharSets := TStringList.Create;
fCharSets.Add('7-bit ASCII'); fHexCharSets.Add('0000');
fCharSets.Add('Japan (Shift - JIS X-0208)'); fHexCharSets.Add('03A4');
fCharSets.Add('Korea (Shift - KSC 5601)'); fHexCharSets.Add('03B5');
fCharSets.Add('Taiwan (Big5)'); fHexCharSets.Add('03B6');
fCharSets.Add('Unicode'); fHexCharSets.Add('04B0');
fCharSets.Add('Latin-2 (Eastern European)'); fHexCharSets.Add('04E2');
fCharSets.Add('Cyrillic'); fHexCharSets.Add('04E3');
fCharSets.Add('Multilingual'); fHexCharSets.Add('04E4');
fCharSets.Add('Greek'); fHexCharSets.Add('04E5');
fCharSets.Add('Turkish'); fHexCharSets.Add('04E6');
fCharSets.Add('Hebrew'); fHexCharSets.Add('04E7');
fCharSets.Add('Arabic'); fHexCharSets.Add('04E8');
fCharSets.Add('7-bit ASCII');
fHexCharSets.Add('0000');
fCharSets.Add('Japan (Shift - JIS X-0208)');
fHexCharSets.Add('03A4');
fCharSets.Add('Korea (Shift - KSC 5601)');
fHexCharSets.Add('03B5');
fCharSets.Add('Taiwan (Big5)');
fHexCharSets.Add('03B6');
fCharSets.Add('Unicode');
fHexCharSets.Add('04B0');
fCharSets.Add('Latin-2 (Eastern European)');
fHexCharSets.Add('04E2');
fCharSets.Add('Cyrillic');
fHexCharSets.Add('04E3');
fCharSets.Add('Multilingual');
fHexCharSets.Add('04E4');
fCharSets.Add('Greek');
fHexCharSets.Add('04E5');
fCharSets.Add('Turkish');
fHexCharSets.Add('04E6');
fCharSets.Add('Hebrew');
fHexCharSets.Add('04E7');
fCharSets.Add('Arabic');
fHexCharSets.Add('04E8');
end;
procedure CreateLanguages;
begin
if fLanguages<>nil then exit;
if fLanguages <> nil then
exit;
fLanguages := TStringList.Create;
fHexLanguages := TStringList.Create;
fLanguages.Add('Arabic'); fHexLanguages.Add('0401');
fLanguages.Add('Bulgarian'); fHexLanguages.Add('0402');
fLanguages.Add('Catalan'); fHexLanguages.Add('0403');
fLanguages.Add('Traditional Chinese'); fHexLanguages.Add('0404');
fLanguages.Add('Czech'); fHexLanguages.Add('0405');
fLanguages.Add('Danish'); fHexLanguages.Add('0406');
fLanguages.Add('German'); fHexLanguages.Add('0407');
fLanguages.Add('Greek'); fHexLanguages.Add('0408');
fLanguages.Add('U.S. English'); fHexLanguages.Add('0409');
fLanguages.Add('Castillian Spanish'); fHexLanguages.Add('040A');
fLanguages.Add('Finnish'); fHexLanguages.Add('040B');
fLanguages.Add('French'); fHexLanguages.Add('040C');
fLanguages.Add('Hebrew'); fHexLanguages.Add('040D');
fLanguages.Add('Hungarian'); fHexLanguages.Add('040E');
fLanguages.Add('Icelandic'); fHexLanguages.Add('040F');
fLanguages.Add('Italian'); fHexLanguages.Add('0410');
fLanguages.Add('Japanese'); fHexLanguages.Add('0411');
fLanguages.Add('Korean'); fHexLanguages.Add('0412');
fLanguages.Add('Dutch'); fHexLanguages.Add('0413');
fLanguages.Add('Norwegian - Bokmal'); fHexLanguages.Add('0414');
fLanguages.Add('Swiss Italian'); fHexLanguages.Add('0810');
fLanguages.Add('Belgian Dutch'); fHexLanguages.Add('0813');
fLanguages.Add('Norwegian - Nynorsk'); fHexLanguages.Add('0814');
fLanguages.Add('Polish'); fHexLanguages.Add('0415');
fLanguages.Add('Portugese (Brazil)'); fHexLanguages.Add('0416');
fLanguages.Add('Rhaeto-Romantic'); fHexLanguages.Add('0417');
fLanguages.Add('Romanian'); fHexLanguages.Add('0418');
fLanguages.Add('Russian'); fHexLanguages.Add('0419');
fLanguages.Add('Croato-Serbian (Latin)'); fHexLanguages.Add('041A');
fLanguages.Add('Slovak'); fHexLanguages.Add('041B');
fLanguages.Add('Albanian'); fHexLanguages.Add('041C');
fLanguages.Add('Swedish'); fHexLanguages.Add('041D');
fLanguages.Add('Thai'); fHexLanguages.Add('041E');
fLanguages.Add('Turkish'); fHexLanguages.Add('041F');
fLanguages.Add('Urdu'); fHexLanguages.Add('0420');
fLanguages.Add('Bahasa'); fHexLanguages.Add('0421');
fLanguages.Add('Simplified Chinese'); fHexLanguages.Add('0804');
fLanguages.Add('Swiss German'); fHexLanguages.Add('0807');
fLanguages.Add('U.K. English'); fHexLanguages.Add('0809');
fLanguages.Add('Mexican Spanish'); fHexLanguages.Add('080A');
fLanguages.Add('Belgian French'); fHexLanguages.Add('080C');
fLanguages.Add('Canadian French'); fHexLanguages.Add('0C0C');
fLanguages.Add('Swiss French'); fHexLanguages.Add('100C');
fLanguages.Add('Portugese (Portugal)'); fHexLanguages.Add('0816');
fLanguages.Add('Sebro-Croatian (Cyrillic)'); fHexLanguages.Add('081A');
fLanguages.Add('Arabic');
fHexLanguages.Add('0401');
fLanguages.Add('Bulgarian');
fHexLanguages.Add('0402');
fLanguages.Add('Catalan');
fHexLanguages.Add('0403');
fLanguages.Add('Traditional Chinese');
fHexLanguages.Add('0404');
fLanguages.Add('Czech');
fHexLanguages.Add('0405');
fLanguages.Add('Danish');
fHexLanguages.Add('0406');
fLanguages.Add('German');
fHexLanguages.Add('0407');
fLanguages.Add('Greek');
fHexLanguages.Add('0408');
fLanguages.Add('U.S. English');
fHexLanguages.Add('0409');
fLanguages.Add('Castillian Spanish');
fHexLanguages.Add('040A');
fLanguages.Add('Finnish');
fHexLanguages.Add('040B');
fLanguages.Add('French');
fHexLanguages.Add('040C');
fLanguages.Add('Hebrew');
fHexLanguages.Add('040D');
fLanguages.Add('Hungarian');
fHexLanguages.Add('040E');
fLanguages.Add('Icelandic');
fHexLanguages.Add('040F');
fLanguages.Add('Italian');
fHexLanguages.Add('0410');
fLanguages.Add('Japanese');
fHexLanguages.Add('0411');
fLanguages.Add('Korean');
fHexLanguages.Add('0412');
fLanguages.Add('Dutch');
fHexLanguages.Add('0413');
fLanguages.Add('Norwegian - Bokmal');
fHexLanguages.Add('0414');
fLanguages.Add('Swiss Italian');
fHexLanguages.Add('0810');
fLanguages.Add('Belgian Dutch');
fHexLanguages.Add('0813');
fLanguages.Add('Norwegian - Nynorsk');
fHexLanguages.Add('0814');
fLanguages.Add('Polish');
fHexLanguages.Add('0415');
fLanguages.Add('Portugese (Brazil)');
fHexLanguages.Add('0416');
fLanguages.Add('Rhaeto-Romantic');
fHexLanguages.Add('0417');
fLanguages.Add('Romanian');
fHexLanguages.Add('0418');
fLanguages.Add('Russian');
fHexLanguages.Add('0419');
fLanguages.Add('Croato-Serbian (Latin)');
fHexLanguages.Add('041A');
fLanguages.Add('Slovak');
fHexLanguages.Add('041B');
fLanguages.Add('Albanian');
fHexLanguages.Add('041C');
fLanguages.Add('Swedish');
fHexLanguages.Add('041D');
fLanguages.Add('Thai');
fHexLanguages.Add('041E');
fLanguages.Add('Turkish');
fHexLanguages.Add('041F');
fLanguages.Add('Urdu');
fHexLanguages.Add('0420');
fLanguages.Add('Bahasa');
fHexLanguages.Add('0421');
fLanguages.Add('Simplified Chinese');
fHexLanguages.Add('0804');
fLanguages.Add('Swiss German');
fHexLanguages.Add('0807');
fLanguages.Add('U.K. English');
fHexLanguages.Add('0809');
fLanguages.Add('Mexican Spanish');
fHexLanguages.Add('080A');
fLanguages.Add('Belgian French');
fHexLanguages.Add('080C');
fLanguages.Add('Canadian French');
fHexLanguages.Add('0C0C');
fLanguages.Add('Swiss French');
fHexLanguages.Add('100C');
fLanguages.Add('Portugese (Portugal)');
fHexLanguages.Add('0816');
fLanguages.Add('Sebro-Croatian (Cyrillic)');
fHexLanguages.Add('081A');
end;
function MSLanguageToHex(const s: string): string;
var
i: LongInt;
i: longint;
begin
i:=MSLanguages.IndexOf(s);
if i>=0 then
Result:=fHexLanguages[i]
i := MSLanguages.IndexOf(s);
if i >= 0 then
Result := fHexLanguages[i]
else
Result:='';
Result := '';
end;
function MSHexToLanguage(const s: string): string;
var
i: LongInt;
i: longint;
begin
i:=MSHexLanguages.IndexOf(s);
if i>=0 then
Result:=fLanguages[i]
i := MSHexLanguages.IndexOf(s);
if i >= 0 then
Result := fLanguages[i]
else
Result:='';
Result := '';
end;
function MSCharacterSetToHex(const s: string): string;
var
i: LongInt;
i: longint;
begin
i:=MSCharacterSets.IndexOf(s);
if i>=0 then
Result:=fHexCharSets[i]
i := MSCharacterSets.IndexOf(s);
if i >= 0 then
Result := fHexCharSets[i]
else
Result:='';
Result := '';
end;
function MSHexToCharacterSet(const s: string): string;
var
i: LongInt;
i: longint;
begin
i:=MSHexCharacterSets.IndexOf(s);
if i>=0 then
Result:=fCharSets[i]
i := MSHexCharacterSets.IndexOf(s);
if i >= 0 then
Result := fCharSets[i]
else
Result:='';
Result := '';
end;
function MSLanguages: TStringList;
begin
CreateLanguages;
Result:=fLanguages;
Result := fLanguages;
end;
function MSHexLanguages: TStringList;
begin
CreateLanguages;
Result:=fHexLanguages;
Result := fHexLanguages;
end;
function MSCharacterSets: TStringList;
begin
CreateCharSets;
Result:=fCharSets;
Result := fCharSets;
end;
function MSHexCharacterSets: TStringList;
begin
CreateCharSets;
Result:=fHexCharSets;
Result := fHexCharSets;
end;
{ VersionInfo }
function TProjectVersionInfo.UpdateResources(AResources: TAbstractProjectResources;
const MainFilename: string): Boolean;
const MainFilename: string): boolean;
var
ARes: TVersionResource;
st: TVersionStringTable;
ti: TVerTranslationInfo;
lang: String;
charset: String;
lang: string;
charset: string;
begin
Result := True;
if UseVersionInfo then
begin
// project indicates to use the versioninfo
ARes := TVersionResource.Create(nil, nil); //it's always RT_VERSION and 1 respectively
ARes := TVersionResource.Create(nil, nil);
//it's always RT_VERSION and 1 respectively
ARes.FixedInfo.FileVersion := FVersion;
ARes.FixedInfo.ProductVersion := ExtractProductVersion;
lang:=HexLang;
if lang='' then lang:=DefaultLanguage;
charset:=HexCharSet;
if charset='' then charset:=DefaultCharSet;
lang := HexLang;
if lang = '' then
lang := DefaultLanguage;
charset := HexCharSet;
if charset = '' then
charset := DefaultCharSet;
st := TVersionStringTable.Create(lang + charset);
st.Add('Comments', Utf8ToAnsi(CommentsString));
st.Add('CompanyName', Utf8ToAnsi(CompanyString));
st.Add('FileDescription', Utf8ToAnsi(DescriptionString));
st.Add('FileVersion', IntToStr(VersionNr) + '.' + IntToStr(MajorRevNr) + '.' + IntToStr(MinorRevNr) + '.' + IntToStr(BuildNr));
st.Add('FileVersion', IntToStr(VersionNr) + '.' + IntToStr(MajorRevNr) +
'.' + IntToStr(MinorRevNr) + '.' + IntToStr(BuildNr));
st.Add('InternalName', Utf8ToAnsi(InternalNameString));
st.Add('LegalCopyright', Utf8ToAnsi(CopyrightString));
st.Add('LegalTrademarks', Utf8ToAnsi(TrademarksString));
st.Add('OriginalFilename', Utf8ToAnsi(OriginalFilenameString));
st.Add('ProductName', Utf8ToAnsi(ProdNameString));
st.Add('ProductVersion', StringReplace(Utf8ToAnsi(ProductVersionString), ',', '.', [rfReplaceAll]));
st.Add('ProductVersion', StringReplace(Utf8ToAnsi(ProductVersionString),
',', '.', [rfReplaceAll]));
ARes.StringFileInfo.Add(st);
ti.language := StrToInt('$'+lang);
ti.codepage := StrToInt('$'+charset);
ti.language := StrToInt('$' + lang);
ti.codepage := StrToInt('$' + charset);
ARes.VarFileInfo.Add(ti);
AResources.AddSystemResource(ARes);
end;
end;
procedure TProjectVersionInfo.WriteToProjectFile(AConfig: TObject; Path: string);
begin
with TXMLConfig(AConfig) do
begin
SetDeleteValue(Path + 'VersionInfo/UseVersionInfo/Value', UseVersionInfo, False);
SetDeleteValue(Path + 'VersionInfo/AutoIncrementBuild/Value',
AutoIncrementBuild, False);
SetDeleteValue(Path + 'VersionInfo/CurrentVersionNr/Value', VersionNr, 0);
SetDeleteValue(Path + 'VersionInfo/CurrentMajorRevNr/Value', MajorRevNr, 0);
SetDeleteValue(Path + 'VersionInfo/CurrentMinorRevNr/Value', MinorRevNr, 0);
SetDeleteValue(Path + 'VersionInfo/CurrentBuildNr/Value', BuildNr, 0);
SetDeleteValue(Path + 'VersionInfo/ProjectVersion/Value', ProductVersionString, '1.0.0.0');
SetDeleteValue(Path + 'VersionInfo/Language/Value', HexLang, DefaultLanguage);
SetDeleteValue(Path + 'VersionInfo/CharSet/Value', HexCharSet, DefaultCharset);
SetDeleteValue(Path + 'VersionInfo/Comments/Value', CommentsString, '');
SetDeleteValue(Path + 'VersionInfo/CompanyName/Value', CompanyString, '');
SetDeleteValue(Path + 'VersionInfo/FileDescription/Value', DescriptionString, '');
SetDeleteValue(Path + 'VersionInfo/InternalName/Value', InternalNameString, '');
SetDeleteValue(Path + 'VersionInfo/LegalCopyright/Value', CopyrightString, '');
SetDeleteValue(Path + 'VersionInfo/LegalTrademarks/Value', TrademarksString, '');
SetDeleteValue(Path + 'VersionInfo/OriginalFilename/Value', OriginalFilenameString, '');
SetDeleteValue(Path + 'VersionInfo/ProductName/Value', ProdNameString, '');
end;
end;
procedure TProjectVersionInfo.ReadFromProjectFile(AConfig: TObject; Path: string);
begin
with TXMLConfig(AConfig) do
begin
UseVersionInfo := GetValue(Path + 'VersionInfo/UseVersionInfo/Value', False);
AutoIncrementBuild := GetValue(Path + 'VersionInfo/AutoIncrementBuild/Value', False);
VersionNr := GetValue(Path + 'VersionInfo/CurrentVersionNr/Value', 0);
MajorRevNr := GetValue(Path + 'VersionInfo/CurrentMajorRevNr/Value', 0);
MinorRevNr := GetValue(Path + 'VersionInfo/CurrentMinorRevNr/Value', 0);
BuildNr := GetValue(Path + 'VersionInfo/CurrentBuildNr/Value', 0);
ProductVersionString := GetValue(Path + 'VersionInfo/ProjectVersion/Value', '1.0.0.0');
HexLang := GetValue(Path + 'VersionInfo/Language/Value', DefaultLanguage);
HexCharSet := GetValue(Path + 'VersionInfo/CharSet/Value', DefaultCharset);
CommentsString := LineBreaksToSystemLineBreaks(GetValue(Path + 'VersionInfo/Comments/Value', ''));
CompanyString := LineBreaksToSystemLineBreaks(GetValue(Path + 'VersionInfo/CompanyName/Value', ''));
DescriptionString := LineBreaksToSystemLineBreaks(GetValue(Path + 'VersionInfo/FileDescription/Value', ''));
InternalNameString := LineBreaksToSystemLineBreaks(GetValue(Path + 'VersionInfo/InternalName/Value', ''));
CopyrightString := LineBreaksToSystemLineBreaks(GetValue(Path + 'VersionInfo/LegalCopyright/Value', ''));
TrademarksString := LineBreaksToSystemLineBreaks(GetValue(Path + 'VersionInfo/LegalTrademarks/Value', ''));
OriginalFilenameString := GetValue(Path + 'VersionInfo/OriginalFilename/Value', '');
ProdNameString := LineBreaksToSystemLineBreaks(GetValue(Path + 'VersionInfo/ProductName/Value', ''));
end;
end;
function TProjectVersionInfo.GetCharSets: TStringList;
begin
CreateCharSets;
Result:=fHexCharSets;
Result := fHexCharSets;
end;
function TProjectVersionInfo.GetHexCharSets: TStringList;
begin
CreateCharSets;
Result:=fHexCharSets;
Result := fHexCharSets;
end;
function TProjectVersionInfo.GetHexLanguages: TStringList;
begin
CreateLanguages;
Result:=fHexLanguages;
Result := fHexLanguages;
end;
function TProjectVersionInfo.GetLanguages: TStringList;
begin
CreateLanguages;
Result:=fLanguages;
Result := fLanguages;
end;
function TProjectVersionInfo.GetVersion(AIndex: integer): integer;
@ -346,108 +467,122 @@ end;
procedure TProjectVersionInfo.SetAutoIncrementBuild(const AValue: boolean);
begin
if FAutoIncrementBuild=AValue then exit;
FAutoIncrementBuild:=AValue;
Modified:=true;
if FAutoIncrementBuild = AValue then
exit;
FAutoIncrementBuild := AValue;
Modified := True;
end;
procedure TProjectVersionInfo.SetCommentsString(const AValue: string);
begin
if FCommentsString=AValue then exit;
FCommentsString:=AValue;
Modified:=true;
if FCommentsString = AValue then
exit;
FCommentsString := AValue;
Modified := True;
end;
procedure TProjectVersionInfo.SetCompanyString(const AValue: string);
begin
if FCompanyString=AValue then exit;
FCompanyString:=AValue;
Modified:=true;
if FCompanyString = AValue then
exit;
FCompanyString := AValue;
Modified := True;
end;
procedure TProjectVersionInfo.SetCopyrightString(const AValue: string);
begin
if FCopyrightString=AValue then exit;
FCopyrightString:=AValue;
Modified:=true;
if FCopyrightString = AValue then
exit;
FCopyrightString := AValue;
Modified := True;
end;
procedure TProjectVersionInfo.SetDescriptionString(const AValue: string);
begin
if FDescriptionString=AValue then exit;
FDescriptionString:=AValue;
Modified:=true;
if FDescriptionString = AValue then
exit;
FDescriptionString := AValue;
Modified := True;
end;
procedure TProjectVersionInfo.SetHexCharSet(const AValue: string);
begin
if FHexCharSet=AValue then exit;
FHexCharSet:=AValue;
Modified:=true;
if FHexCharSet = AValue then
exit;
FHexCharSet := AValue;
Modified := True;
end;
procedure TProjectVersionInfo.SetHexLang(const AValue: string);
begin
if FHexLang=AValue then exit;
FHexLang:=AValue;
Modified:=true;
if FHexLang = AValue then
exit;
FHexLang := AValue;
Modified := True;
end;
procedure TProjectVersionInfo.SetInternalNameString(const AValue: string);
begin
if FInternalNameString=AValue then exit;
FInternalNameString:=AValue;
Modified:=true;
if FInternalNameString = AValue then
exit;
FInternalNameString := AValue;
Modified := True;
end;
procedure TProjectVersionInfo.SetOriginalFilenameString(const AValue: string);
begin
if FOriginalFilenameString=AValue then exit;
FOriginalFilenameString:=AValue;
Modified:=true;
if FOriginalFilenameString = AValue then
exit;
FOriginalFilenameString := AValue;
Modified := True;
end;
procedure TProjectVersionInfo.SetProdNameString(const AValue: string);
begin
if FProdNameString=AValue then exit;
FProdNameString:=AValue;
Modified:=true;
if FProdNameString = AValue then
exit;
FProdNameString := AValue;
Modified := True;
end;
procedure TProjectVersionInfo.SetProductVersionString(const AValue: string);
var
NewValue: String;
NewValue: string;
begin
NewValue:=StringReplace(AValue, ',', '.', [rfReplaceAll]);
if FProductVersionString=NewValue then exit;
FProductVersionString:=NewValue;
Modified:=true;
NewValue := StringReplace(AValue, ',', '.', [rfReplaceAll]);
if FProductVersionString = NewValue then
exit;
FProductVersionString := NewValue;
Modified := True;
end;
procedure TProjectVersionInfo.SetTrademarksString(const AValue: string);
begin
if FTrademarksString=AValue then exit;
FTrademarksString:=AValue;
Modified:=true;
if FTrademarksString = AValue then
exit;
FTrademarksString := AValue;
Modified := True;
end;
procedure TProjectVersionInfo.SetUseVersionInfo(const AValue: boolean);
begin
if FUseVersionInfo=AValue then exit;
FUseVersionInfo:=AValue;
Modified:=true;
if FUseVersionInfo = AValue then
exit;
FUseVersionInfo := AValue;
Modified := True;
end;
procedure TProjectVersionInfo.SetVersion(AIndex: integer; const AValue: integer);
begin
if FVersion[AIndex] = AValue then Exit;
if FVersion[AIndex] = AValue then
Exit;
FVersion[AIndex] := AValue;
Modified := True;
end;
function TProjectVersionInfo.ExtractProductVersion: TFileProductVersion;
var
S, Part: String;
S, Part: string;
i, p: integer;
begin
S := ProductVersionString;
@ -468,13 +603,16 @@ begin
end;
end;
procedure TProjectVersionInfo.DoBeforeBuild(
AResources: TAbstractProjectResources; SaveToTestDir: boolean);
procedure TProjectVersionInfo.DoBeforeBuild(AResources: TAbstractProjectResources;
SaveToTestDir: boolean);
begin
if AutoIncrementBuild then // project indicate to use autoincrementbuild
BuildNr := BuildNr + 1;
end;
initialization
RegisterProjectResource(TProjectVersionInfo);
finalization
FreeAndNil(fHexCharSets);
FreeAndNil(fHexLanguages);

26
ideintf/projectresourcesintf.pas
View File

@ -33,11 +33,15 @@ type
procedure DoBeforeBuild(AResources: TAbstractProjectResources; SaveToTestDir: boolean); virtual;
function UpdateResources(AResources: TAbstractProjectResources; const MainFilename: string): Boolean; virtual; abstract;
procedure WriteToProjectFile(AConfig: {TXMLConfig}TObject; Path: String); virtual; abstract;
procedure ReadFromProjectFile(AConfig: {TXMLConfig}TObject; Path: String); virtual; abstract;
property Modified: boolean read FModified write SetModified;
property OnModified: TNotifyEvent read FOnModified write FOnModified;
end;
TAbstractProjectResourceClass = class of TAbstractProjectResource;
{ TAbstractProjectResources }
TAbstractProjectResources = class
@ -47,6 +51,8 @@ type
protected
FMessages: TStringList;
procedure SetResourceType(const AValue: TResourceType); virtual;
function GetProjectResource(AIndex: TAbstractProjectResourceClass): TAbstractProjectResource; virtual; abstract;
class function GetRegisteredResources: TList;
public
constructor Create(AProject: TLazProject); virtual;
destructor Destroy; override;
@ -58,10 +64,23 @@ type
property Messages: TStringList read FMessages;
property Project: TLazProject read FProject;
property ResourceType: TResourceType read FResourceType write SetResourceType;
property Resource[AIndex: TAbstractProjectResourceClass]: TAbstractProjectResource read GetProjectResource; default;
end;
procedure RegisterProjectResource(AResource: TAbstractProjectResourceClass);
implementation
var
FRegisteredProjectResources: TList = nil;
procedure RegisterProjectResource(AResource: TAbstractProjectResourceClass);
begin
if FRegisteredProjectResources = nil then
FRegisteredProjectResources := TList.Create;
FRegisteredProjectResources.Add(AResource);
end;
{ TAbstractProjectResource }
procedure TAbstractProjectResource.SetModified(const AValue: boolean);
@ -89,6 +108,11 @@ begin
FResourceType := AValue;
end;
class function TAbstractProjectResources.GetRegisteredResources: TList;
begin
Result := FRegisteredProjectResources;
end;
constructor TAbstractProjectResources.Create(AProject: TLazProject);
begin
FProject:=AProject;
@ -101,4 +125,6 @@ begin
inherited Destroy;
end;
finalization
FRegisteredProjectResources.Free;
end.