diff --git a/ide/projecticon.pas b/ide/projecticon.pas index 7578703dc8..dae5122192 100644 --- a/ide/projecticon.pas +++ b/ide/projecticon.pas @@ -55,6 +55,8 @@ type function GetStream: TStream; procedure SetStream(AStream: TStream); + function HasAnyLazarusResource: Boolean; override; + function HasAnySystemResource: Boolean; override; function UpdateResources(AResources: TAbstractProjectResources; const MainFilename: string): Boolean; override; function CreateIconFile: Boolean; @@ -111,6 +113,16 @@ begin IconText := NewIconText; end; +function TProjectIcon.HasAnyLazarusResource: Boolean; +begin + Result := IconText <> ''; +end; + +function TProjectIcon.HasAnySystemResource: Boolean; +begin + Result := IconText <> ''; +end; + function TProjectIcon.UpdateResources(AResources: TAbstractProjectResources; const MainFilename: string): Boolean; var @@ -134,6 +146,7 @@ begin // the preferred way is this: // RCIcon := sIcon + #$D#$A + GetAsHex; // but it does not work + if CreateIconFile then AResources.AddSystemResource(sIcon + Format(' "%s"', [StringReplace(icoFileName, '\', '\\', [rfReplaceAll])])) else diff --git a/ide/projectresources.pas b/ide/projectresources.pas index 9c0a80c051..a292b1477f 100644 --- a/ide/projectresources.pas +++ b/ide/projectresources.pas @@ -77,8 +77,8 @@ type function Regenerate(const AWorkingDir, MainFileName: String): Boolean; function UpdateMainSourceFile(const AFileName: string): Boolean; - function HasSystemResources: Boolean; - function HasLazarusResources: Boolean; + function HasSystemResources(CheckLists: Boolean): Boolean; + function HasLazarusResources(CheckLists: Boolean): Boolean; procedure WriteToProjectFile(AConfig: TXMLConfig; Path: String); procedure ReadFromProjectFile(AConfig: TXMLConfig; Path: String); @@ -127,6 +127,7 @@ end; function TProjectResources.Update: Boolean; begin + // CheckMode is used only to test whether we have paticular resources Clear; // handle versioninfo Result := VersionInfo.UpdateResources(Self, rcFileName); @@ -215,7 +216,7 @@ begin Exit; AStream := nil; - if HasSystemResources then + if HasSystemResources(True) then begin try AStream := TFileStream.Create(UTF8ToSys(rcFileName), fmCreate); @@ -224,7 +225,7 @@ begin AStream.Free; end; end; - if HasLazarusResources then + if HasLazarusResources(True) then begin try AStream := TFileStream.Create(UTF8ToSys(lrsFileName), fmCreate); @@ -236,14 +237,24 @@ begin Result := True; end; -function TProjectResources.HasSystemResources: Boolean; +function TProjectResources.HasSystemResources(CheckLists: Boolean): Boolean; begin - Result := FSystemResources.Count > 0; + if CheckLists then + Result := FSystemResources.Count > 0 + else + Result := VersionInfo.HasAnySystemResource or + XPManifest.HasAnySystemResource or + ProjectIcon.HasAnySystemResource; end; -function TProjectResources.HasLazarusResources: Boolean; +function TProjectResources.HasLazarusResources(CheckLists: Boolean): Boolean; begin - Result := FLazarusResources.Count > 0; + if CheckLists then + Result := FLazarusResources.Count > 0 + else + Result := VersionInfo.HasAnyLazarusResource or + XPManifest.HasAnyLazarusResource or + ProjectIcon.HasAnyLazarusResource; end; procedure TProjectResources.WriteToProjectFile(AConfig: TXMLConfig; Path: String); @@ -310,8 +321,7 @@ var NamePos, InPos: integer; begin Result := True; - if not Update then - Exit; + CodeBuf := CodeToolBoss.LoadFile(AFilename, False, False); if CodeBuf <> nil then begin @@ -322,7 +332,7 @@ begin // update LResources uses if CodeToolBoss.FindUnitInAllUsesSections(CodeBuf, LazResourcesUnit, NamePos, InPos) then begin - if not HasLazarusResources then + if not HasLazarusResources(False) then begin if not CodeToolBoss.RemoveUnitFromAllUsesSections(CodeBuf, LazResourcesUnit) then begin @@ -333,7 +343,7 @@ begin end; end else - if HasLazarusResources then + if HasLazarusResources(False) then begin if not CodeToolBoss.AddUnitToMainUsesSection(CodeBuf, LazResourcesUnit,'') then begin @@ -349,7 +359,7 @@ begin NewTopLine, Filename, false) then begin // there is a resource directive in the source - if not HasSystemResources then + if not HasSystemResources(False) then begin if not CodeToolBoss.RemoveDirective(NewCode, NewX,NewY,true) then begin @@ -360,7 +370,7 @@ begin end; end else - if HasSystemResources then + if HasSystemResources(False) then begin if not CodeToolBoss.AddResourceDirective(CodeBuf, Filename,false,'{$IFDEF WINDOWS}{$R '+Filename+'}{$ENDIF}') then @@ -379,7 +389,7 @@ begin begin // there is a resource directive in the source //debugln(['TProjectResources.UpdateMainSourceFile include directive found']); - if not HasLazarusResources then + if not HasLazarusResources(False) then begin if not CodeToolBoss.RemoveDirective(NewCode, NewX,NewY,true) then begin @@ -391,7 +401,7 @@ begin end; end else - if HasLazarusResources then + if HasLazarusResources(False) then begin //debugln(['TProjectResources.UpdateMainSourceFile include directive not found']); if not CodeToolBoss.AddIncludeDirective(CodeBuf, diff --git a/ide/w32manifest.pas b/ide/w32manifest.pas index 40e9f4e77f..323e567437 100644 --- a/ide/w32manifest.pas +++ b/ide/w32manifest.pas @@ -47,6 +47,8 @@ type public function UpdateResources(AResources: TAbstractProjectResources; const MainFilename: string): Boolean; override; + function HasAnyLazarusResource: Boolean; override; + function HasAnySystemResource: Boolean; override; property UseManifest: boolean read FUseManifest write SetUseManifest; end; @@ -94,5 +96,15 @@ begin AResources.AddSystemResource(sManifest); end; +function TProjectXPManifest.HasAnyLazarusResource: Boolean; +begin + Result := False; +end; + +function TProjectXPManifest.HasAnySystemResource: Boolean; +begin + Result := UseManifest; +end; + end. diff --git a/ide/w32versioninfo.pas b/ide/w32versioninfo.pas index 324cf335bb..9c048db157 100644 --- a/ide/w32versioninfo.pas +++ b/ide/w32versioninfo.pas @@ -84,6 +84,8 @@ type procedure SetUseVersionInfo(const AValue: boolean); procedure SetVersionNr(const AValue: integer); public + function HasAnyLazarusResource: Boolean; override; + function HasAnySystemResource: Boolean; override; function UpdateResources(AResources: TAbstractProjectResources; const MainFilename: string): Boolean; override; property UseVersionInfo: boolean read FUseVersionInfo write SetUseVersionInfo; @@ -511,6 +513,16 @@ begin Modified:=true; end; +function TProjectVersionInfo.HasAnyLazarusResource: Boolean; +begin + Result := False; +end; + +function TProjectVersionInfo.HasAnySystemResource: Boolean; +begin + Result := UseVersionInfo; +end; + finalization FreeAndNil(fHexCharSets); FreeAndNil(fHexLanguages); diff --git a/ideintf/projectresourcesintf.pas b/ideintf/projectresourcesintf.pas index 5ca3f81f72..23e3347939 100644 --- a/ideintf/projectresourcesintf.pas +++ b/ideintf/projectresourcesintf.pas @@ -29,6 +29,8 @@ type FOnModified: TNotifyEvent; procedure SetModified(const AValue: boolean); public + function HasAnyLazarusResource: Boolean; virtual; abstract; + function HasAnySystemResource: Boolean; virtual; abstract; function UpdateResources(AResources: TAbstractProjectResources; const MainFilename: string): Boolean; virtual; abstract; constructor Create; virtual;