Как решить проблему с высоким DPI?

Вопрос 1: Есть ли у меня другой (лучший) вариант?

Вы можете использовать WMI в соответствии с вашим предыдущим вопросом: Как получить реальное разрешение экрана в системе с высоким разрешением?

Вопрос 2: Я пытался создать эту маленькую программу. Хотя он имеет около 10 строк кода, его размер EXE составляет 2,1 МБ, а объем памяти — 5,4 МБ! Могу ли я сделать его меньше?

Хитрость заключается в том, чтобы избежать использования каких-либо модулей VCL и свести к минимуму количество используемых модулей RTL. Ваша цель должна состоять в том, чтобы использовать только устройство Windows. Или даже избегайте этого и создайте собственный импорт Windows API только для тех функций, которые вам нужны.

Другим вариантом было бы создать эту программу с другим языком программирования, который лучше подходит для удаления мертвого кода. Я бы, вероятно, сделал это с помощью короткой программы на C.

Это 30 КБ с простой иконкой, 15 КБ, если вы UPX, скомпилировано с помощью Delphi 10 Seattle и занимает примерно 150-200 мс в моей системе.

program ScreenSupport;

{$APPTYPE CONSOLE}

{$WEAKLINKRTTI ON}
{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])}

uses
  Windows,
  Messages;

{$R *.res}

{$SetPEFlags $0200} // IMAGE_FILE_DEBUG_STRIPPED}      // $0200
{$SetPEFlags $0004} // IMAGE_FILE_LINE_NUMS_STRIPPED}  // $0004
{$SetPEFlags $0008} // IMAGE_FILE_LOCAL_SYMS_STRIPPED} // $0008
{$SetPEFlags $0001} // IMAGE_FILE_RELOCS_STRIPPED}     // $0001

Const WM_APP = $8000;
      msgSendScreenres = WM_APP+1;
      SM_CXVIRTUALSCREEN = 78;
      SM_CYVIRTUALSCREEN = 79;

function GetDesktopHeight: Integer;
begin
  Result := GetSystemMetrics(SM_CYVIRTUALSCREEN);
end;

function GetDesktopWidth: Integer;
begin
  Result := GetSystemMetrics(SM_CXVIRTUALSCREEN);
end;

procedure SendScreenRes(t: THandle);
begin
  if t = 0 then Exit;
  PostMessage(t,msgSendScreenres,GetDesktopWidth,GetDesktopHeight);
end;

function IsAnyParam(s: string): Boolean;
Var a: Integer;
begin
  Result := False;
  if ParamCount = 0 then Exit;
  for a := 1 to ParamCount do
   if ParamStr(a) = s then Exit(True);
end;

function StrToInt(const S: string): Integer;
Var E: Integer;
begin
  Val(S, Result, E);
end;

begin
// screen res requested
  if IsAnyParam('-screenres') then begin
    try
      SendScreenRes(StrToInt(ParamStr(2)));
    except
      Exit;
    end;
  end;
end.

Чтобы использовать его, вызовите его из основного приложения:

Const msgSendScreenres = WM_APP+1;

ShellExecute(0,'open','ScreenSupport.exe',PChar('-screenres '+IntToStr(Form1.Handle)),'',SW_HIDE);

затем добавьте это в частные объявления на основном блоке

procedure WMScreenRes(var Msg: TMessage); message msgSendScreenres;

тогда лови его

procedure TForm1.WMScreenRes(var Msg: TMessage);
begin
  ScreenWidth  := Msg.WParam;
  ScreenHeight := Msg.LParam;
end;