winformsdelphi-7dpi

How fix bug in delphi 7 with scale dpi?


Please help fix bug in delphi 7 with scale dpi. In this sample, I use TButton with Anchor:=[akRight] and as you can see button text overflow if window setting 125 dpi scale mode. enter image description here

I prepared example for demonstration:

1) Default scale Default scale

2) Large scale ( as you see button2 is gone ) Large scale

Source code:

Unit1.pas

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Button1: TButton;
    Button2: TButton;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

end.

Unit1.dfm

object Form1: TForm1
  Left = 488
  Top = 196
  Width = 720
  Height = 511
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Panel1: TPanel
    Left = 0
    Top = 432
    Width = 704
    Height = 41
    Align = alBottom
    Caption = 'Panel1'
    TabOrder = 0
    DesignSize = (
      704
      41)
    object Button1: TButton
      Left = 12
      Top = 8
      Width = 75
      Height = 25
      Caption = 'Button1'
      TabOrder = 0
    end
    object Button2: TButton
      Left = 616
      Top = 8
      Width = 75
      Height = 25
      Anchors = [akTop, akRight] 
      Caption = 'Button2'
      TabOrder = 1
    end
  end
  object Panel2: TPanel
    Left = 0
    Top = 0
    Width = 704
    Height = 432
    Align = alClient
    Caption = 'Panel2'
    TabOrder = 1
  end
end

Solution

  • I've found a solution: detect all TControl's and reposition them.

    const
     DEFAULT_DPI = 97;
    
    function TFMain.ScaleDPI(Value: Integer) : Integer;
    begin
       Result:=Ceil(Value*Screen.PixelsPerInch/DEFAULT_DPI);
    end;
    
    var i, n       : integer;
        CompFix    : array of TAnchors;
    
    with IsForm do begin
       SetLength(CompFix, ComponentCount);
       if ( Screen.PixelsPerInch > DEFAULT_DPI ) and Scaled then
          if ( (BorderStyle = bsSizeable) or (BorderStyle = bsSizeToolWin) ) then begin
             for i:=0 to ComponentCount-1 do
                if Components[i] is TControl then
                   if ( akRight in (Components[i] as TControl).Anchors ) or
                      ( akBottom in (Components[i] as TControl).Anchors ) then begin
                         CompFix[i]:=(Components[i] as TControl).Anchors;
                         (Components[i] as TControl).Anchors:=(Components[i] as TControl).Anchors - [akRight] - [akBottom] + [akLeft] + [akTop];
                      end else CompFix[i]:=[];
             ClientWidth:=ScaleDPI(ClientWidth);
             ClientHeight:=ScaleDPI(ClientHeight);
             for i:=0 to ComponentCount-1 do
                if CompFix[i] <> [] then begin
                   (Components[i] as TControl).Anchors:=CompFix[i];
                   end;
             end;
       end;