如何修复 delphi 7 中带有比例 dpi 的错误？
How fix bug in delphi 7 with scale dpi?
请帮助修复 delphi 7 中比例 dpi 的错误。
在此示例中，我将 TButton 与 Anchor:=[akRight] 一起使用，如果 window 设置 125 dpi 缩放模式，您可以看到按钮文本溢出。
我准备了演示示例：
1) 默认比例
2) 大规模（如你所见，button2 不见了）
源代码：
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
我找到了一个解决方案：检测所有 TControl 并重新定位它们。
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;
要正确使用缩放，您必须使用为此准备的环境。
没有什么复杂的，字母不会缩小，一切都会正常工作。
我有一个演示应用程序，展示了如何使用缩放
如果系统的全球规模与发展愿望的规模不同
根据整体规模，可以仅调整应用程序本身的规模。
EXE APP DEMO
screen
unit AmUserScale;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs;
//type
type
AmScale = class
private
class procedure SetScaleAppCustom(New,Old:integer);
public
//хранит значение маштаба по умолчанию
// AppScaleDesing рекомедую выстовить в 100 при создании формы а не здесь
// WinScaleDPIDesing рекомедую выстовить в 96 при создании формы что равно WinApi.Windows.USER_DEFAULT_SCREEN_DPI а не здесь
//если вы разрабатываете прогу и у вас на компе глобальный маштаб 120 то его и установите по умолчанию в WinScaleDPIDesing
// если у вас всегда глобальный маштаб 96 то ничего устанавливать не нужно см initialization
class var AppScaleDesing:Integer; // какой маштаб был на этапе разработки
class var AppScaleNow:Integer; //какой маштаб сейчас в приложении
class var WinScaleDPIDesing:Integer; //какой глобальный маштаб системы был на этапе разработки
class var WinScaleDPINow:Integer; //какой глобальный маштаб системы сейчас в приложении
class var IsShow:boolean;
// при создании главной формы запустить Init
// можно передать параметр сохраненного маштаба приложения например с какой то базы данных
// это процент от 30 до 200 обычно это 100 процентов от размера приложения на этапе разработки
class procedure Init(ASavedProcent:Integer=100);
// в собыитии FormShow запустить Show
class procedure Show;
// запустить в событии главной формы FormAfterMonitorDpiChanged
// проиходит когда в системе глобально меняется маштаб
class procedure ChangeDPI(NewDPI,OldDPI:integer);
// получить новое значение размера для числа val смотрите ниже описание
// если кратко то P:=Tpanel.create(self); P.height:= AmScale.Value(88);
class function Value(val:integer):integer; static;
// если хотим поменять мастаб всего приложения SetScaleApp(120,100) увеличится на 20%
class procedure SetScaleApp(New,Old:integer);
// получить список для юзера возможных маштабов приложения
class procedure GetAppToList(L:TStrings);
// у вас есть значение но не знаете индек его в списке = найдите
class function GetIndexFromList(L:TStrings;value:integer=0):integer;
// получить значение с строки которая была получена в GetAppToList
class function GetValueFromStr(S:String):integer;
// изменить маштаб когда юзер выбрал новое значение из списка
class procedure SetAppFromListInt(New:Integer);
//передать одну линию со списка полученного в GetAppToList
class procedure SetAppFromList(S:String);
end;
function UserMainScale(val:integer):integer;
{
ЭТО СТАРОЕ ОПИСАНИЕ СМЫСЛ ТОТ ЖЕ просто имена процедур изменены
получает маштаб экрана у пользователя на форм create занести значение в UserMainScaleGetConst
где
Width_now это ширина формы когда програ запускается
Width_debag это ширина формы на этапе разработки
в ответ приходит процент изменения , т.е маштаб
USER_MAIN_SCALE_CREATE:= UserMainScaleGetConst(MyForm.Width,500);
USER_MAIN_SCALE_CREATE хранит текуший маштаб наример 125.67 но обычно 100
далее если создаем компоненты диначимичеки то указываем ширину и высоту и отступы как
P:=Tpanel.create(self);
P.parent:=self;
P.height:= UserMainScale(88); //хотя раньше бы писали как P.height:= 88;
P.font.size:= UserMainScale(10);
небольшое замечание по динамическому созданию котролов
после TWinControl.Create
и до уставновки Parent
нужно ставить значения высот обычно т.е
P.height:= 88;
P.parent:=self;
после установки Parent
P.height:= UserMainScale(88);
}
implementation
{ AmScale }
function UserMainScale(val:integer):integer;
begin
Result:=AmScale.Value(val);
end;
class procedure AmScale.GetAppToList(L: TStrings);
begin
L.Clear;
L.Add('70 %');
L.Add('80 %');
L.Add('90 %');
L.Add('95 %');
L.Add('100 % (рекомедуется)');
L.Add('110 %');
L.Add('120 %');
L.Add('130 %');
L.Add('140 %');
L.Add('150 %');
L.Add('175 %');
L.Add('200 %');
end;
class function AmScale.GetIndexFromList(L: TStrings; value: integer=0): integer;
begin
if value<30 then
value:= AppScaleNow;
for Result := 0 to L.Count-1 do
if GetValueFromStr(L[Result]) = value then exit;
Result:=-1;
end;
class function AmScale.GetValueFromStr(S: String): integer;
var tok:integer;
begin
Result:=0;
tok:= pos(' ',S);
if (tok<>1) and (tok<>0) then
begin
S:=s.Split([' '])[0];
TryStrToInt(S,Result);
end;
end;
class procedure AmScale.SetAppFromList(S: String);
begin
SetAppFromListInt(GetValueFromStr(S));
end;
class procedure AmScale.SetAppFromListInt(New: Integer);
begin
SetScaleApp(New,AppScaleNow);
end;
class procedure AmScale.SetScaleApp(New,Old:integer);
begin
if New<30 then exit;
if Old<30 then
Old:= AppScaleNow;
if Old<30 then exit;
if New<>AppScaleNow then
begin
SetScaleAppCustom(New,AppScaleNow);
AppScaleNow:= New;
end;
end;
class procedure AmScale.SetScaleAppCustom(New, Old: integer);
var i:integer;
begin
for I := 0 to Screen.FormCount-1 do
Screen.Forms[i].ScaleBy(New,Old);
end;
class procedure AmScale.Show;
begin
SetScaleAppCustom(AppScaleNow,AppScaleDesing);
IsShow:=true;
end;
class procedure AmScale.ChangeDPI(NewDPI,OldDPI:integer);
begin
WinScaleDPINow:= NewDPI;
end;
class procedure AmScale.Init(ASavedProcent:Integer=100);
var LMonitor:TMonitor;
LForm: TForm;
LPlacement: TWindowPlacement;
begin
if ASavedProcent<=0 then
ASavedProcent:=100;
if ASavedProcent<30 then ASavedProcent:=30;
if ASavedProcent>300 then ASavedProcent:=300;
AppScaleDesing:=100;
AppScaleNow:=ASavedProcent;
WinScaleDPINow:=USER_DEFAULT_SCREEN_DPI;
WinScaleDPIDesing:=USER_DEFAULT_SCREEN_DPI;
if (Application<>nil) and (Screen<>nil) then
begin
LMonitor := Screen.MonitorFromWindow(Application.Handle);
if LMonitor <> nil then
WinScaleDPINow := LMonitor.PixelsPerInch
else
WinScaleDPINow := Screen.PixelsPerInch;
LForm := Application.MainForm;
if (LForm <> nil) then
WinScaleDPIDesing := LForm.PixelsPerInch;
end
else if (Screen<>nil) and (Mouse<>nil) then
begin
LMonitor := Screen.MonitorFromPoint(Mouse.CursorPos);
if LMonitor <> nil then
WinScaleDPINow := LMonitor.PixelsPerInch
else
WinScaleDPINow := Screen.PixelsPerInch;
LForm := Application.MainForm;
if (LForm <> nil) then
WinScaleDPIDesing := LForm.PixelsPerInch;
end;
//ScaleForPPI(GetParentCurrentDpi);
end;
class function AmScale.Value(val: integer): integer;
begin
// result:=Round( Value(Real(val)) );
// сначало маштаб системы потом маштаб приложения
result:=MulDiv(val, WinScaleDPINow, WinScaleDPIDesing);
if IsShow then
result:=MulDiv(result, AppScaleNow, AppScaleDesing);
end;
{
class procedure AmScale.Start(Width_now, Width_debag: real);
begin
USER_SCALE:=100;
if Width_debag=0 then exit;
USER_SCALE:=(Width_now/Width_debag)*100;
c:=TMonitor.Create;
c.PixelsPerInch
end;}
initialization
begin
AmScale.IsShow:=false;
AmScale.AppScaleDesing:=100;
AmScale.AppScaleNow:=100;
AmScale.WinScaleDPIDesing:= WinApi.Windows.USER_DEFAULT_SCREEN_DPI;
AmScale.WinScaleDPINow:= WinApi.Windows.USER_DEFAULT_SCREEN_DPI;
end;
end.
请帮助修复 delphi 7 中比例 dpi 的错误。
在此示例中，我将 TButton 与 Anchor:=[akRight] 一起使用，如果 window 设置 125 dpi 缩放模式，您可以看到按钮文本溢出。
我准备了演示示例：
1) 默认比例
2) 大规模（如你所见，button2 不见了）
源代码：
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
我找到了一个解决方案：检测所有 TControl 并重新定位它们。
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;
要正确使用缩放，您必须使用为此准备的环境。 没有什么复杂的，字母不会缩小，一切都会正常工作。 我有一个演示应用程序，展示了如何使用缩放 如果系统的全球规模与发展愿望的规模不同 根据整体规模，可以仅调整应用程序本身的规模。 EXE APP DEMO screen
unit AmUserScale;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs;
//type
type
AmScale = class
private
class procedure SetScaleAppCustom(New,Old:integer);
public
//хранит значение маштаба по умолчанию
// AppScaleDesing рекомедую выстовить в 100 при создании формы а не здесь
// WinScaleDPIDesing рекомедую выстовить в 96 при создании формы что равно WinApi.Windows.USER_DEFAULT_SCREEN_DPI а не здесь
//если вы разрабатываете прогу и у вас на компе глобальный маштаб 120 то его и установите по умолчанию в WinScaleDPIDesing
// если у вас всегда глобальный маштаб 96 то ничего устанавливать не нужно см initialization
class var AppScaleDesing:Integer; // какой маштаб был на этапе разработки
class var AppScaleNow:Integer; //какой маштаб сейчас в приложении
class var WinScaleDPIDesing:Integer; //какой глобальный маштаб системы был на этапе разработки
class var WinScaleDPINow:Integer; //какой глобальный маштаб системы сейчас в приложении
class var IsShow:boolean;
// при создании главной формы запустить Init
// можно передать параметр сохраненного маштаба приложения например с какой то базы данных
// это процент от 30 до 200 обычно это 100 процентов от размера приложения на этапе разработки
class procedure Init(ASavedProcent:Integer=100);
// в собыитии FormShow запустить Show
class procedure Show;
// запустить в событии главной формы FormAfterMonitorDpiChanged
// проиходит когда в системе глобально меняется маштаб
class procedure ChangeDPI(NewDPI,OldDPI:integer);
// получить новое значение размера для числа val смотрите ниже описание
// если кратко то P:=Tpanel.create(self); P.height:= AmScale.Value(88);
class function Value(val:integer):integer; static;
// если хотим поменять мастаб всего приложения SetScaleApp(120,100) увеличится на 20%
class procedure SetScaleApp(New,Old:integer);
// получить список для юзера возможных маштабов приложения
class procedure GetAppToList(L:TStrings);
// у вас есть значение но не знаете индек его в списке = найдите
class function GetIndexFromList(L:TStrings;value:integer=0):integer;
// получить значение с строки которая была получена в GetAppToList
class function GetValueFromStr(S:String):integer;
// изменить маштаб когда юзер выбрал новое значение из списка
class procedure SetAppFromListInt(New:Integer);
//передать одну линию со списка полученного в GetAppToList
class procedure SetAppFromList(S:String);
end;
function UserMainScale(val:integer):integer;
{
ЭТО СТАРОЕ ОПИСАНИЕ СМЫСЛ ТОТ ЖЕ просто имена процедур изменены
получает маштаб экрана у пользователя на форм create занести значение в UserMainScaleGetConst
где
Width_now это ширина формы когда програ запускается
Width_debag это ширина формы на этапе разработки
в ответ приходит процент изменения , т.е маштаб
USER_MAIN_SCALE_CREATE:= UserMainScaleGetConst(MyForm.Width,500);
USER_MAIN_SCALE_CREATE хранит текуший маштаб наример 125.67 но обычно 100
далее если создаем компоненты диначимичеки то указываем ширину и высоту и отступы как
P:=Tpanel.create(self);
P.parent:=self;
P.height:= UserMainScale(88); //хотя раньше бы писали как P.height:= 88;
P.font.size:= UserMainScale(10);
небольшое замечание по динамическому созданию котролов
после TWinControl.Create
и до уставновки Parent
нужно ставить значения высот обычно т.е
P.height:= 88;
P.parent:=self;
после установки Parent
P.height:= UserMainScale(88);
}
implementation
{ AmScale }
function UserMainScale(val:integer):integer;
begin
Result:=AmScale.Value(val);
end;
class procedure AmScale.GetAppToList(L: TStrings);
begin
L.Clear;
L.Add('70 %');
L.Add('80 %');
L.Add('90 %');
L.Add('95 %');
L.Add('100 % (рекомедуется)');
L.Add('110 %');
L.Add('120 %');
L.Add('130 %');
L.Add('140 %');
L.Add('150 %');
L.Add('175 %');
L.Add('200 %');
end;
class function AmScale.GetIndexFromList(L: TStrings; value: integer=0): integer;
begin
if value<30 then
value:= AppScaleNow;
for Result := 0 to L.Count-1 do
if GetValueFromStr(L[Result]) = value then exit;
Result:=-1;
end;
class function AmScale.GetValueFromStr(S: String): integer;
var tok:integer;
begin
Result:=0;
tok:= pos(' ',S);
if (tok<>1) and (tok<>0) then
begin
S:=s.Split([' '])[0];
TryStrToInt(S,Result);
end;
end;
class procedure AmScale.SetAppFromList(S: String);
begin
SetAppFromListInt(GetValueFromStr(S));
end;
class procedure AmScale.SetAppFromListInt(New: Integer);
begin
SetScaleApp(New,AppScaleNow);
end;
class procedure AmScale.SetScaleApp(New,Old:integer);
begin
if New<30 then exit;
if Old<30 then
Old:= AppScaleNow;
if Old<30 then exit;
if New<>AppScaleNow then
begin
SetScaleAppCustom(New,AppScaleNow);
AppScaleNow:= New;
end;
end;
class procedure AmScale.SetScaleAppCustom(New, Old: integer);
var i:integer;
begin
for I := 0 to Screen.FormCount-1 do
Screen.Forms[i].ScaleBy(New,Old);
end;
class procedure AmScale.Show;
begin
SetScaleAppCustom(AppScaleNow,AppScaleDesing);
IsShow:=true;
end;
class procedure AmScale.ChangeDPI(NewDPI,OldDPI:integer);
begin
WinScaleDPINow:= NewDPI;
end;
class procedure AmScale.Init(ASavedProcent:Integer=100);
var LMonitor:TMonitor;
LForm: TForm;
LPlacement: TWindowPlacement;
begin
if ASavedProcent<=0 then
ASavedProcent:=100;
if ASavedProcent<30 then ASavedProcent:=30;
if ASavedProcent>300 then ASavedProcent:=300;
AppScaleDesing:=100;
AppScaleNow:=ASavedProcent;
WinScaleDPINow:=USER_DEFAULT_SCREEN_DPI;
WinScaleDPIDesing:=USER_DEFAULT_SCREEN_DPI;
if (Application<>nil) and (Screen<>nil) then
begin
LMonitor := Screen.MonitorFromWindow(Application.Handle);
if LMonitor <> nil then
WinScaleDPINow := LMonitor.PixelsPerInch
else
WinScaleDPINow := Screen.PixelsPerInch;
LForm := Application.MainForm;
if (LForm <> nil) then
WinScaleDPIDesing := LForm.PixelsPerInch;
end
else if (Screen<>nil) and (Mouse<>nil) then
begin
LMonitor := Screen.MonitorFromPoint(Mouse.CursorPos);
if LMonitor <> nil then
WinScaleDPINow := LMonitor.PixelsPerInch
else
WinScaleDPINow := Screen.PixelsPerInch;
LForm := Application.MainForm;
if (LForm <> nil) then
WinScaleDPIDesing := LForm.PixelsPerInch;
end;
//ScaleForPPI(GetParentCurrentDpi);
end;
class function AmScale.Value(val: integer): integer;
begin
// result:=Round( Value(Real(val)) );
// сначало маштаб системы потом маштаб приложения
result:=MulDiv(val, WinScaleDPINow, WinScaleDPIDesing);
if IsShow then
result:=MulDiv(result, AppScaleNow, AppScaleDesing);
end;
{
class procedure AmScale.Start(Width_now, Width_debag: real);
begin
USER_SCALE:=100;
if Width_debag=0 then exit;
USER_SCALE:=(Width_now/Width_debag)*100;
c:=TMonitor.Create;
c.PixelsPerInch
end;}
initialization
begin
AmScale.IsShow:=false;
AmScale.AppScaleDesing:=100;
AmScale.AppScaleNow:=100;
AmScale.WinScaleDPIDesing:= WinApi.Windows.USER_DEFAULT_SCREEN_DPI;
AmScale.WinScaleDPINow:= WinApi.Windows.USER_DEFAULT_SCREEN_DPI;
end;
end.