• R/O
  • SSH
  • HTTPS

dzprepbuild: Commit


Commit MetaInfo

Révision71 (tree)
l'heure2019-01-30 22:35:20
Auteurtwm

Message de Log

new options to enable / disable theming

Change Summary

Modification

--- trunk/src/PrepBuild.dproj (revision 70)
+++ trunk/src/PrepBuild.dproj (revision 71)
@@ -94,7 +94,7 @@
9494 <DCC_Optimize>False</DCC_Optimize>
9595 </PropertyGroup>
9696 <PropertyGroup Condition="'$(Cfg_2_Win32)'!=''">
97- <Debugger_RunParams>--ReadDof=testdata\Testproject --IncBuild --updatedof=testdata\Testproject --writerc=testdata\Testproject</Debugger_RunParams>
97+ <Debugger_RunParams>--incbuild --BuildDateTime={today} --readini=testdata\testproject --updateini=testdata\testproject --WriteRc=testdata\testproject --InputManifest=testdata\testproject.manifest.in --manifest=testdata\testproject --updatemanifest --WriteManifestRc=testdata\testproject --theming=on</Debugger_RunParams>
9898 <VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
9999 <VerInfo_Locale>1033</VerInfo_Locale>
100100 </PropertyGroup>
--- trunk/src/d_ManifestVersionInfo.pas (revision 70)
+++ trunk/src/d_ManifestVersionInfo.pas (revision 71)
@@ -14,12 +14,20 @@
1414 i_VersionInfoAccess;
1515
1616 type
17- Tdm_ManifestVersionInfo = class(TDataModule, IVersionInfoAccess)
17+ IThemingAccess = interface ['{AFA7C417-A4E7-43DB-A2BF-49C2157A33E7}']
18+ procedure DisableTheming;
19+ procedure EnableTheming;
20+ end;
21+
22+type
23+ Tdm_ManifestVersionInfo = class(TDataModule, IVersionInfoAccess, IThemingAccess)
1824 ProjDoc: TXMLDocument;
1925 private
2026 FInputFilename: string;
2127 FOutputFilename: string;
2228 FDescriptionNode: IXMLNode;
29+ FAssemblyIdentityNode: IXMLNode;
30+ function FindComCtlNode(out _DependentAssemblyNode: IXMLNode): boolean;
2331 protected // IInterface
2432 FRefCount: Integer;
2533 function QueryInterface(const IID: TGUID; out Obj): HResult; override; stdcall;
@@ -29,8 +37,10 @@
2937 function VerInfoFilename: string;
3038 procedure ReadFromFile(_VerInfo: TVersionInfo);
3139 procedure WriteToFile(_VerInfo: TVersionInfo);
40+ protected // IThemingAccess
41+ procedure DisableTheming;
42+ procedure EnableTheming;
3243 protected
33- FAssemblyIdentityNode: IXMLNode;
3444 procedure InitVersionNodes; virtual;
3545 public
3646 constructor Create(const _ManifestFile: string; const _InputFile: string = ''); reintroduce;
@@ -61,6 +71,7 @@
6171
6272 TFileSystem.FileExists(FInputFilename, True);
6373
74+ ProjDoc.Options := ProjDoc.Options + [doNodeAutoIndent] - [doNodeAutoCreate, doAttrNull, doAutoSave];
6475 ProjDoc.FileName := FInputFilename;
6576 ProjDoc.Active := True;
6677
@@ -80,14 +91,100 @@
8091 // end;
8192 //end;
8293
94+function Tdm_ManifestVersionInfo.FindComCtlNode(out _DependentAssemblyNode: IXMLNode): boolean;
95+var
96+ AssemblyNode: IXMLNode;
97+ DependencyNode: IXMLNode;
98+ DependentAssemblyNode: IXMLNode;
99+ AssemblyIdentityNode: IXMLNode;
100+begin
101+ Result := False;
102+ AssemblyNode := ProjDoc.DocumentElement;
103+ DependencyNode := AssemblyNode.ChildNodes.FindNode('dependency');
104+ while Assigned(DependencyNode) do begin
105+ DependentAssemblyNode := DependencyNode.ChildNodes.FindNode('dependentAssembly');
106+ if not Assigned(DependentAssemblyNode) then begin
107+ // This is an error:
108+ // According to https://docs.microsoft.com/en-us/windows/desktop/sbscs/application-manifests
109+ // the dependency node must contain at least one dependendAssembly node.
110+ Exit; //==>
111+ end;
112+ AssemblyIdentityNode := DependentAssemblyNode.ChildNodes.FindNode('assemblyIdentity');
113+ if not Assigned(AssemblyIdentityNode) then begin
114+ // This is an error:
115+ // According to https://docs.microsoft.com/en-us/windows/desktop/sbscs/application-manifests
116+ // the dependendAssembly node must contain exactly one assemblyIdentityNode node.
117+ Exit; //==>
118+ end;
119+ if not AssemblyIdentityNode.HasAttribute('name') then begin
120+ // this is an error
121+ Exit;
122+ end;
123+ if AssemblyIdentityNode.Attributes['name'] = 'Microsoft.Windows.Common-Controls' then begin
124+ Result := True;
125+ _DependentAssemblyNode := DependentAssemblyNode;
126+ Exit; //==>
127+ end;
128+ DependentAssemblyNode := nil;
129+ DependencyNode := DependencyNode.NextSibling;
130+ end;
131+end;
132+
133+procedure Tdm_ManifestVersionInfo.DisableTheming;
134+var
135+ DependentAssemblyNode: IXMLNode;
136+ DependencyNode: IXMLNode;
137+ AssemblyNode: IXMLNode;
138+ DependencyIdx: Integer;
139+begin
140+ if not FindComCtlNode(DependentAssemblyNode) then begin
141+ // Node does not exist, so theming is already disabled
142+ Exit; //==>
143+ end;
144+
145+ AssemblyNode := ProjDoc.DocumentElement;
146+ DependencyNode := DependentAssemblyNode.ParentNode;
147+ DependentAssemblyNode := nil;
148+
149+ DependencyIdx := AssemblyNode.ChildNodes.IndexOf(DependencyNode);
150+ AssemblyNode.ChildNodes.Delete(DependencyIdx);
151+end;
152+
153+procedure Tdm_ManifestVersionInfo.EnableTheming;
154+var
155+ DependentAssemblyNode: IXMLNode;
156+ DependencyNode: IXMLNode;
157+ AssemblyNode: IXMLNode;
158+ DescriptionIdx: Integer;
159+begin
160+ if FindComCtlNode(DependentAssemblyNode) then begin
161+ // Node already exists, so theming is already enabled
162+ Exit; //==>
163+ end;
164+
165+ AssemblyNode := ProjDoc.DocumentElement;
166+
167+ // we must insert the dependency element before the description element, otherwise the application won't start
168+ DescriptionIdx := AssemblyNode.ChildNodes.IndexOf('description');
169+
170+ DependencyNode := AssemblyNode.AddChild('dependency', DescriptionIdx);
171+ DependentAssemblyNode := DependencyNode.AddChild('dependentAssembly');
172+ DependentAssemblyNode.Attributes['type'] := 'win32';
173+ DependentAssemblyNode.Attributes['name'] := 'Microsoft.Windows.Common-Controls';
174+ DependentAssemblyNode.Attributes['version'] := '6.0.0.0';
175+ DependentAssemblyNode.Attributes['publicKeyToken'] := '6595b64144ccf1df';
176+ DependentAssemblyNode.Attributes['language'] := '*';
177+ DependentAssemblyNode.Attributes['processorArchitecture'] := '*';
178+end;
179+
83180 procedure Tdm_ManifestVersionInfo.InitVersionNodes;
84181 var
85- Assembly: IXMLNode;
182+ AssemblyNode: IXMLNode;
86183 begin
87- Assembly := ProjDoc.DocumentElement;
184+ AssemblyNode := ProjDoc.DocumentElement;
88185
89- FAssemblyIdentityNode := Assembly.ChildNodes['assemblyIdentity'];
90- FDescriptionNode := Assembly.ChildNodes['description'];
186+ FAssemblyIdentityNode := AssemblyNode.ChildNodes['assemblyIdentity'];
187+ FDescriptionNode := AssemblyNode.ChildNodes['description'];
91188 end;
92189
93190 function Tdm_ManifestVersionInfo.VerInfoFilename: string;
--- trunk/src/u_PrepBuildMain.pas (revision 70)
+++ trunk/src/u_PrepBuildMain.pas (revision 71)
@@ -247,6 +247,8 @@
247247 Manifest: string;
248248 IgnoreManifestErrors: Boolean;
249249 s: string;
250+ Theming: string;
251+ ThemingAccess: IThemingAccess;
250252 begin
251253 try
252254 WriteLn('dzPrepBuild version ' + TApplication_GetFileVersion + ' built ' + TApplication_GetProductVersion);
@@ -449,6 +451,16 @@
449451 else
450452 IgnoreManifestErrors := False;
451453
454+ if FGetOpt.OptionPassed('Theming', Param) then begin
455+ if SameText(Param, 'ON') then
456+ Theming := 'ON'
457+ else if SameText(Param, 'OFF') then
458+ Theming := 'OFF'
459+ else
460+ raise Exception.CreateFmt(_('Parameter for Theming ("%s") must be ON or OFF'), [Param]);
461+ end else
462+ Theming := '';
463+
452464 if FGetOpt.OptionPassed('UpdateManifest') then begin
453465 try
454466 if InputManifest <> '' then
@@ -455,6 +467,16 @@
455467 WriteLn('Reading manifest from ', InputManifest);
456468 VerInfoAccess := Tdm_ManifestVersionInfo.Create(Manifest, InputManifest);
457469 WriteLn('Updating ', VerInfoAccess.VerInfoFilename);
470+ if Theming <> '' then begin
471+ ThemingAccess := VerInfoAccess as IThemingAccess;
472+ if Theming = 'ON' then begin
473+ WriteLn('Enableing theme support');
474+ ThemingAccess.EnableTheming;
475+ end else begin
476+ WriteLn('Disableing theme support');
477+ ThemingAccess.DisableTheming;
478+ end;
479+ end;
458480 VerInfoAccess.WriteToFile(VersionInfo);
459481 except
460482 on e: Exception do begin
@@ -549,6 +571,7 @@
549571 FGetOpt.RegisterOption('Manifest', _('Name of the .manifest file for the UpdateManifest and WriteManifestRc options'), True);
550572 FGetOpt.RegisterOption('UpdateManifest', _('update the .manifest file (given with the Manifest option) with the version information'));
551573 FGetOpt.RegisterOption('IgnoreManifestErrors', _('ignore any errors caused by the UpdateManifest option'));
574+ FGetOpt.RegisterOption('Theming', _('Set theming support: Value must be ON or OFF'), True);
552575 FGetOpt.RegisterOption('WriteManifestRc', _('Write an .rc file for embedding the .manifest file given with the Manifest option'), True);
553576
554577 FGetOpt.RegisterOption('Icon', _('Assign an icon file to add to the .rc file'), True);
Afficher sur ancien navigateur de dépôt.