Show tab text at the system menu font size on scaled displays

WtProgram/OleDropTarget.fs

@@ -56,7 +56,7 @@ type OleDropTarget(ts:TabStrip) as this=
                         label <- Some tip
                         tip
                 let strip : Rect = ts.bounds
-                use font = System.Drawing.SystemFonts.MessageBoxFont
+                use font = TabMetrics.font 0 System.Drawing.FontStyle.Regular
                 tip.show(text,font,System.Drawing.Rectangle(strip.x,strip.y,strip.size.width,strip.size.height),pointerX)
 
     let effectAt (keys:int) (pt:POINTL) (allowed:int) =

WtProgram/TabStripSprite.fs

@@ -93,8 +93,9 @@ module TabMetrics =
     /// A logical length (padding, gap, button) shrunk with the icon.
     let scaled (height:int) (logical:int) = max 1 (int(Math.Round(float(Dpi.scale logical) * scale height)))
     /// The menu font, made smaller only when its line would not fit the tab. 0 means any height.
+    /// GDI already sizes points at the system DPI, so only another monitor's scale is applied.
     let font (height:int) (style:FontStyle) =
-        let points = float32(Dpi.scaleF(float SystemFonts.MenuFont.SizeInPoints))
+        let points = SystemFonts.MenuFont.SizeInPoints*float32(Dpi.value())/float32(Dpi.system())
         use full = new Font(SystemFonts.MenuFont.FontFamily,points,style)
         let fit = if height>0 && full.Height>height then float32 height/float32 full.Height else 1.0f
         new Font(SystemFonts.MenuFont.FontFamily,max 1.0f (points*fit),style)

tests/TabShadow.fsx

@@ -271,6 +271,17 @@ let main () =
                 check (flashing.GetPixel(x,flashing.Height/2).ToArgb()<>Color.Red.ToArgb()) "Vertical stripe overrode an attention color"
     check (Theme.tabTint true (Some Color.Red)=None) "High contrast retained tint"
     let tabImage = ts.render
+    // GDI already sizes points at the system DPI: tab text matches the menu font there and
+    // grows only in proportion on a monitor with another scale.
+    do
+        let before = Dpi.value()
+        try
+            for dpi,factor in [Dpi.system(),1.0f; Dpi.system()*2,2.0f] do
+                Dpi.set dpi
+                use font = TabMetrics.font 0 FontStyle.Regular
+                check (abs(font.SizeInPoints-SystemFonts.MenuFont.SizeInPoints*factor)<0.01f)
+                      (sprintf "Tab font is %.2fpt at %d DPI with the system at %d DPI" font.SizeInPoints dpi (Dpi.system()))
+        finally Dpi.set before
     // Short tabs shrink their contents to fit instead of clipping them.
     for h in [12;18;26] do
         use font = TabMetrics.font h FontStyle.Regular