1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:

...

private
    { Private-Deklarationen }
    FontDoFix     : Boolean; // für Bestimmung der eingestellten Schriftgrösse
    FontDesignRes : Integer; // ----- ebenfalls ----

    procedure FixSize;    // zur Bestimmung der Schriftgrösse

...

procedure TForm1.FormCreate(Sender: TObject);
begin
 FontDoFix := True;                { zur Ermittlung der Schriftgroesse}
 FontDesignRes := 96;
end;

...

procedure TForm1.FormShow(Sender: TObject);
begin
 FixSize;                         // an Schriftart anpassen 
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:

...

procedure TForm1.FixSize;
begin
  if FontDoFix then
    begin
      PixelsPerInch := Screen.PixelsPerInch;
      if (PixelsPerInch <> FontDesignRes) then
        begin
          Width := LongInt(Width * PixelsPerInch) div FontDesignRes;
          Height := LongInt(Height * PixelsPerInch) div FontDesignRes;
        end;
      FontDoFix := False;
    end;
end;

....                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:

function GetFontSize: Boolean; 
var 
  size: Integer; 
  handler:  THandle; 
begin 
  Result   := False; 
  handler := GetDc(HWND_DESKTOP); 
  size := GetDeviceCaps(handler, logpixelsx); 
  ReleaseDc(HWND_DESKTOP, handler); 
  if size = 96 then Result := False 
  else if size = 120 then Result := True; 
end;