IDE: add option to enable/disable Application.Scaled in project file. Issue #31639

git-svn-id: trunk@54530 -
2025-04-07 13:38:00 +02:00 · 2017-04-05 19:29:05 +00:00 · 2017-04-05 19:29:05 +00:00 · fa7bf64041
commit fa7bf64041
parent b5ddafa8d2
9 changed files with 86 additions and 58 deletions
--- a/components/ideintf/projectintf.pas
+++ b/components/ideintf/projectintf.pas
@ -237,7 +237,8 @@ type
    pfMainUnitIsPascalSource,// main unit is pascal, even it does not end in .pas/.pp
    pfMainUnitHasUsesSectionForAllUnits,// add new units to main uses section
    pfMainUnitHasCreateFormStatements,// add/remove Application.CreateForm statements
-    pfMainUnitHasTitleStatement,// add/remove Application.Title:= statements
+    pfMainUnitHasTitleStatement,// add/remove Application.Title:= statement
+    pfMainUnitHasScaledStatement,// add/remove Application.Scaled:= statement
    pfRunnable, // project can be run
    pfAlwaysBuild, // skip IDE's smart check if compilation is needed and always compile
    pfUseDesignTimePackages, // compile design time packages to project
@ -555,6 +556,7 @@ const
                         pfMainUnitHasUsesSectionForAllUnits,
                         pfMainUnitHasCreateFormStatements,
                         pfMainUnitHasTitleStatement,
+                         pfMainUnitHasScaledStatement,
                         pfRunnable,
                         pfLRSFilesInOutputDirectory,
                         pfSaveJumpHistory,
@ -566,6 +568,7 @@ const
      'MainUnitHasUsesSectionForAllUnits',
      'MainUnitHasCreateFormStatements',
      'MainUnitHasTitleStatement',
+      'MainUnitHasScaledStatement',
      'Runnable',
      'AlwaysBuild',
      'UseDesignTimePackages',
--- a/components/instantfpc/instantfpcregisterlaz.pas
+++ b/components/instantfpc/instantfpcregisterlaz.pas
@ -58,7 +58,7 @@ constructor TProjectInstantFPCDescriptor.Create;
 begin
  inherited Create;
  Name:=ProjDescNameInstantFPCProject;
-  Flags:=Flags-[pfMainUnitHasCreateFormStatements,pfMainUnitHasTitleStatement]
+  Flags:=Flags-[pfMainUnitHasCreateFormStatements,pfMainUnitHasTitleStatement,pfMainUnitHasScaledStatement]
              +[pfUseDefaultCompilerOptions];
 end;

--- a/ide/frames/project_misc_options.lfm
+++ b/ide/frames/project_misc_options.lfm
@ -10,13 +10,13 @@ object ProjectMiscOptionsFrame: TProjectMiscOptionsFrame
  DesignTop = 188
  object Bevel1: TBevel
    AnchorSideLeft.Control = Owner
-    AnchorSideTop.Control = MainUnitHasTitleStatementCheckBox
+    AnchorSideTop.Control = MainUnitHasScaledStatementCheckBox
    AnchorSideTop.Side = asrBottom
    AnchorSideRight.Control = Owner
    AnchorSideRight.Side = asrBottom
    Left = 0
    Height = 3
-    Top = 120
+    Top = 125
    Width = 536
    Anchors = [akTop, akLeft, akRight]
    BorderSpacing.Top = 6
@ -26,9 +26,9 @@ object ProjectMiscOptionsFrame: TProjectMiscOptionsFrame
    AnchorSideTop.Control = MainUnitIsPascalSourceCheckBox
    AnchorSideTop.Side = asrBottom
    Left = 0
-    Height = 24
-    Top = 30
-    Width = 324
+    Height = 19
+    Top = 25
+    Width = 262
    BorderSpacing.Top = 6
    Caption = 'MainUnitHasUsesSectionForAllUnitsCheckBox'
    ParentShowHint = False
@ -40,9 +40,9 @@ object ProjectMiscOptionsFrame: TProjectMiscOptionsFrame
    AnchorSideTop.Control = MainUnitHasUsesSectionForAllUnitsCheckBox
    AnchorSideTop.Side = asrBottom
    Left = 0
-    Height = 24
-    Top = 60
-    Width = 324
+    Height = 19
+    Top = 50
+    Width = 262
    BorderSpacing.Top = 6
    Caption = 'MainUnitHasCreateFormStatementsCheckBox'
    ParentShowHint = False
@ -53,9 +53,9 @@ object ProjectMiscOptionsFrame: TProjectMiscOptionsFrame
    AnchorSideLeft.Control = Owner
    AnchorSideTop.Control = Owner
    Left = 0
-    Height = 24
+    Height = 19
    Top = 0
-    Width = 244
+    Width = 198
    Caption = 'MainUnitIsPascalSourceCheckBox'
    ParentShowHint = False
    ShowHint = True
@ -66,9 +66,9 @@ object ProjectMiscOptionsFrame: TProjectMiscOptionsFrame
    AnchorSideTop.Control = MainUnitHasCreateFormStatementsCheckBox
    AnchorSideTop.Side = asrBottom
    Left = 0
-    Height = 24
-    Top = 90
-    Width = 270
+    Height = 19
+    Top = 75
+    Width = 218
    BorderSpacing.Top = 6
    Caption = 'MainUnitHasTitleStatementCheckBox'
    ParentShowHint = False
@ -79,42 +79,42 @@ object ProjectMiscOptionsFrame: TProjectMiscOptionsFrame
    AnchorSideLeft.Control = Owner
    AnchorSideTop.Control = Bevel1
    Left = 0
-    Height = 24
-    Top = 126
-    Width = 150
+    Height = 19
+    Top = 131
+    Width = 122
    BorderSpacing.Top = 6
    Caption = 'RunnableCheckBox'
    ParentShowHint = False
    ShowHint = True
-    TabOrder = 4
+    TabOrder = 5
  end
  object AlwaysBuildCheckBox: TCheckBox
    AnchorSideLeft.Control = Owner
    AnchorSideTop.Control = UseDesignTimePkgsCheckBox
    AnchorSideTop.Side = asrBottom
    Left = 0
-    Height = 24
-    Top = 186
-    Width = 168
+    Height = 19
+    Top = 181
+    Width = 136
    BorderSpacing.Top = 6
    Caption = 'AlwaysBuildCheckBox'
    ParentShowHint = False
    ShowHint = True
-    TabOrder = 6
+    TabOrder = 7
  end
  object LRSInOutputDirCheckBox: TCheckBox
    AnchorSideLeft.Control = Owner
    AnchorSideTop.Control = AlwaysBuildCheckBox
    AnchorSideTop.Side = asrBottom
    Left = 0
-    Height = 24
-    Top = 216
-    Width = 190
+    Height = 19
+    Top = 206
+    Width = 154
    BorderSpacing.Top = 6
    Caption = 'LRSInOutputDirCheckBox'
    ParentShowHint = False
    ShowHint = True
-    TabOrder = 7
+    TabOrder = 8
  end
  object ResourceGroupBox: TGroupBox
    AnchorSideLeft.Control = Owner
@ -124,7 +124,7 @@ object ProjectMiscOptionsFrame: TProjectMiscOptionsFrame
    AnchorSideRight.Side = asrBottom
    Left = 0
    Height = 81
-    Top = 246
+    Top = 231
    Width = 536
    Anchors = [akTop, akLeft, akRight]
    BorderSpacing.Top = 6
@ -137,29 +137,29 @@ object ProjectMiscOptionsFrame: TProjectMiscOptionsFrame
    ChildSizing.ShrinkVertical = crsScaleChilds
    ChildSizing.Layout = cclLeftToRightThenTopToBottom
    ChildSizing.ControlsPerLine = 1
-    ClientHeight = 56
+    ClientHeight = 61
    ClientWidth = 532
-    TabOrder = 8
+    TabOrder = 9
    object UseFPCResourcesRadioButton: TRadioButton
      Left = 6
-      Height = 22
-      Top = 28
+      Height = 25
+      Top = 6
      Width = 520
      Caption = 'UseFPCResourcesRadioButton'
      ParentShowHint = False
      ShowHint = True
-      TabOrder = 1
+      TabOrder = 0
    end
    object UseLRSFilesRadioButton: TRadioButton
      Left = 6
-      Height = 22
-      Top = 6
+      Height = 24
+      Top = 31
      Width = 520
      Caption = 'UseLRSFilesRadioButton'
      Checked = True
      ParentShowHint = False
      ShowHint = True
-      TabOrder = 0
+      TabOrder = 1
      TabStop = True
    end
  end
@ -168,23 +168,23 @@ object ProjectMiscOptionsFrame: TProjectMiscOptionsFrame
    AnchorSideTop.Control = RunnableCheckBox
    AnchorSideTop.Side = asrBottom
    Left = 0
-    Height = 24
+    Height = 19
    Top = 156
-    Width = 221
+    Width = 179
    BorderSpacing.Top = 6
    Caption = 'UseDesignTimePkgsCheckBox'
    ParentShowHint = False
    ShowHint = True
-    TabOrder = 5
+    TabOrder = 6
  end
  object PathDelimLabel: TLabel
    AnchorSideLeft.Control = Owner
    AnchorSideTop.Control = PathDelimComboBox
    AnchorSideTop.Side = asrCenter
    Left = 0
-    Height = 20
-    Top = 346
-    Width = 105
+    Height = 15
+    Top = 331
+    Width = 83
    Caption = 'PathDelimLabel'
    ParentColor = False
  end
@ -196,7 +196,7 @@ object ProjectMiscOptionsFrame: TProjectMiscOptionsFrame
    AnchorSideRight.Side = asrBottom
    Left = 0
    Height = 3
-    Top = 333
+    Top = 318
    Width = 536
    Anchors = [akTop, akLeft, akRight]
    BorderSpacing.Top = 6
@ -207,14 +207,28 @@ object ProjectMiscOptionsFrame: TProjectMiscOptionsFrame
    AnchorSideTop.Control = Bevel2
    AnchorSideTop.Side = asrBottom
    AnchorSideRight.Side = asrBottom
-    Left = 111
-    Height = 28
-    Top = 342
+    Left = 89
+    Height = 23
+    Top = 327
    Width = 259
    BorderSpacing.Left = 6
    BorderSpacing.Top = 6
-    ItemHeight = 20
-    TabOrder = 9
+    ItemHeight = 15
+    TabOrder = 10
    Text = 'PathDelimComboBox'
  end
+  object MainUnitHasScaledStatementCheckBox: TCheckBox
+    AnchorSideLeft.Control = Owner
+    AnchorSideTop.Control = MainUnitHasTitleStatementCheckBox
+    AnchorSideTop.Side = asrBottom
+    Left = 0
+    Height = 19
+    Top = 100
+    Width = 229
+    BorderSpacing.Top = 6
+    Caption = 'MainUnitHasScaledStatementCheckBox'
+    ParentShowHint = False
+    ShowHint = True
+    TabOrder = 4
+  end
 end
--- a/ide/frames/project_misc_options.pas
+++ b/ide/frames/project_misc_options.pas
@ -21,6 +21,7 @@ type
    LRSInOutputDirCheckBox: TCheckBox;
    MainUnitHasCreateFormStatementsCheckBox: TCheckBox;
    MainUnitHasTitleStatementCheckBox: TCheckBox;
+    MainUnitHasScaledStatementCheckBox: TCheckBox;
    MainUnitHasUsesSectionForAllUnitsCheckBox: TCheckBox;
    MainUnitIsPascalSourceCheckBox: TCheckBox;
    PathDelimComboBox: TComboBox;
@ -58,8 +59,10 @@ begin
  MainUnitHasUsesSectionForAllUnitsCheckBox.Hint := lisNewUnitsAreAddedToUsesSections;
  MainUnitHasCreateFormStatementsCheckBox.Caption := lisMainUnitHasApplicationCreateFormStatements;
  MainUnitHasCreateFormStatementsCheckBox.Hint := lisUsedForAutoCreatedForms;
-  MainUnitHasTitleStatementCheckBox.Caption := lisMainUnitHasApplicationTitleStatements;
+  MainUnitHasTitleStatementCheckBox.Caption := lisMainUnitHasApplicationTitleStatement;
  MainUnitHasTitleStatementCheckBox.Hint := lisIdeMaintainsTheTitleInMainUnit;
+  MainUnitHasScaledStatementCheckBox.Caption := lisMainUnitHasApplicationScaledStatement;
+  MainUnitHasScaledStatementCheckBox.Hint := lisIdeMaintainsScaledInMainUnit;
  RunnableCheckBox.Caption := lisProjectIsRunnable;
  RunnableCheckBox.Hint := lisProjectIsRunnableHint;
  UseDesignTimePkgsCheckBox.Caption := lisUseDesignTimePackages;
@ -87,6 +90,7 @@ begin
    MainUnitHasUsesSectionForAllUnitsCheckBox.Checked := (pfMainUnitHasUsesSectionForAllUnits in Flags);
    MainUnitHasCreateFormStatementsCheckBox.Checked := (pfMainUnitHasCreateFormStatements in Flags);
    MainUnitHasTitleStatementCheckBox.Checked := (pfMainUnitHasTitleStatement in Flags);
+    MainUnitHasScaledStatementCheckBox.Checked := (pfMainUnitHasScaledStatement in Flags);
    RunnableCheckBox.Checked := (pfRunnable in Flags);
    UseDesignTimePkgsCheckBox.Checked := (pfUseDesignTimePackages in Flags);
    AlwaysBuildCheckBox.Checked := (pfAlwaysBuild in Flags);
@ -129,6 +133,8 @@ begin
                 MainUnitHasCreateFormStatementsCheckBox.Checked);
  SetProjectFlag(pfMainUnitHasTitleStatement,
                 MainUnitHasTitleStatementCheckBox.Checked);
+  SetProjectFlag(pfMainUnitHasScaledStatement,
+                 MainUnitHasScaledStatementCheckBox.Checked);
  SetProjectFlag(pfRunnable, RunnableCheckBox.Checked);
  SetProjectFlag(pfUseDesignTimePackages, UseDesignTimePkgsCheckBox.Checked);
  SetProjectFlag(pfAlwaysBuild, AlwaysBuildCheckBox.Checked);
--- a/ide/lazarusidestrconsts.pas
+++ b/ide/lazarusidestrconsts.pas
@ -2635,8 +2635,10 @@ resourcestring
    +'section containing all units of project';
  lisMainUnitHasApplicationCreateFormStatements = 'Main unit has Application.CreateForm statements';
  lisUsedForAutoCreatedForms = 'Used for auto-created forms.';
-  lisMainUnitHasApplicationTitleStatements = 'Main unit has Application.Title statements';
+  lisMainUnitHasApplicationTitleStatement = 'Main unit has Application.Title statement';
  lisIdeMaintainsTheTitleInMainUnit = 'The IDE maintains the title in main unit.';
+  lisMainUnitHasApplicationScaledStatement = 'Main unit has Application.Scaled statement';
+  lisIdeMaintainsScaledInMainUnit = 'The IDE maintains Application.Scaled (Hi-DPI) in main unit.';
  lisProjectIsRunnable = 'Project is runnable';
  lisProjectIsRunnableHint = 'Generates a binary executable which can be run.';
  lisUseDesignTimePackages = 'Use design time packages';
--- a/ide/main.pp
+++ b/ide/main.pp
@ -4968,7 +4968,8 @@ var
    OldScaled, NewScaled: Boolean;
  begin
    Result := True;
-    if (AProject.MainUnitID < 0) then
+    if (AProject.MainUnitID < 0) or
+      (not (pfMainUnitHasScaledStatement in AProject.Flags)) then
      Exit;
    OldScaled := GetScaled;

--- a/ide/project.pp
+++ b/ide/project.pp
@ -2779,6 +2779,7 @@ begin
    SetFlag(pfMainUnitHasUsesSectionForAllUnits, OldProjectType in [ptProgram,ptApplication]);
    SetFlag(pfMainUnitHasCreateFormStatements, OldProjectType in [ptApplication]);
    SetFlag(pfMainUnitHasTitleStatement,OldProjectType in [ptApplication]);
+    SetFlag(pfMainUnitHasScaledStatement,OldProjectType in [ptApplication]);
    SetFlag(pfRunnable, OldProjectType in [ptProgram,ptApplication,ptCustomProgram]);
  end;
  Flags:=Flags-[pfUseDefaultCompilerOptions];
@ -5843,7 +5844,7 @@ begin

  if (MainUnitID>=0) then begin
    if Requires(PackageGraph.LCLPackage,true)
-    and (Flags*[pfMainUnitHasCreateFormStatements,pfMainUnitHasTitleStatement]<>[])
+    and (Flags*[pfMainUnitHasCreateFormStatements,pfMainUnitHasTitleStatement,pfMainUnitHasScaledStatement]<>[])
    then begin
      // this is a probably a LCL project where the main source only contains
      // automatic code
--- a/ide/projectdefs.pas
+++ b/ide/projectdefs.pas
@ -1323,7 +1323,7 @@ constructor TProjectSimpleProgramDescriptor.Create;
 begin
  inherited Create;
  Name:=ProjDescNameSimpleProgram;
-  Flags:=Flags-[pfMainUnitHasCreateFormStatements,pfMainUnitHasTitleStatement]
+  Flags:=Flags-[pfMainUnitHasCreateFormStatements,pfMainUnitHasTitleStatement,pfMainUnitHasScaledStatement]
              +[pfUseDefaultCompilerOptions];
 end;

@ -1373,7 +1373,7 @@ constructor TProjectProgramDescriptor.Create;
 begin
  inherited Create;
  Name:=ProjDescNameProgram;
-  Flags:=Flags-[pfMainUnitHasCreateFormStatements,pfMainUnitHasTitleStatement]
+  Flags:=Flags-[pfMainUnitHasCreateFormStatements,pfMainUnitHasTitleStatement,pfMainUnitHasScaledStatement]
              +[pfUseDefaultCompilerOptions];
 end;

@ -1435,7 +1435,8 @@ begin
  Name:=ProjDescNameCustomProgram;
  Flags:=Flags-[pfMainUnitHasUsesSectionForAllUnits,
                pfMainUnitHasCreateFormStatements,
-                pfMainUnitHasTitleStatement]
+                pfMainUnitHasTitleStatement,
+                pfMainUnitHasScaledStatement]
              +[pfUseDefaultCompilerOptions];
  FAddMainSource:=true;
 end;
@ -1505,7 +1506,7 @@ constructor TProjectConsoleApplicationDescriptor.Create;
 begin
  inherited Create;
  Name:=ProjDescNameConsoleApplication;
-  Flags:=Flags-[pfMainUnitHasCreateFormStatements,pfMainUnitHasTitleStatement]
+  Flags:=Flags-[pfMainUnitHasCreateFormStatements,pfMainUnitHasTitleStatement,pfMainUnitHasScaledStatement]
              +[pfUseDefaultCompilerOptions];
 end;

@ -1675,7 +1676,7 @@ constructor TProjectLibraryDescriptor.Create;
 begin
  inherited Create;
  Name:=ProjDescNameLibrary;
-  Flags:=Flags-[pfMainUnitHasCreateFormStatements,pfMainUnitHasTitleStatement]
+  Flags:=Flags-[pfMainUnitHasCreateFormStatements,pfMainUnitHasTitleStatement,pfMainUnitHasScaledStatement]
              +[pfUseDefaultCompilerOptions];
 end;

--- a/ide/sourcefilemanager.pas
+++ b/ide/sourcefilemanager.pas
@ -3882,7 +3882,7 @@ begin
      end;
      if (Project1.MainUnitInfo<>nil)
      and ((Project1.FirstUnitWithEditorIndex=nil)
-       or ([pfMainUnitHasCreateFormStatements,pfMainUnitHasTitleStatement]*Project1.Flags=[]))
+       or ([pfMainUnitHasCreateFormStatements,pfMainUnitHasTitleStatement,pfMainUnitHasScaledStatement]*Project1.Flags=[]))
      then begin
        // the project has not created any secondary files
        // or the project main source is not auto updated by the IDE