Changeset 248 for branches

Timestamp:

May 22, 2020, 7:08:10 PM (5 years ago)

Author:

chronos

Message:

• Fixed: Wrong font size in Help form.

Location:

branches/highdpi

Files:

• Packages/DpiControls/UDpiControls.pas (modified) (15 diffs)
• Start.pas (modified) (1 diff)

branches/highdpi/Packages/DpiControls/UDpiControls.pas

@@ -6 +6 @@
 
 uses
-  Windows, Classes, SysUtils, LCLProc, LResources, Forms, FormEditingIntf, ProjectIntf,
+  {$IFDEF WINDOWS}Windows, {$ENDIF}Classes, SysUtils, LCLProc, LResources, Forms, FormEditingIntf, ProjectIntf,
   Controls, StdCtrls, fgl, Graphics, ComCtrls, ExtCtrls, LCLType, GraphType,
   Types, CustApp, LMessages, LCLIntf, Menus;
@@ -59 +59 @@
     FOnChange: TNotifyEvent;
     FSize: Integer;
+    FHeight: Integer;
+    FPixelsPerInch: Integer;
+    FColor: TColor;
     function GetCharSet: TFontCharSet;
     function GetColor: TColor;
@@ -64 +67 @@
     function GetName: string;
     function GetPixelsPerInch: Integer;
+    function GetSize: Integer;
     function GetStyle: TFontStyles;
     function IsNameStored: Boolean;
@@ -75 +79 @@
     procedure DoChange;
     procedure SetStyle(AValue: TFontStyles);
+    procedure UpdateFont;
   protected
     procedure ScreenChanged;
@@ -88 +93 @@
     property Name: string read GetName write SetName stored IsNameStored;
     property Style: TFontStyles read GetStyle write SetStyle default [];
-    property Size: Integer read FSize write SetSize stored false;
+    property Size: Integer read GetSize write SetSize stored false;
     property PixelsPerInch: Integer read GetPixelsPerInch write SetPixelsPerInch;
     property Height: Integer read GetHeight write SetHeight default 0;
@@ -2275 +2280 @@
   if FSize = AValue then Exit;
   FSize := AValue;
-  GetNativeFont.Size := AValue;
+  FHeight := -MulDiv(FSize, FPixelsPerInch, 72);
+  UpdateFont;
   DoChange;
 end;
@@ -2287 +2293 @@
 begin
   GetNativeFont.Style := AValue;
+end;
+
+procedure TDpiFont.UpdateFont;
+begin
+  GetNativeFont.PixelsPerInch := FPixelsPerInch;
+  GetNativeFont.Size := FSize;
 end;
 
@@ -2308 +2320 @@
 procedure TDpiFont.SetPixelsPerInch(AValue: Integer);
 begin
-  GetNativeFont.PixelsPerInch := PixelsPerInch;
+  FPixelsPerInch := PixelsPerInch;
+  FHeight := -MulDiv(FSize, FPixelsPerInch, 72);
+  UpdateFont;
 end;
 
@@ -2318 +2332 @@
 function TDpiFont.GetColor: TColor;
 begin
-  Result := GetNativeFont.Color;
+  Result := FColor;
 end;
 
@@ -2333 +2347 @@
 function TDpiFont.GetPixelsPerInch: Integer;
 begin
-  Result := GetNativeFont.PixelsPerInch;
+  Result := FPixelsPerInch;
+end;
+
+function TDpiFont.GetSize: Integer;
+begin
+  Result := FSize;
 end;
 
@@ -2353 +2372 @@
 procedure TDpiFont.SetColor(AValue: TColor);
 begin
+  if FColor = AValue then Exit;
+  FColor := AValue;
   GetNativeFont.Color := AValue;
 end;
@@ -2358 +2379 @@
 procedure TDpiFont.SetHeight(AValue: Integer);
 begin
-  GetNativeFont.Height := AValue;
+  FHeight := AValue;
+  FSize := MulDiv(-FHeight, 72, FPixelsPerInch);
+  UpdateFont;
 end;
 
@@ -2368 +2391 @@
 constructor TDpiFont.Create;
 begin
+  FPixelsPerInch := DpiScreen.PixelsPerInch;
   Size := 8;
 end;
@@ -2381 +2405 @@
     GetNativeFont.Assign((Source as TDpiFont).GetNativeFont);
     Size := (Source as TDpiFont).Size;
+    Height := (Source as TDpiFont).Height;
+    PixelsPerInch := (Source as TDpiFont).PixelsPerInch;
     FOnChange := (Source as TDpiFont).FOnChange;
+    Color := (Source as TDpiFont).Color;
   end;
 end;
@@ -2582 +2609 @@
 procedure TDpiScreen.UpdateScreen;
 begin
-//  Dpi := 96 * 2;
   Dpi := Screen.PixelsPerInch;
 end;

branches/highdpi/Start.pas

@@ -48 +48 @@
     Bitmap: TDpiBitmap; { game world sample preview }
     Size: TPoint;
-    Colors: array [0 .. 11, 0 .. 1] of TColor;
+    Colors: array [0 .. $1f, 0 .. 1] of TColor;
     Mode: TMiniMode;
     procedure LoadFromLogFile(FileName: string; var LastTurn: Integer);