Browse Source

fix font size with retina

Johann ELSASS 5 years ago
parent
commit
4cb088970d
2 changed files with 40 additions and 2 deletions
  1. 28 2
      bcbutton.pas
  2. 12 0
      bctypes.pas

+ 28 - 2
bcbutton.pas

@@ -1176,6 +1176,9 @@ var
   vertAlign, relVertAlign: TTextLayout;
   glyphHorzMargin, glyphVertMargin: integer;
   tw, th, availW: integer;
+  canvasScale: single;
+  scaledFont: TBCFont;
+  ownScaledFont: Boolean;
 begin
   if (Parent = nil) or (not Parent.HandleAllocated) then
     Exit;
@@ -1183,6 +1186,21 @@ begin
   FLastBorderWidth := FStateNormal.Border.Width;
   CalculateGlyphSize(gw, gh);
 
+  // more precise computation of font with Retina scaling
+  canvasScale := GetCanvasScaleFactor;
+  if (canvasScale <> 1) and FShowCaption then
+  begin
+    scaledFont := TBCFont.Create(nil);
+    scaledFont.Assign(FStateNormal.FontEx);
+    scaledFont.Scale(canvasScale);
+    ownScaledFont := true;
+  end else
+  begin
+    scaledFont := FStateNormal.FontEx;
+    ownScaledFont := false;
+    canvasScale := 1;
+  end;
+
   if GlyphOldPlacement then
   begin
     {  if WidthIsAnchored then
@@ -1193,7 +1211,11 @@ begin
     PreferredWidth := 0;
     PreferredHeight := 0;
     if FShowCaption then
-      CalculateTextSize(Caption, FStateNormal.FontEx, PreferredWidth, PreferredHeight);
+    begin
+      CalculateTextSize(Caption, scaledFont, PreferredWidth, PreferredHeight);
+      PreferredWidth := ceil(PreferredWidth/canvasScale);
+      PreferredHeight := ceil(PreferredHeight/canvasScale);
+    end;
 
     // Extra pixels for DropDown
     if Style = bbtDropDown then
@@ -1256,7 +1278,10 @@ begin
       availW := 65535;
       if (Align in [alTop,alBottom]) and (Parent <> nil) then
         availW := Parent.ClientWidth - PreferredWidth;
-      CalculateTextSizeEx(actualCaption, FStateNormal.FontEx, tw, th, availW);
+      CalculateTextSizeEx(actualCaption, scaledFont, tw, th, availW);
+      tw := ceil(tw/canvasScale);
+      th := ceil(th/canvasScale);
+
       if (tw<>0) and FStateNormal.FontEx.WordBreak then inc(tw);
       if vertAlign<>relVertAlign then
       begin
@@ -1270,6 +1295,7 @@ begin
       end;
     end;
   end;
+  if ownScaledFont then scaledFont.Free;
 end;
 
 class function TCustomBCButton.GetControlClassDefaultSize: TSize;

+ 12 - 0
bctypes.pas

@@ -878,7 +878,19 @@ begin
 end;
 
 procedure TBCFont.Scale(AScale: single);
+var
+  bmp: TBitmap;
 begin
+  // we need to have an actual height and not the default value
+  if Height = 0 then
+  begin
+    bmp := TBitmap.Create;
+    bmp.Canvas.Font.Name:= Name;
+    bmp.Canvas.Font.Height:= 0;
+    bmp.Canvas.Font.Style:= Style;
+    Height := -bmp.Canvas.TextHeight('Bgra');
+    bmp.Free;
+  end;
   Height := round(Height * AScale);
   ShadowRadius:= min(high(ShadowRadius), round(ShadowRadius * AScale));
   ShadowOffsetX:= max(low(ShadowOffsetX), min(high(ShadowOffsetX), round(ShadowOffsetX*AScale)));