paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-18 20:19:29 +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 uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
ExtCtrls, StdCtrls, Buttons, ComCtrls, ExtDlgs, Math, LCLType, IDEOptionsIntf, ExtCtrls, StdCtrls, Buttons, ComCtrls, ExtDlgs, Math, LCLType, IDEOptionsIntf,
Project, LazarusIDEStrConsts, EnvironmentOpts, ApplicationBundle; Project, LazarusIDEStrConsts, EnvironmentOpts, ApplicationBundle, ProjectIcon,
W32Manifest;
type type
@ -199,8 +200,8 @@ begin
TitleEdit.Text := Title; TitleEdit.Text := Title;
TargetFileEdit.Text := TargetFilename; TargetFileEdit.Text := TargetFilename;
UseAppBundleCheckBox.Checked := UseAppBundle; UseAppBundleCheckBox.Checked := UseAppBundle;
UseXPManifestCheckBox.Checked := Resources.XPManifest.UseManifest; UseXPManifestCheckBox.Checked := TProjectXPManifest(Resources[TProjectXPManifest]).UseManifest;
AStream := Resources.ProjectIcon.GetStream; AStream := TProjectIcon(Resources[TProjectIcon]).GetStream;
try try
SetIconFromStream(AStream); SetIconFromStream(AStream);
finally finally
@ -218,18 +219,17 @@ begin
Title := TitleEdit.Text; Title := TitleEdit.Text;
AStream := GetIconAsStream; AStream := GetIconAsStream;
try try
Resources.ProjectIcon.SetStream(AStream); TProjectIcon(Resources[TProjectIcon]).SetStream(AStream);
finally finally
AStream.Free; AStream.Free;
end; end;
TargetFilename := TargetFileEdit.Text; TargetFilename := TargetFileEdit.Text;
UseAppBundle := UseAppBundleCheckBox.Checked; UseAppBundle := UseAppBundleCheckBox.Checked;
Resources.XPManifest.UseManifest := UseXPManifestCheckBox.Checked; TProjectXPManifest(Resources[TProjectXPManifest]).UseManifest := UseXPManifestCheckBox.Checked;
end; end;
end; end;
class function TProjectApplicationOptionsFrame.SupportedOptionsClass: class function TProjectApplicationOptionsFrame.SupportedOptionsClass: TAbstractIDEOptionsClass;
TAbstractIDEOptionsClass;
begin begin
Result := TProject; Result := TProject;
end; end;

70
ide/frames/project_versioninfo_options.pas
View File

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

22
ide/projecticon.pas
View File

@ -35,7 +35,7 @@ interface
uses uses
Classes, SysUtils, FileUtil, Process, LCLProc, Controls, Forms, Classes, SysUtils, FileUtil, Process, LCLProc, Controls, Forms,
CodeToolManager, LazConf, LResources, resource, groupiconresource, CodeToolManager, LazConf, Laz_XMLCfg, LResources, resource, groupiconresource,
ProjectIntf, ProjectResourcesIntf; ProjectIntf, ProjectResourcesIntf;
type type
@ -59,6 +59,9 @@ type
function UpdateResources(AResources: TAbstractProjectResources; function UpdateResources(AResources: TAbstractProjectResources;
const MainFilename: string): Boolean; override; const MainFilename: string): Boolean; override;
procedure WriteToProjectFile(AConfig: {TXMLConfig}TObject; Path: String); override;
procedure ReadFromProjectFile(AConfig: {TXMLConfig}TObject; Path: String); override;
function CreateIconFile: Boolean; function CreateIconFile: Boolean;
property IconData: TIconData read FData write SetIconData; property IconData: TIconData read FData write SetIconData;
@ -134,6 +137,20 @@ begin
AResources.AddSystemResource(ARes); AResources.AddSystemResource(ARes);
end; 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; function TProjectIcon.CreateIconFile: Boolean;
var var
FileStream, AStream: TStream; FileStream, AStream: TStream;
@ -221,5 +238,8 @@ begin
Result := FData = nil; Result := FData = nil;
end; end;
initialization
RegisterProjectResource(TProjectIcon);
end. end.

162
ide/projectresources.pas
View File

@ -37,11 +37,10 @@ unit ProjectResources;
interface interface
uses uses
Classes, SysUtils, Controls, LCLProc, LResources, FileUtil, Laz_XMLCfg, Classes, SysUtils, Contnrs, Controls, LCLProc, LResources, FileUtil, Laz_XMLCfg,
Dialogs, ProjectIntf, ProjectResourcesIntf, LazarusIDEStrConsts, AvgLvlTree, Dialogs, ProjectIntf, ProjectResourcesIntf, LazarusIDEStrConsts, AvgLvlTree,
KeywordFuncLists, BasicCodeTools, KeywordFuncLists, BasicCodeTools, IDEProcs, DialogProcs, CodeToolManager,
W32VersionInfo, W32Manifest, ProjectIcon, IDEProcs, DialogProcs, CodeCache, resource, reswriter;
CodeToolManager, CodeCache, resource, reswriter;
type type
{ TProjectResources } { TProjectResources }
@ -53,6 +52,7 @@ type
FInModified: Boolean; FInModified: Boolean;
FLrsIncludeAllowed: Boolean; FLrsIncludeAllowed: Boolean;
FResources: TObjectList;
FSystemResources: TResources; FSystemResources: TResources;
FLazarusResources: TStringList; FLazarusResources: TStringList;
@ -61,21 +61,19 @@ type
LastResFilename: String; LastResFilename: String;
LastLrsFileName: String; LastLrsFileName: String;
FVersionInfo: TProjectVersionInfo;
FXPManifest: TProjectXPManifest;
FProjectIcon: TProjectIcon;
procedure SetFileNames(const MainFileName, TestDir: String); procedure SetFileNames(const MainFileName, TestDir: String);
procedure SetModified(const AValue: Boolean); procedure SetModified(const AValue: Boolean);
procedure EmbeddedObjectModified(Sender: TObject);
function Update: Boolean; function Update: Boolean;
function UpdateMainSourceFile(const AFileName: string): Boolean; function UpdateMainSourceFile(const AFileName: string): Boolean;
procedure UpdateFlagLrsIncludeAllowed(const AFileName: string); procedure UpdateFlagLrsIncludeAllowed(const AFileName: string);
function Save(SaveToTestDir: string): Boolean; function Save(SaveToTestDir: string): Boolean;
procedure UpdateCodeBuffers; procedure UpdateCodeBuffers;
procedure DeleteLastCodeBuffers; procedure DeleteLastCodeBuffers;
procedure OnResourceModified(Sender: TObject);
protected protected
procedure SetResourceType(const AValue: TResourceType); override; procedure SetResourceType(const AValue: TResourceType); override;
function GetProjectResource(AIndex: TAbstractProjectResourceClass): TAbstractProjectResource; override;
public public
constructor Create(AProject: TLazProject); override; constructor Create(AProject: TLazProject); override;
destructor Destroy; override; destructor Destroy; override;
@ -97,10 +95,6 @@ type
procedure WriteToProjectFile(AConfig: TXMLConfig; Path: String); procedure WriteToProjectFile(AConfig: TXMLConfig; Path: String);
procedure ReadFromProjectFile(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 Modified: Boolean read FModified write SetModified;
property OnModified: TNotifyEvent read FOnModified write FOnModified; property OnModified: TNotifyEvent read FOnModified write FOnModified;
end; end;
@ -321,6 +315,8 @@ begin
end; end;
procedure TProjectResources.SetModified(const AValue: Boolean); procedure TProjectResources.SetModified(const AValue: Boolean);
var
i: integer;
begin begin
if FInModified then if FInModified then
Exit; Exit;
@ -330,9 +326,8 @@ begin
FModified := AValue; FModified := AValue;
if not FModified then if not FModified then
begin begin
VersionInfo.Modified := False; for i := 0 to FResources.Count - 1 do
XPManifest.Modified := False; TAbstractProjectResource(FResources[i]).Modified := False;
ProjectIcon.Modified := False;
end; end;
if Assigned(FOnModified) then if Assigned(FOnModified) then
OnModified(Self); OnModified(Self);
@ -341,31 +336,28 @@ begin
end; end;
function TProjectResources.Update: Boolean; function TProjectResources.Update: Boolean;
var
i: integer;
begin begin
Clear; Clear;
// handle versioninfo for i := 0 to FResources.Count - 1 do
Result := VersionInfo.UpdateResources(Self, resFileName); begin
if not Result then Result := TAbstractProjectResource(FResources[i]).UpdateResources(Self, resFileName);
Exit; if not Result then
Exit;
// handle manifest end;
Result := XPManifest.UpdateResources(Self, resFileName);
if not Result then
Exit;
// handle project icon
Result := ProjectIcon.UpdateResources(Self, resFileName);
end; end;
procedure TProjectResources.EmbeddedObjectModified(Sender: TObject); procedure TProjectResources.OnResourceModified(Sender: TObject);
begin begin
Modified := Modified := Modified or TAbstractProjectResource(Sender).Modified;
VersionInfo.Modified or
XPManifest.Modified or
ProjectIcon.Modified;
end; end;
constructor TProjectResources.Create(AProject: TLazProject); constructor TProjectResources.Create(AProject: TLazProject);
var
i: integer;
L: TList;
R: TAbstractProjectResource;
begin begin
inherited Create(AProject); inherited Create(AProject);
@ -375,25 +367,21 @@ begin
FSystemResources := TResources.Create; FSystemResources := TResources.Create;
FLazarusResources := TStringList.Create; FLazarusResources := TStringList.Create;
FVersionInfo := TProjectVersionInfo.Create; FResources := TObjectList.Create;
FVersionInfo.OnModified := @EmbeddedObjectModified; L := GetRegisteredResources;
for i := 0 to L.Count - 1 do
FXPManifest := TProjectXPManifest.Create; begin
FXPManifest.UseManifest := True; R := TAbstractProjectResourceClass(L[i]).Create;
FXPManifest.OnModified := @EmbeddedObjectModified; R.OnModified := @OnResourceModified;
FResources.Add(R);
FProjectIcon := TProjectIcon.Create; end;
FProjectIcon.OnModified := @EmbeddedObjectModified;
end; end;
destructor TProjectResources.Destroy; destructor TProjectResources.Destroy;
begin begin
DeleteResourceBuffers; DeleteResourceBuffers;
FreeAndNil(FVersionInfo); FreeAndNil(FResources);
FreeAndNil(FXPManifest);
FreeAndNil(FProjectIcon);
FreeAndNil(FSystemResources); FreeAndNil(FSystemResources);
FreeAndNil(FLazarusResources); FreeAndNil(FLazarusResources);
@ -419,11 +407,25 @@ begin
end; end;
end; end;
procedure TProjectResources.DoBeforeBuild(SaveToTestDir: boolean); function TProjectResources.GetProjectResource(AIndex: TAbstractProjectResourceClass): TAbstractProjectResource;
var
i: integer;
begin begin
VersionInfo.DoBeforeBuild(Self,SaveToTestDir); for i := 0 to FResources.Count - 1 do
XPManifest.DoBeforeBuild(Self,SaveToTestDir); begin
ProjectIcon.DoBeforeBuild(Self,SaveToTestDir); 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; end;
procedure TProjectResources.Clear; procedure TProjectResources.Clear;
@ -480,61 +482,21 @@ begin
end; end;
procedure TProjectResources.WriteToProjectFile(AConfig: TXMLConfig; Path: String); procedure TProjectResources.WriteToProjectFile(AConfig: TXMLConfig; Path: String);
var
i: integer;
begin begin
// todo: further split by classes AConfig.SetDeleteValue(Path+'General/ResourceType/Value', ResourceTypeNames[ResourceType], ResourceTypeNames[rtLRS]);
with AConfig do for i := 0 to FResources.Count - 1 do
begin TAbstractProjectResource(FResources[i]).WriteToProjectFile(AConfig, Path);
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;
end; end;
procedure TProjectResources.ReadFromProjectFile(AConfig: TXMLConfig; Path: String); procedure TProjectResources.ReadFromProjectFile(AConfig: TXMLConfig; Path: String);
var
i: integer;
begin begin
// todo: further split by classes ResourceType := StrToResourceType(AConfig.GetValue(Path+'General/ResourceType/Value', ResourceTypeNames[rtLRS]));
with AConfig do for i := 0 to FResources.Count - 1 do
begin TAbstractProjectResource(FResources[i]).ReadFromProjectFile(AConfig, Path);
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;
end; end;
function TProjectResources.UpdateMainSourceFile(const AFileName: string): Boolean; function TProjectResources.UpdateMainSourceFile(const AFileName: string): Boolean;

24
ide/w32manifest.pas
View File

@ -38,7 +38,7 @@ interface
uses uses
Classes, SysUtils, FileUtil, Process, LCLProc, Controls, Forms, Classes, SysUtils, FileUtil, Process, LCLProc, Controls, Forms,
CodeToolManager, CodeCache, LazConf, DialogProcs, LResources, CodeToolManager, CodeCache, LazConf, Laz_XMLCfg, DialogProcs, LResources,
ProjectResourcesIntf, resource; ProjectResourcesIntf, resource;
type type
@ -49,7 +49,10 @@ type
FUseManifest: boolean; FUseManifest: boolean;
procedure SetUseManifest(const AValue: boolean); procedure SetUseManifest(const AValue: boolean);
public public
constructor Create; override;
function UpdateResources(AResources: TAbstractProjectResources; const MainFilename: string): 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 UseManifest: boolean read FUseManifest write SetUseManifest; property UseManifest: boolean read FUseManifest write SetUseManifest;
end; end;
@ -83,6 +86,12 @@ begin
Modified := True; Modified := True;
end; end;
constructor TProjectXPManifest.Create;
begin
inherited Create;
UseManifest := True;
end;
function TProjectXPManifest.UpdateResources(AResources: TAbstractProjectResources; function TProjectXPManifest.UpdateResources(AResources: TAbstractProjectResources;
const MainFilename: string): Boolean; const MainFilename: string): Boolean;
var var
@ -102,5 +111,18 @@ begin
end; end;
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. end.

452
ide/w32versioninfo.pas
View File

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

26
ideintf/projectresourcesintf.pas
View File

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