Making Delphi 2007 HighDPI-aware

[dummzeuch 1505]

5 hours ago, Attila Kovacs said:

Compatibility mode / HDPI / scale by application or something like that.

Hm, interesting. I didn't even know this is possible. At a first glance Delphi 2007 doesn't look too bad on a 4K monitor with scaling set to 125% or even 150%. (GExperts has has some problems though).

 

Unfortunately this seems to be a global setting for the executable rather than a setting for a shortcut only which makes it a lot less useful.

[Attila Kovacs 629]

2 minutes ago, dummzeuch said:

GExperts has has some problems though

Yessss, and AFAIR I tried to tell this but there was no reaction.

[Attila Kovacs 629]

10 minutes ago, dummzeuch said:

2007 doesn't look too bad on a 4K monitor

This is the unit I'm using to fix the issues in D2007. For things I'm using, could be incomplete.

The hardcoded address is for the latest IDE with all its patches, will only work with that obviously.

 

DzWiz.pas

Edited May 20, 2022 by Attila Kovacs

[dummzeuch 1505]

7 minutes ago, Attila Kovacs said:

Yessss, and AFAIR I tried to tell this but there was no reaction.

I don't remember that. I probably was busy at the time and then forgot about it. Did you file (a) bug report(s)?

[Attila Kovacs 629]

1 minute ago, dummzeuch said:

Did you file (a) bug report(s)?

Nah, I didn't want to bother with my problems, not that wild, I'm just using the formatter. (which by the way kills the IDE with the latest GE, which again IDC)

[Attila Kovacs 629]

procedure ResizeImageList(AImageList: TImageList; AWidth, AHeight: integer);
var
  i: integer;
  mb, ib, sib, smb: TBitmap;
  ilc: TImageList;
begin
  ilc := TImageList.Create(nil);
  try
    ilc.Width := AWidth;
    ilc.Height := AHeight;

    for i := 0 to AImageList.Count - 1 do
      ilc.AddImage(AImageList, i);

    ib := TBitmap.Create;
    mb := TBitmap.Create;
    try
      ib.Width := AImageList.Width;
      ib.Height := AImageList.Height;
      mb.Width := AImageList.Width;
      mb.Height := AImageList.Height;

      AImageList.BeginUpdate;
      try
        AImageList.SetSize(AWidth, AHeight);

        sib := TBitmap.Create;
        smb := TBitmap.Create;
        try
          sib.Width := AImageList.Width;
          sib.Height := AImageList.Height;
          sib.Canvas.FillRect(sib.Canvas.ClipRect);
          smb.Width := AImageList.Width;
          smb.Height := AImageList.Height;
          smb.Canvas.FillRect(smb.Canvas.ClipRect);
          for i := 0 to -1 + ilc.Count do
          begin
            ib.Canvas.FillRect(ib.Canvas.ClipRect);
            mb.Canvas.FillRect(mb.Canvas.ClipRect);

            ImageList_DrawEx(ilc.Handle, i, ib.Canvas.Handle, 0, 0, ib.Width, ib.Height, CLR_NONE, CLR_NONE, ILD_NORMAL);
            ImageList_DrawEx(ilc.Handle, i, mb.Canvas.Handle, 0, 0, mb.Width, mb.Height, CLR_NONE, CLR_NONE, ILD_MASK);

            sib.Canvas.StretchDraw(Rect(0, 0, sib.Width, sib.Width), ib);
            smb.Canvas.StretchDraw(Rect(0, 0, smb.Width, smb.Width), mb);
          end;
          AImageList.Add(sib, smb);
        finally
          sib.Free;
          smb.Free;
        end;
      finally
        AImageList.EndUpdate;
      end;
    finally
      ib.Free;
      mb.Free;
    end;
  finally
    ilc.Free;
  end;
end;

 

Edited May 20, 2022 by Attila Kovacs

[dummzeuch 1505]

Just in case anybody else is interested: The setting @Attila Kovacs was talking about is stored in the registry:

HKCU\SOFTWARE\Microsoft\Windows NT\CurrentVersion\AppCompatFlags\Layers

There are entries with the full path of the executable. In my case for Delphi 2007:

C:\Delphi\Delphi2007\bin\bds.exe

And a text value. which seems to contain entries separated by a space.

• Enabling the "High DPI scaling override" option adds a "HIGHDPIAWARE" value to that entry,
• Disbling it removes that entry

I'm not sure where the selection from the combo box is stored though. Possibly under

HKCU\SOFTWARE\Microsoft\Windows NT\CurrentVersion\AppCompatFlags\Compatibility Assistant\Store

There are again entries with the full path of the executable, but this time the data is binary so it's not easy to decode. All entries start with the letters SACP, whatever that means.

 

EDIT: No, changing that option did not make any difference there.

 

The selection in the combo box decides what is stored there too.

• Enabling the "High DPI scaling override" option and
  • selecting "Application" adds a "HIGHDPIAWARE" value
  • selecting "System" adds a "DPIUNAWARE" value
  • selecting "System (enhanced)" adds "GDIDPISCALING DPIUNAWARE"
• Disabling it removes these values.

As the entries refer to the absolute path of the executable rather than the shortcut, there seems to be no way to create separate entries for different shortcuts to an executable which is a bit inconvenient.

 

Maybe we should move this part of the conversation to a new thread? "Making older Delphi IDEs partially High DPI aware" or something?

Edited May 21, 2022 by dummzeuch

[Attila Kovacs 629]

11 minutes ago, dummzeuch said:

Maybe we should move this part of the conversation to a new thread? "Making older Delphi IDEs partially High DPI aware" or something?

Yes that would be cool. However, it's not just the IDE. I'm letting my old programs run this way, and they look just great. (Some extra code needed ofc.)

 

For my understanding adding the exe with full path to the first registry path you mention is enough.

 

Edited May 21, 2022 by Attila Kovacs

[dummzeuch 1505]

As for having the option to start with or without high DPI awareness: I just copied the bds.* files in my Delphi 2007 bin directory to hbds.* and created an entry for that under

HKCU\SOFTWARE\Microsoft\Windows NT\CurrentVersion\AppCompatFlags\Layers

for it. Now I can start the IDE as bds.exe with System High DPI settings and hbds.exe with Application High DPI settings.

 

I also tried to simply edit the application manifest of hbds.exe but that didn't work, unfortunately.

 

Not sure whether this will work with newer IDEs though, because Embarcadero "improved" their detection of tampering with the licensing.

Edited May 21, 2022 by dummzeuch

[Attila Kovacs 629]

reg /?

[dummzeuch 1505]

14 hours ago, Attila Kovacs said:

procedure ResizeImageList(AImageList: TImageList; AWidth, AHeight: integer);
var
  i: integer;
  mb, ib, sib, smb: TBitmap;
  ilc: TImageList;
begin
  ilc := TImageList.Create(nil);
  try
    ilc.Width := AWidth;
    ilc.Height := AHeight;

    for i := 0 to AImageList.Count - 1 do
      ilc.AddImage(AImageList, i);

    ib := TBitmap.Create;
    mb := TBitmap.Create;
    try
      ib.Width := AImageList.Width;
      ib.Height := AImageList.Height;
      mb.Width := AImageList.Width;
      mb.Height := AImageList.Height;

      AImageList.BeginUpdate;
      try
        AImageList.SetSize(AWidth, AHeight);

        sib := TBitmap.Create;
        smb := TBitmap.Create;
        try
          sib.Width := AImageList.Width;
          sib.Height := AImageList.Height;
          sib.Canvas.FillRect(sib.Canvas.ClipRect);
          smb.Width := AImageList.Width;
          smb.Height := AImageList.Height;
          smb.Canvas.FillRect(smb.Canvas.ClipRect);
          for i := 0 to -1 + ilc.Count do
          begin
            ib.Canvas.FillRect(ib.Canvas.ClipRect);
            mb.Canvas.FillRect(mb.Canvas.ClipRect);

            ImageList_DrawEx(ilc.Handle, i, ib.Canvas.Handle, 0, 0, ib.Width, ib.Height, CLR_NONE, CLR_NONE, ILD_NORMAL);
            ImageList_DrawEx(ilc.Handle, i, mb.Canvas.Handle, 0, 0, mb.Width, mb.Height, CLR_NONE, CLR_NONE, ILD_MASK);

            sib.Canvas.StretchDraw(Rect(0, 0, sib.Width, sib.Width), ib);
            smb.Canvas.StretchDraw(Rect(0, 0, smb.Width, smb.Width), mb);
          end;
          AImageList.Add(sib, smb);
        finally
          sib.Free;
          smb.Free;
        end;
      finally
        AImageList.EndUpdate;
      end;
    finally
      ib.Free;
      mb.Free;
    end;
  finally
    ilc.Free;
  end;
end;

Not sure what this was about, but it doesn't compile with Delphi 2007 because TImageList.SetSize does not yet exist.

 

[Attila Kovacs 629]

It was not for D2007 and it's just setting width and height.

 

Try this

 

procedure ResizeImageList(AImageList: TImageList; AWidth, AHeight: integer);
var
  i: integer;
  mb, ib, sib, smb: TBitmap;
  ilc: TImageList;
begin
  ilc := TImageList.Create(nil);
  try
    ilc.Width := AWidth;
    ilc.Height := AHeight;

    for i := 0 to AImageList.Count - 1 do
      ilc.AddImage(AImageList, i);

    ib := TBitmap.Create;
    mb := TBitmap.Create;
    try
      ib.Width := AImageList.Width;
      ib.Height := AImageList.Height;
      mb.Width := AImageList.Width;
      mb.Height := AImageList.Height;


      AImageList.Width := AWidth;
      AImageList.Height := AHeight;

      sib := TBitmap.Create;
      smb := TBitmap.Create;
      try
        sib.Width := AImageList.Width;
        sib.Height := AImageList.Height;
        sib.Canvas.FillRect(sib.Canvas.ClipRect);
        smb.Width := AImageList.Width;
        smb.Height := AImageList.Height;
        smb.Canvas.FillRect(smb.Canvas.ClipRect);
        for i := 0 to -1 + ilc.Count do
        begin
          ib.Canvas.FillRect(ib.Canvas.ClipRect);
          mb.Canvas.FillRect(mb.Canvas.ClipRect);

          ImageList_DrawEx(ilc.Handle, i, ib.Canvas.Handle, 0, 0, ib.Width, ib.Height, CLR_NONE, CLR_NONE, ILD_NORMAL);
          ImageList_DrawEx(ilc.Handle, i, mb.Canvas.Handle, 0, 0, mb.Width, mb.Height, CLR_NONE, CLR_NONE, ILD_MASK);

          sib.Canvas.StretchDraw(Rect(0, 0, sib.Width, sib.Width), ib);
          smb.Canvas.StretchDraw(Rect(0, 0, smb.Width, smb.Width), mb);
        end;
        AImageList.Add(sib, smb);
      finally
        sib.Free;
        smb.Free;
      end;
    finally
      ib.Free;
      mb.Free;
    end;
  finally
    ilc.Free;
  end;
end;

 

[dummzeuch 1505]

22 hours ago, Attila Kovacs said:

This is the unit I'm using to fix the issues in D2007. For things I'm using, could be incomplete.

The hardcoded address is for the latest IDE with all its patches, will only work with that obviously.

 

DzWiz.pas

As you might have guessed I am playing around with this code. It works fine for the object inspector (I have added code to also increase the font size). But it does nothing for the TVirtualTreeViews e.g. the Project Manager. As far as I understand it, it should set the DefaultNodeHeight by directly calling some method whose address is hard coded as you wrote above. My installation should contain all patches, but it doesn't work.

How did you determine that address?

Edit: I also tried to set the DefaultNodeHeight property via RTTI. It also didn't make any difference. But in the IDE Explorer the correct value was shown.

Edited May 21, 2022 by dummzeuch

[Attila Kovacs 629]

the address is TBaseVirtualTree.SetDefaultNodeHeight, and as the value is not dfm stored I have to call that

 and the project manager is working for me, 28pix nodeheight:

 

 

could be some interference with other experts?

 

[dummzeuch 1505]

1 hour ago, Attila Kovacs said:

the address is TBaseVirtualTree.SetDefaultNodeHeight, and as the value is not dfm stored I have to call that

 and the project manager is working for me, 28pix nodeheight:

 

 

could be some interference with other experts?

 

I am seeing two problems:

1. Simply setting the DefaultNodeHeight does not make any difference, regardless whether I use your hack or simply set it via RTTI.
2. When also assigning an OnMeasureItem event (via RTTI) that returns the correct node height, it works, but only when I click on an entry which causes that entry to be redrawn or when I load a new project. I tried to call TWinControl.Invalidate and sent a WM_Paint message to it but it didn't make any difference.

I have also temporarily disabled all experts which did not make any difference.

There is one difference between what your expert did and what I am currently trying: I want to have menu entries to turn this functionality on and off. I also want to make it use the "correct" size depending on the current DPI and the design DPI.

Edited May 21, 2022 by dummzeuch

[Attila Kovacs 629]

6 minutes ago, dummzeuch said:

which causes that entry to be redrawn or when I load a new project. I tried to call TWinControl.Invalidate and set a WM_Paint message to it but it didn't make any difference.

Yes, it's true, but after installing the wizard every time the IDE starts up the node heights are ok.

You have to invalidate the tree controls if you want an instant change.

I'd suggest you to check the registry from the wizard and if the IDE is in it patch the IDE otherwise do nothing.

 

[dummzeuch 1505]

49 minutes ago, Attila Kovacs said:

You have to invalidate the tree controls if you want an instant change.

That's what I meant by:

59 minutes ago, dummzeuch said:

I tried to call TWinControl.Invalidate

Oddly enough changing the font size takes effect immediately but still ignores the change to DefaultNodeHeight until I click on a tree node. And even then it only redraws that one tree node and the one that was selected previously.

[Attila Kovacs 629]

I'm not sure what TWincontrol.Invalidate calls as the actual classes are unknown for the wizard and I have no clue how RTTI works under D2007, that's why I had the hardcoded address.

[dummzeuch 1505]

TControl.Invalidate is virtual, so this should call the correct method of any derived class.

 

I'll post the RTTI code tomorrow when I'm back at my computer. It's actually quite simple and will work with any relevant version of Delphi, as long as the property is declared published.

Edited May 21, 2022 by dummzeuch

[Attila Kovacs 629]

Not if it's reintroduced/not overridden in the child class.

[dummzeuch 1505]

11 hours ago, Attila Kovacs said:

Not if it's reintroduced/not overridden in the child class.

If it is overridden, the correct method should automatically be called. If it is reintroduced, that's bad practice, in particular for such an important base method, and I doubt that any Borland/Codegear developer did this in the code of the IDE.

[Attila Kovacs 629]

do they have an own virtualtree? the one we know does not override it.

[dummzeuch 1505]

35 minutes ago, Attila Kovacs said:

do they have an own virtualtree? the one we know does not override it.

No idea. But I guess they would have overriden if that was necessary.

[dummzeuch 1505]

12 hours ago, dummzeuch said:

I'll post the RTTI code tomorrow when I'm back at my computer. It's actually quite simple and will work with any relevant version of Delphi, as long as the property is declared published.

uses
  TypInfo;

function TAdvancedObject_SetIntProperty(_Instance: TObject; const _Name: string; _Value: Integer): Boolean;
var
  PropInfo: PPropInfo;
begin
  PropInfo := GetPropInfo(_Instance.ClassInfo, _Name);
  Result := Assigned(PropInfo) and (PropInfo.PropType^.Kind = tkInteger);
  if Result then
    TypInfo.SetOrdProp(_Instance, PropInfo, _Value);
end;


  // called as

  TAdvancedObject_SetIntProperty(AComponent, 'DefaultNodeHeight', FVtNodeHeight);

 

[Attila Kovacs 629]

Thank you, this helps a lot, I wish I knew it earlier.

 

 

Edit:

Setting the Indent property changes the layout immediately, DefaultNodeHeight not.

I think if you need that on the fly you have to iterate through the nodes and set its height or invalidate them one by one.

But I would not do that as it makes no sense changing it runtime but as I said, checking at startup if the IDE is starting in HDPI mode or not via the registry.

 

 

 

Edited May 22, 2022 by Attila Kovacs