delphi 程序窗体及控件自适应分辨率


本文整理自网络,侵删。

 

代码如下:

unit untFixForm;

interface

uses
Classes, SysUtils, Controls, Forms;

type
TFontedControl = class(TControl)
public
property Font;
end;

TFontMapping = record
SWidth : Integer;
SHeight: Integer;
FName: string;
FSize: Integer;
end;

procedure FixForm(AForm: TForm);
procedure SetFontMapping;

var
FontMapping : array of TFontMapping;

implementation

procedure SetFontMapping;
begin
SetLength(FontMapping, 3);

// 800 x 600
FontMapping[0].SWidth := 800;
FontMapping[0].SHeight := 600;
FontMapping[0].FName := '宋体';
FontMapping[0].FSize := 7;

// 1024 x 768
FontMapping[1].SWidth := 1024;
FontMapping[1].SHeight := 768;
FontMapping[1].FName := '宋体';
FontMapping[1].FSize := 9;

// 1280 x 1024
FontMapping[2].SWidth := 1280;
FontMapping[2].SHeight := 1024;
FontMapping[2].FName := '宋体';
FontMapping[2].FSize := 11;

end;

procedure FixForm(AForm: TForm);
var
i, j : integer;
t : TControl;
begin
with AForm do
begin
for i := 0 to ComponentCount - 1 do
begin
try
t := TControl(Components[i]);
t.left := Trunc(t.left * (Screen.width / 1024));
t.top := Trunc(t.Top * (Screen.Height / 768));
t.Width := Trunc(t.Width * (Screen.Width / 1024));
t.Height := Trunc(t.Height * (Screen.Height / 768));
except
end; { try }
end; { for i }

for i:= 0 to Length(FontMapping) - 1 do
begin
if (Screen.Width = FontMapping[i].SWidth) and (Screen.Height = FontMapping[i].SHeight) then
begin
for j := 0 to ComponentCount - 1 do
begin
try
TFontedControl(Components[j]).Font.Name := FontMapping[i].FName;
TFontedControl(Components[j]).FONT.Size := FontMapping[i].FSize;
except
end; { try }
end; { for j }
end; { if }
end; { for i }
end; { with }
end;

initialization
SetFontMapping;

end.

SetFontMapping 方法可以自行修改,以适应更多的分辨率。

调用也非常简单,如下所示:

procedure TForm1.FormShow(Sender: TObject);
begin
if MessageBox(Handle,'要使用屏幕自适应吗?','提示',MB_YESNO or MB_ICONINFORMATION) = idno then Exit;
untFixForm.FixForm(Self);

下面的函数可以解决问题:

Form:需要调整的Form,OrgWidth:开发时屏幕的宽度,OrgHeight:开发时屏幕的高度。

注意:需要把Form的Scaled设置为True。

procedure

AdjustForm(Form: TForm; const OrgWidth, OrgHeight: integer);
begin


with Form do

begin

Width := Width * Screen.Width div OrgWidth;

Height := Height * Screen.Height div OrgHeight;

ScaleBy(Screen.Width, OrgWidth);

end;
end;

相关阅读 >>

Delphi 删除目录下指定类型文件

Delphi xe datasnap服务器获取客户端ip地址

Delphi 如何确定access数据库中存在某一个已知名的表

Delphi延时4种方法

Delphi xe android下让tmemo不自动弹出键盘

Delphi andorid应用程序检查wifi有效还是无效

Delphi application.restore; 简单用法

Delphi计算两个时间差

Delphi unigi unidbtreegrid展开叠起 unidbgrid自动调节列宽

Delphi 字符转16进制、16进制转字符

更多相关阅读请进入《Delphi》频道 >>



打赏

取消

感谢您的支持,我会继续努力的!

扫码支持
扫码打赏,您说多少就多少

打开支付宝扫一扫,即可进行扫码打赏哦

分享从这里开始,精彩与您同在

评论

管理员已关闭评论功能...