paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-28 01:37:20 +01:00
Code Issues Packages Projects Releases Wiki Activity

IDE: project options: more values for Win Vista DPI awarness. Issue #30170, modified patch by AlexeyT

Browse Source 
git-svn-id: trunk@53325 -
This commit is contained in:
ondrej 2016-11-09 09:15:34 +00:00
parent d725d7f542
commit 31944eda39
5 changed files with 183 additions and 106 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

162
ide/frames/project_application_options.lfm
View File

@ -15,7 +15,7 @@ object ProjectApplicationOptionsFrame: TProjectApplicationOptionsFrame
Width = 487 Width = 487
Align = alTop Align = alTop
Caption = 'AppSettingsGroupBox' Caption = 'AppSettingsGroupBox'
ClientHeight = 449 ClientHeight = 450
ClientWidth = 483 ClientWidth = 483
TabOrder = 0 TabOrder = 0
object TitleLabel: TLabel object TitleLabel: TLabel
@ -23,9 +23,9 @@ object ProjectApplicationOptionsFrame: TProjectApplicationOptionsFrame
AnchorSideTop.Control = TitleEdit AnchorSideTop.Control = TitleEdit
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
Left = 6 Left = 6
Height = 15 Height = 17
Top = 10 Top = 11
Width = 51 Width = 67
BorderSpacing.Left = 6 BorderSpacing.Left = 6
Caption = 'TitleLabel' Caption = 'TitleLabel'
ParentColor = False ParentColor = False
@ -34,9 +34,9 @@ object ProjectApplicationOptionsFrame: TProjectApplicationOptionsFrame
AnchorSideLeft.Control = AppSettingsGroupBox AnchorSideLeft.Control = AppSettingsGroupBox
AnchorSideTop.Control = IconPanel AnchorSideTop.Control = IconPanel
Left = 6 Left = 6
Height = 15 Height = 17
Top = 35 Top = 39
Width = 51 Width = 65
BorderSpacing.Left = 6 BorderSpacing.Left = 6
Caption = 'IconLabel' Caption = 'IconLabel'
ParentColor = False ParentColor = False
@ -48,9 +48,9 @@ object ProjectApplicationOptionsFrame: TProjectApplicationOptionsFrame
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = IconTrack AnchorSideRight.Control = IconTrack
Left = 240 Left = 240
Height = 15 Height = 17
Top = 176 Top = 182
Width = 80 Width = 101
BorderSpacing.Left = 6 BorderSpacing.Left = 6
BorderSpacing.Right = 6 BorderSpacing.Right = 6
Caption = 'IconTrackLabel' Caption = 'IconTrackLabel'
@ -58,7 +58,7 @@ object ProjectApplicationOptionsFrame: TProjectApplicationOptionsFrame
end end
object TitleEdit: TEdit object TitleEdit: TEdit
Left = 106 Left = 106
Height = 23 Height = 27
Top = 6 Top = 6
Width = 371 Width = 371
Align = alTop Align = alTop
@ -72,9 +72,9 @@ object ProjectApplicationOptionsFrame: TProjectApplicationOptionsFrame
AnchorSideTop.Control = DarwinDividerBevel AnchorSideTop.Control = DarwinDividerBevel
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 6 Left = 6
Height = 19 Height = 24
Top = 337 Top = 381
Width = 150 Width = 191
BorderSpacing.Left = 6 BorderSpacing.Left = 6
BorderSpacing.Top = 3 BorderSpacing.Top = 3
Caption = 'UseAppBundleCheckBox' Caption = 'UseAppBundleCheckBox'
@ -85,9 +85,9 @@ object ProjectApplicationOptionsFrame: TProjectApplicationOptionsFrame
AnchorSideTop.Control = WindowsDividerBevel AnchorSideTop.Control = WindowsDividerBevel
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 6 Left = 6
Height = 19 Height = 24
Top = 224 Top = 236
Width = 151 Width = 195
BorderSpacing.Left = 6 BorderSpacing.Left = 6
BorderSpacing.Top = 3 BorderSpacing.Top = 3
Caption = 'UseXPManifestCheckBox' Caption = 'UseXPManifestCheckBox'
@ -100,7 +100,7 @@ object ProjectApplicationOptionsFrame: TProjectApplicationOptionsFrame
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 106 Left = 106
Height = 128 Height = 128
Top = 35 Top = 39
Width = 128 Width = 128
BorderSpacing.Left = 106 BorderSpacing.Left = 106
BorderSpacing.Top = 6 BorderSpacing.Top = 6
@ -108,14 +108,14 @@ object ProjectApplicationOptionsFrame: TProjectApplicationOptionsFrame
BevelOuter = bvNone BevelOuter = bvNone
BorderWidth = 1 BorderWidth = 1
BorderStyle = bsSingle BorderStyle = bsSingle
ClientHeight = 124 ClientHeight = 126
ClientWidth = 124 ClientWidth = 126
TabOrder = 1 TabOrder = 1
object IconImage: TImage object IconImage: TImage
Left = 1 Left = 1
Height = 122 Height = 124
Top = 1 Top = 1
Width = 122 Width = 124
Align = alClient Align = alClient
Center = True Center = True
OnPictureChanged = IconImagePictureChanged OnPictureChanged = IconImagePictureChanged
@ -128,9 +128,9 @@ object ProjectApplicationOptionsFrame: TProjectApplicationOptionsFrame
AnchorSideBottom.Control = IconPanel AnchorSideBottom.Control = IconPanel
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 240 Left = 240
Height = 25 Height = 29
Top = 35 Top = 39
Width = 111 Width = 120
AutoSize = True AutoSize = True
BorderSpacing.Left = 6 BorderSpacing.Left = 6
Caption = 'LoadIconButton' Caption = 'LoadIconButton'
@ -142,9 +142,9 @@ object ProjectApplicationOptionsFrame: TProjectApplicationOptionsFrame
AnchorSideTop.Control = DefaultIconButton AnchorSideTop.Control = DefaultIconButton
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 240 Left = 240
Height = 25 Height = 29
Top = 97 Top = 109
Width = 109 Width = 117
AutoSize = True AutoSize = True
BorderSpacing.Top = 6 BorderSpacing.Top = 6
Caption = 'SaveIconButton' Caption = 'SaveIconButton'
@ -156,9 +156,9 @@ object ProjectApplicationOptionsFrame: TProjectApplicationOptionsFrame
AnchorSideTop.Control = SaveIconButton AnchorSideTop.Control = SaveIconButton
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 240 Left = 240
Height = 25 Height = 29
Top = 128 Top = 144
Width = 112 Width = 121
AutoSize = True AutoSize = True
BorderSpacing.Top = 6 BorderSpacing.Top = 6
Caption = 'ClearIconButton' Caption = 'ClearIconButton'
@ -172,8 +172,8 @@ object ProjectApplicationOptionsFrame: TProjectApplicationOptionsFrame
AnchorSideRight.Control = IconPanel AnchorSideRight.Control = IconPanel
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 106 Left = 106
Height = 40 Height = 46
Top = 163 Top = 167
Width = 128 Width = 128
Max = 0 Max = 0
OnChange = IconTrackChange OnChange = IconTrackChange
@ -182,55 +182,40 @@ object ProjectApplicationOptionsFrame: TProjectApplicationOptionsFrame
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
TabOrder = 2 TabOrder = 2
end end
object DpiAwareCheckBox: TCheckBox
AnchorSideLeft.Control = UseXPManifestCheckBox
AnchorSideTop.Control = UseXPManifestCheckBox
AnchorSideTop.Side = asrBottom
Left = 27
Height = 19
Top = 246
Width = 123
BorderSpacing.Left = 21
BorderSpacing.Top = 3
Caption = 'DpiAwareCheckBox'
TabOrder = 8
end
object UIAccessCheckBox: TCheckBox object UIAccessCheckBox: TCheckBox
AnchorSideLeft.Control = DpiAwareCheckBox
AnchorSideTop.Control = ExecutionLevelComboBox AnchorSideTop.Control = ExecutionLevelComboBox
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 27 Left = 27
Height = 19 Height = 24
Top = 294 Top = 331
Width = 119 Width = 152
BorderSpacing.Top = 3 BorderSpacing.Top = 3
Caption = 'UIAccessCheckBox' Caption = 'UIAccessCheckBox'
TabOrder = 10 TabOrder = 10
end end
object ExecutionLevelComboBox: TComboBox object ExecutionLevelComboBox: TComboBox
AnchorSideLeft.Control = ExecutionLevelLabel AnchorSideLeft.Control = DpiAwareComboBox
AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = DpiAwareComboBox
AnchorSideTop.Control = DpiAwareCheckBox
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 139 AnchorSideRight.Control = DpiAwareComboBox
Height = 23 AnchorSideRight.Side = asrBottom
Top = 268 Left = 195
Width = 338 Height = 31
Top = 297
Width = 282
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 6
BorderSpacing.Top = 3 BorderSpacing.Top = 3
ItemHeight = 15 ItemHeight = 0
Style = csDropDownList Style = csDropDownList
TabOrder = 9 TabOrder = 9
end end
object ExecutionLevelLabel: TLabel object ExecutionLevelLabel: TLabel
AnchorSideLeft.Control = DpiAwareCheckBox
AnchorSideTop.Control = ExecutionLevelComboBox AnchorSideTop.Control = ExecutionLevelComboBox
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
Left = 27 Left = 27
Height = 15 Height = 17
Top = 272 Top = 304
Width = 106 Width = 138
Caption = 'ExecutionLevelLabel' Caption = 'ExecutionLevelLabel'
ParentColor = False ParentColor = False
end end
@ -239,9 +224,9 @@ object ProjectApplicationOptionsFrame: TProjectApplicationOptionsFrame
AnchorSideTop.Control = LoadIconButton AnchorSideTop.Control = LoadIconButton
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 240 Left = 240
Height = 25 Height = 29
Top = 66 Top = 74
Width = 123 Width = 136
AutoSize = True AutoSize = True
BorderSpacing.Top = 6 BorderSpacing.Top = 6
Caption = 'DefaultIconButton' Caption = 'DefaultIconButton'
@ -252,8 +237,8 @@ object ProjectApplicationOptionsFrame: TProjectApplicationOptionsFrame
AnchorSideTop.Control = IconTrack AnchorSideTop.Control = IconTrack
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 6 Left = 6
Height = 15 Height = 17
Top = 206 Top = 216
Width = 471 Width = 471
Caption = 'For Windows' Caption = 'For Windows'
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
@ -265,8 +250,8 @@ object ProjectApplicationOptionsFrame: TProjectApplicationOptionsFrame
AnchorSideTop.Control = UIAccessCheckBox AnchorSideTop.Control = UIAccessCheckBox
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 6 Left = 6
Height = 15 Height = 17
Top = 319 Top = 361
Width = 471 Width = 471
Caption = 'For Darwin' Caption = 'For Darwin'
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
@ -279,9 +264,9 @@ object ProjectApplicationOptionsFrame: TProjectApplicationOptionsFrame
AnchorSideTop.Control = UseAppBundleCheckBox AnchorSideTop.Control = UseAppBundleCheckBox
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 27 Left = 27
Height = 25 Height = 29
Top = 362 Top = 411
Width = 155 Width = 177
AutoSize = True AutoSize = True
BorderSpacing.Left = 21 BorderSpacing.Left = 21
BorderSpacing.Top = 6 BorderSpacing.Top = 6
@ -289,6 +274,37 @@ object ProjectApplicationOptionsFrame: TProjectApplicationOptionsFrame
OnClick = CreateAppBundleButtonClick OnClick = CreateAppBundleButtonClick
TabOrder = 12 TabOrder = 12
end end
object DpiAwareLabel: TLabel
AnchorSideLeft.Control = UseXPManifestCheckBox
AnchorSideTop.Control = DpiAwareComboBox
AnchorSideTop.Side = asrCenter
Left = 27
Height = 17
Top = 270
Width = 103
BorderSpacing.Left = 21
BorderSpacing.Top = 3
Caption = 'DpiAwareLabel'
ParentColor = False
end
object DpiAwareComboBox: TComboBox
AnchorSideLeft.Control = ExecutionLevelLabel
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = UseXPManifestCheckBox
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = TitleEdit
AnchorSideRight.Side = asrBottom
Left = 195
Height = 31
Top = 263
Width = 282
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 30
BorderSpacing.Top = 3
ItemHeight = 0
Style = csDropDownList
TabOrder = 8
end
end end
object OpenPictureDialog1: TOpenPictureDialog object OpenPictureDialog1: TOpenPictureDialog
left = 385 left = 385

27
ide/frames/project_application_options.pas
View File

@ -18,11 +18,12 @@ type
AppSettingsGroupBox: TGroupBox; AppSettingsGroupBox: TGroupBox;
CreateAppBundleButton: TBitBtn; CreateAppBundleButton: TBitBtn;
DefaultIconButton: TButton; DefaultIconButton: TButton;
DpiAwareLabel: TLabel;
DpiAwareComboBox: TComboBox;
WindowsDividerBevel: TDividerBevel; WindowsDividerBevel: TDividerBevel;
DarwinDividerBevel: TDividerBevel; DarwinDividerBevel: TDividerBevel;
UIAccessCheckBox: TCheckBox; UIAccessCheckBox: TCheckBox;
ExecutionLevelComboBox: TComboBox; ExecutionLevelComboBox: TComboBox;
DpiAwareCheckBox: TCheckBox;
ClearIconButton: TBitBtn; ClearIconButton: TBitBtn;
IconImage: TImage; IconImage: TImage;
IconLabel: TLabel; IconLabel: TLabel;
@ -172,7 +173,8 @@ end;
procedure TProjectApplicationOptionsFrame.UseXPManifestCheckBoxChange(Sender: TObject); procedure TProjectApplicationOptionsFrame.UseXPManifestCheckBoxChange(Sender: TObject);
begin begin
DpiAwareCheckBox.Enabled := UseXPManifestCheckBox.Checked; DpiAwareLabel.Enabled := UseXPManifestCheckBox.Checked;
DpiAwareComboBox.Enabled := UseXPManifestCheckBox.Checked;
ExecutionLevelLabel.Enabled := UseXPManifestCheckBox.Checked; ExecutionLevelLabel.Enabled := UseXPManifestCheckBox.Checked;
ExecutionLevelComboBox.Enabled := UseXPManifestCheckBox.Checked; ExecutionLevelComboBox.Enabled := UseXPManifestCheckBox.Checked;
UIAccessCheckBox.Enabled := UseXPManifestCheckBox.Checked; UIAccessCheckBox.Enabled := UseXPManifestCheckBox.Checked;
@ -209,6 +211,8 @@ end;
procedure TProjectApplicationOptionsFrame.Setup(ADialog: TAbstractOptionsEditorDialog); procedure TProjectApplicationOptionsFrame.Setup(ADialog: TAbstractOptionsEditorDialog);
var var
ExecutionLevel: TXPManifestExecutionLevel; ExecutionLevel: TXPManifestExecutionLevel;
DpiLevel: TXPManifestDpiAware;
DpiLevelNames: array[TXPManifestDpiAware] of string;
begin begin
AppSettingsGroupBox.Caption := dlgApplicationSettings; AppSettingsGroupBox.Caption := dlgApplicationSettings;
TitleLabel.Caption := dlgPOTitle; TitleLabel.Caption := dlgPOTitle;
@ -219,10 +223,18 @@ begin
// Windows specific, Manifest // Windows specific, Manifest
WindowsDividerBevel.Caption := lisForWindows; WindowsDividerBevel.Caption := lisForWindows;
UseXPManifestCheckBox.Caption := dlgPOUseManifest; UseXPManifestCheckBox.Caption := dlgPOUseManifest;
DpiAwareCheckBox.Caption := dlgPODpiAware;
DpiAwareLabel.Caption := dlgPODpiAwareness;
DpiLevelNames[xmdaFalse] := dlgPODpiAwarenessOff;
DpiLevelNames[xmdaTrue] := dlgPODpiAwarenessOn;
DpiLevelNames[xmdaPerMonitor] := dlgPODpiAwarenessOldOffNewPerMonitor;
DpiLevelNames[xmdaTruePM] := dlgPODpiAwarenessOldOnNewPerMonitor;
ExecutionLevelLabel.Caption := dlgPOExecutionLevel; ExecutionLevelLabel.Caption := dlgPOExecutionLevel;
for ExecutionLevel := Low(TXPManifestExecutionLevel) to High(TXPManifestExecutionLevel) do for ExecutionLevel in TXPManifestExecutionLevel do
ExecutionLevelComboBox.Items.Add(ExecutionLevelToCaption[ExecutionLevel]^); ExecutionLevelComboBox.Items.Add(ExecutionLevelToCaption[ExecutionLevel]^);
for DpiLevel in TXPManifestDpiAware do
DpiAwareComboBox.Items.Add(DpiLevelNames[DpiLevel] + ' (' + ManifestDpiAwareValues[DpiLevel] + ')');
UIAccessCheckBox.Caption := dlgPOUIAccess; UIAccessCheckBox.Caption := dlgPOUIAccess;
// Darwin specific, Application Bundle // Darwin specific, Application Bundle
@ -260,11 +272,12 @@ begin
with ProjResources.XPManifest do with ProjResources.XPManifest do
begin begin
UseXPManifestCheckBox.Checked := UseManifest; UseXPManifestCheckBox.Checked := UseManifest;
DpiAwareCheckBox.Checked := DpiAware; DpiAwareComboBox.ItemIndex := Ord(DpiAware);
ExecutionLevelComboBox.ItemIndex := Ord(ExecutionLevel); ExecutionLevelComboBox.ItemIndex := Ord(ExecutionLevel);
UIAccessCheckBox.Checked := UIAccess; UIAccessCheckBox.Checked := UIAccess;
end; end;
DpiAwareCheckBox.Enabled := UseXPManifestCheckBox.Checked; DpiAwareLabel.Enabled := UseXPManifestCheckBox.Checked;
DpiAwareComboBox.Enabled := UseXPManifestCheckBox.Checked;
ExecutionLevelLabel.Enabled := UseXPManifestCheckBox.Checked; ExecutionLevelLabel.Enabled := UseXPManifestCheckBox.Checked;
ExecutionLevelComboBox.Enabled := UseXPManifestCheckBox.Checked; ExecutionLevelComboBox.Enabled := UseXPManifestCheckBox.Checked;
UIAccessCheckBox.Enabled := UseXPManifestCheckBox.Checked; UIAccessCheckBox.Enabled := UseXPManifestCheckBox.Checked;
@ -298,7 +311,7 @@ begin
with ProjResources.XPManifest do with ProjResources.XPManifest do
begin begin
UseManifest := UseXPManifestCheckBox.Checked; UseManifest := UseXPManifestCheckBox.Checked;
DpiAware := DpiAwareCheckBox.Checked; DpiAware := TXPManifestDpiAware(DpiAwareComboBox.ItemIndex);
ExecutionLevel := TXPManifestExecutionLevel(ExecutionLevelComboBox.ItemIndex); ExecutionLevel := TXPManifestExecutionLevel(ExecutionLevelComboBox.ItemIndex);
UIAccess := UIAccessCheckBox.Checked; UIAccess := UIAccessCheckBox.Checked;
end; end;

6
ide/lazarusidestrconsts.pas
View File

@ -2548,7 +2548,11 @@ resourcestring
dlgPOUseAppBundle = 'Use Application Bundle for running and debugging'; dlgPOUseAppBundle = 'Use Application Bundle for running and debugging';
dlgPOCreateAppBundle = 'Create Application Bundle'; dlgPOCreateAppBundle = 'Create Application Bundle';
dlgPOUseManifest = 'Use manifest file to enable themes'; dlgPOUseManifest = 'Use manifest file to enable themes';
dlgPODpiAware = 'Enabled DPI Awareness (for Vista+)'; dlgPODpiAwareness = 'DPI awareness';
dlgPODpiAwarenessOff = 'off';
dlgPODpiAwarenessOn = 'on';
dlgPODpiAwarenessOldOffNewPerMonitor = 'Vista-8: off, 8.1+: per monitor';
dlgPODpiAwarenessOldOnNewPerMonitor = 'Vista-8: on, 8.1+: per monitor';
dlgPOUIAccess = 'UI Access (uiAccess)'; dlgPOUIAccess = 'UI Access (uiAccess)';
dlgPOAsInvoker = 'as invoker (asInvoker)'; dlgPOAsInvoker = 'as invoker (asInvoker)';
dlgPOHighestAvailable = 'highest available (highestAvailable)'; dlgPOHighestAvailable = 'highest available (highestAvailable)';

2
ide/project.pp
View File

@ -1133,7 +1133,7 @@ function dbgs(Flags: TUnitInfoFlags): string; overload;
implementation implementation
const const
ProjectInfoFileVersion = 9; ProjectInfoFileVersion = 10;
ProjOptionsPath = 'ProjectOptions/'; ProjOptionsPath = 'ProjectOptions/';

92
ide/w32manifest.pas
View File

@ -48,15 +48,23 @@ type
xmelRequireAdministrator xmelRequireAdministrator
); );
TXPManifestDpiAware = (
xmdaFalse,
xmdaTrue,
xmdaPerMonitor,
xmdaTruePM
);
type
{ TProjectXPManifest } { TProjectXPManifest }
TProjectXPManifest = class(TAbstractProjectResource) TProjectXPManifest = class(TAbstractProjectResource)
private private
FExecutionLevel: TXPManifestExecutionLevel; FExecutionLevel: TXPManifestExecutionLevel;
FIsDpiaAware: boolean; FDpiAware: TXPManifestDpiAware;
FUIAccess: Boolean; FUIAccess: Boolean;
FUseManifest: boolean; FUseManifest: boolean;
procedure SetDpiAware(const AValue: boolean); procedure SetDpiAware(AValue: TXPManifestDpiAware);
procedure SetExecutionLevel(AValue: TXPManifestExecutionLevel); procedure SetExecutionLevel(AValue: TXPManifestExecutionLevel);
procedure SetUIAccess(AValue: Boolean); procedure SetUIAccess(AValue: Boolean);
procedure SetUseManifest(const AValue: boolean); procedure SetUseManifest(const AValue: boolean);
@ -67,7 +75,7 @@ type
procedure ReadFromProjectFile(AConfig: {TXMLConfig}TObject; const Path: String); override; procedure ReadFromProjectFile(AConfig: {TXMLConfig}TObject; const Path: String); override;
property UseManifest: boolean read FUseManifest write SetUseManifest; property UseManifest: boolean read FUseManifest write SetUseManifest;
property DpiAware: boolean read FIsDpiaAware write SetDpiAware; property DpiAware: TXPManifestDpiAware read FDpiAware write SetDpiAware;
property ExecutionLevel: TXPManifestExecutionLevel read FExecutionLevel write SetExecutionLevel; property ExecutionLevel: TXPManifestExecutionLevel read FExecutionLevel write SetExecutionLevel;
property UIAccess: Boolean read FUIAccess write SetUIAccess; property UIAccess: Boolean read FUIAccess write SetUIAccess;
end; end;
@ -78,10 +86,18 @@ const
'highestAvailable', 'highestAvailable',
'requireAdministrator' 'requireAdministrator'
); );
ManifestDpiAwareValues: array[TXPManifestDpiAware] of string = (
'False',
'True',
'Per-monitor',
'True/PM'
);
implementation implementation
const const
sManifestFileDataStart: String = sManifestFileData: String =
'<?xml version="1.0" encoding="UTF-8" standalone="yes"?>'#$D#$A+ '<?xml version="1.0" encoding="UTF-8" standalone="yes"?>'#$D#$A+
'<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">'#$D#$A+ '<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">'#$D#$A+
' <assemblyIdentity version="1.0.0.0" processorArchitecture="*" name="CompanyName.ProductName.YourApp" type="win32"/>'#$D#$A+ ' <assemblyIdentity version="1.0.0.0" processorArchitecture="*" name="CompanyName.ProductName.YourApp" type="win32"/>'#$D#$A+
@ -111,15 +127,27 @@ const
' <!-- Windows 10 -->'#$D#$A+ ' <!-- Windows 10 -->'#$D#$A+
' <supportedOS Id="{8e0f7a12-bfb3-4fe8-b9a5-48fd50a15a9a}" />'#$D#$A+ ' <supportedOS Id="{8e0f7a12-bfb3-4fe8-b9a5-48fd50a15a9a}" />'#$D#$A+
' </application>'#$D#$A+ ' </application>'#$D#$A+
' </compatibility>'#$D#$A; ' </compatibility>'#$D#$A+
sManifestFileDataEnd: String =
'</assembly>';
sManifestFileDataDpiAware: String =
' <asmv3:application xmlns:asmv3="urn:schemas-microsoft-com:asm.v3">'#$D#$A+ ' <asmv3:application xmlns:asmv3="urn:schemas-microsoft-com:asm.v3">'#$D#$A+
' <asmv3:windowsSettings xmlns="http://schemas.microsoft.com/SMI/2005/WindowsSettings">'#$D#$A+ ' <asmv3:windowsSettings xmlns="http://schemas.microsoft.com/SMI/2005/WindowsSettings">'#$D#$A+
' <dpiAware>true</dpiAware>'#$D#$A+ ' <dpiAware>%s</dpiAware>'#$D#$A+
' </asmv3:windowsSettings>'#$D#$A+ ' </asmv3:windowsSettings>'#$D#$A+
' </asmv3:application>'#$D#$A; ' </asmv3:application>'#$D#$A+
'</assembly>';
function StrToXPManifestDpiAware(const s: string): TXPManifestDpiAware;
begin
for Result:=Low(TXPManifestDpiAware) to High(TXPManifestDpiAware) do
if CompareText(s,ManifestDpiAwareValues[Result])=0 then exit;
Result:=xmdaFalse;
end;
function StrToXPManifestExecutionLevel(const s: string): TXPManifestExecutionLevel;
begin
for Result:=Low(TXPManifestExecutionLevel) to High(TXPManifestExecutionLevel) do
if CompareText(s,ExecutionLevelToStr[Result])=0 then exit;
Result:=xmelAsInvoker;
end;
procedure TProjectXPManifest.SetUseManifest(const AValue: boolean); procedure TProjectXPManifest.SetUseManifest(const AValue: boolean);
begin begin
@ -128,10 +156,10 @@ begin
Modified := True; Modified := True;
end; end;
procedure TProjectXPManifest.SetDpiAware(const AValue: boolean); procedure TProjectXPManifest.SetDpiAware(AValue: TXPManifestDpiAware);
begin begin
if FIsDpiaAware = AValue then exit; if FDpiAware = AValue then Exit;
FIsDpiaAware := AValue; FDpiAware := AValue;
Modified := True; Modified := True;
end; end;
@ -154,7 +182,7 @@ begin
inherited Create; inherited Create;
FIsDefaultOption := True; FIsDefaultOption := True;
UseManifest := False; UseManifest := False;
DpiAware := False; DpiAware := xmdaFalse;
ExecutionLevel := xmelAsInvoker; ExecutionLevel := xmelAsInvoker;
UIAccess := False; UIAccess := False;
end; end;
@ -174,10 +202,10 @@ begin
Res := TGenericResource.Create(RType, RName); Res := TGenericResource.Create(RType, RName);
RType.Free; //no longer needed RType.Free; //no longer needed
RName.Free; RName.Free;
ManifestFileData := Format(sManifestFileDataStart, [ExecutionLevelToStr[ExecutionLevel], BoolToStr(UIAccess, 'true', 'false')]); ManifestFileData := Format(sManifestFileData, [
if DpiAware then ExecutionLevelToStr[ExecutionLevel],
ManifestFileData := ManifestFileData + sManifestFileDataDpiAware; BoolToStr(UIAccess, 'true', 'false'),
ManifestFileData := ManifestFileData + sManifestFileDataEnd; ManifestDpiAwareValues[DpiAware]]);
Res.RawData.Write(ManifestFileData[1], Length(ManifestFileData)); Res.RawData.Write(ManifestFileData[1], Length(ManifestFileData));
AResources.AddSystemResource(Res); AResources.AddSystemResource(Res);
end; end;
@ -187,18 +215,34 @@ procedure TProjectXPManifest.WriteToProjectFile(AConfig: TObject;
const Path: String); const Path: String);
begin begin
TXMLConfig(AConfig).SetDeleteValue(Path+'General/UseXPManifest/Value', UseManifest, False); TXMLConfig(AConfig).SetDeleteValue(Path+'General/UseXPManifest/Value', UseManifest, False);
TXMLConfig(AConfig).SetDeleteValue(Path+'General/XPManifest/DpiAware/Value', DpiAware, False); TXMLConfig(AConfig).SetDeleteValue(Path+'General/XPManifest/DpiAware/Value', ManifestDpiAwareValues[DpiAware], ManifestDpiAwareValues[xmdaFalse]);
TXMLConfig(AConfig).SetDeleteValue(Path+'General/XPManifest/ExecutionLevel/Value', Ord(ExecutionLevel), 0); TXMLConfig(AConfig).SetDeleteValue(Path+'General/XPManifest/ExecutionLevel/Value', ExecutionLevelToStr[ExecutionLevel], ExecutionLevelToStr[xmelAsInvoker]);
TXMLConfig(AConfig).SetDeleteValue(Path+'General/XPManifest/UIAccess/Value', UIAccess, False); TXMLConfig(AConfig).SetDeleteValue(Path+'General/XPManifest/UIAccess/Value', UIAccess, False);
end; end;
procedure TProjectXPManifest.ReadFromProjectFile(AConfig: TObject; procedure TProjectXPManifest.ReadFromProjectFile(AConfig: TObject;
const Path: String); const Path: String);
var
Cfg: TXMLConfig;
begin begin
UseManifest := TXMLConfig(AConfig).GetValue(Path+'General/UseXPManifest/Value', False); Cfg := TXMLConfig(AConfig);
DpiAware := TXMLConfig(AConfig).GetValue(Path+'General/XPManifest/DpiAware/Value', False); UseManifest := Cfg.GetValue(Path+'General/UseXPManifest/Value', False);
ExecutionLevel := TXPManifestExecutionLevel(TXMLConfig(AConfig).GetValue(Path+'General/XPManifest/ExecutionLevel/Value', 0));
UIAccess := TXMLConfig(AConfig).GetValue(Path+'General/XPManifest/UIAccess/Value', False); //support prev values "True/False"
if Cfg.GetValue(Path+'Version/Value',0)<=9 then
begin
if Cfg.GetValue(Path+'General/XPManifest/DpiAware/Value', False) then
DpiAware := xmdaTrue
else
DpiAware := xmdaFalse;
end else
DpiAware := StrToXPManifestDpiAware(Cfg.GetValue(Path+'General/XPManifest/DpiAware/Value', ''));
if Cfg.GetValue(Path+'Version/Value',0)<=9 then
ExecutionLevel := TXPManifestExecutionLevel(Cfg.GetValue(Path+'General/XPManifest/ExecutionLevel/Value', 0))
else
ExecutionLevel := StrToXPManifestExecutionLevel(Cfg.GetValue(Path+'General/XPManifest/ExecutionLevel/Value', ''));
UIAccess := Cfg.GetValue(Path+'General/XPManifest/UIAccess/Value', False);
end; end;
initialization initialization