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.
I prepared example for demonstration:
2) Large scale ( as you see button2 is gone )
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
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;