fontsize scaling fixed

norgepaul · Nov 30, 2020 · adf5f73 · adf5f73
1 parent 31cf05f
commit adf5f73
Show file tree

Hide file tree

Showing 5 changed files with 21 additions and 5 deletions.
diff --git a/Demo/frmMainU.pas b/Demo/frmMainU.pas
@@ -2021,7 +2021,7 @@ procedure TfrmMain.ChromeTabs2AfterDrawItem(Sender: TObject;
 
   if (ChromeTabs2.Tabs.Count = 0) and (ItemType = itTabContainer) and (ChromeTabs2.ActiveDragTabObject = nil) then
   begin
-    TabsFont := TGPFont.Create(ChromeTabs2.LookAndFeel.Tabs.DefaultFont.Name, 11);
+    TabsFont := TGPFont.Create(ChromeTabs2.LookAndFeel.Tabs.DefaultFont.Name, ChromeTabs2.ScaledFontSize(11));
     TabsTxtBrush := TGPSolidBrush.Create(MakeGDIPColor(clWhite, 255));
     try
       TargetCanvas.SetSmoothingMode(ChromeTabs2.Options.Display.Tabs.CanvasSmoothingMode);

diff --git a/Lib/ChromeTabs.pas b/Lib/ChromeTabs.pas
@@ -444,6 +444,7 @@   TCustomChromeTabs = class(TCustomControl, IChromeTabs, IChromeTabDockControl)
     procedure SetDefaultOptions;
     procedure InvalidateAllControls;
     function ScaledPixels(pPixels: Integer): Integer;
+    function ScaledFontSize(fFontSize : Integer) : Integer;
 
     property ActiveDragTabObject: IDragTabObject read FActiveDragTabObject;
     property TabControls[Index: Integer]: TChromeTabControl read GetTabControl;
@@ -2693,6 +2694,20 @@ procedure TCustomChromeTabs.SaveOptions(Stream: TStream);
   end;
 end;
 
+function TCustomChromeTabs.ScaledFontSize(fFontSize: Integer): Integer;
+var
+  font : TFont;
+begin
+  font := TFont.Create;
+  try
+    font.Size := fFontSize;
+    font.Height := ScaledPixels(font.Height);
+    Result := font.Size;
+  finally
+    font.Free;
+  end;
+end;
+
 function TCustomChromeTabs.ScaledPixels(pPixels: Integer): Integer;
 begin
   Result := MulDiv(pPixels, {$if CompilerVersion > 31}Self.FCurrentPPI{$else}Screen.PixelsPerInch{$ifend}, 96);

diff --git a/Lib/ChromeTabsClasses.pas b/Lib/ChromeTabsClasses.pas
@@ -1207,6 +1207,7 @@   TOptions = class(TChromeTabsPersistent)
     function GetComponentState: TComponentState;
     function IsDragging: Boolean;
     function ScaledPixels(pPixels: Integer): Integer;
+    function ScaledFontSize(fFontSize : Integer) : Integer;
 
     function GetLookAndFeel: TChromeTabsLookAndFeel;
     function GetOptions: TOptions;

diff --git a/Lib/ChromeTabsControls.pas b/Lib/ChromeTabsControls.pas
@@ -934,7 +934,7 @@ function TChromeTabControl.GetTabWidthByContent: Integer;
 
     TabCanvas := TGPGraphics.Create(Bitmap.Canvas.Handle);
     TabsFont := TGPFont.Create(FChromeTabControlPropertyItems.StopTabProperties.FontName,
-                               FChromeTabControlPropertyItems.CurrentTabProperties.FontSize);
+                               FChromeTabs.ScaledFontSize(FChromeTabControlPropertyItems.CurrentTabProperties.FontSize));
     TxtFormat := TGPStringFormat.Create;
     try
       TabCanvas.SetTextRenderingHint(FChromeTabControlPropertyItems.StopTabProperties.TextRenderingMode);
@@ -1120,9 +1120,9 @@ procedure TChromeTabControl.DrawTo(TabCanvas: TGPGraphics; MouseX, MouseY: Integ
     BlendFactorsFade: array[0..2] of Single;
   begin
     if ChromeTabs.GetOptions.Behaviour.DebugMode then
-      TextSize := 7
+      TextSize := FChromeTabs.ScaledFontSize(7)
     else
-      TextSize := FChromeTabControlPropertyItems.CurrentTabProperties.FontSize;
+      TextSize := FChromeTabs.ScaledFontSize(FChromeTabControlPropertyItems.CurrentTabProperties.FontSize);
 
     TabsFont := TGPFont.Create(FChromeTabControlPropertyItems.StopTabProperties.FontName, TextSize);
     try

diff --git a/README.md b/README.md
@@ -1,6 +1,6 @@
 # TChromeTabs
 
-TChromeTabs is a comprehensive implementation of Google Chrome's tabs for Delphi 6 - Delphi DX10.4 Sydney
+TChromeTabs is a comprehensive implementation of Google Chrome's tabs for Delphi 6 - Delphi DX10.4 Sydney with High-DPI support
 
 Delphinus-Support