http://anony3721.blog.163.com/blog/static/511974201082235754423/
解决Delphi窗体缩放の疑难杂症
No.1 Delphi中如何限制窗体大小？
Delphi中可以限制窗体或者元件的大小，只要指定它的Constraints属性即可（默认是0,就是不限制）。但是Delphi这个属性有个很大的缺陷，比如从上往下调整，达到最小后，窗体高度虽然不会缩小了，但是窗体会继续往下移动，这样看起来会有些不正常（Delphi自己的窗体没有这个现象）。要解决这个问题，还是只有截取windows的消息，自己进行处理。
const
MinWidth = 500;
MinHeight = 400;
procedure WMSIZING(var Msg: TMessage); message WM_SIZING;
procedure TfrmMain.WMSIZING(var Msg: TMessage);
begin
Msg.Result := 1;
//限制最小高度
if (PRect(Msg.LPARAM)^.Bottom - PRect(Msg.LPARAM)^.Top) < MinHeight then
begin
if PRect(Msg.LPARAM)^.Top = Top then
PRect(Msg.LPARAM)^.Bottom := PRect(Msg.LPARAM)^.Top + MinHeight
else
PRect(Msg.LPARAM)^.Top := PRect(Msg.LPARAM)^.Bottom - MinHeight;
end;
//限制最小宽度
if (PRect(Msg.LPARAM)^.Right - PRect(Msg.LPARAM)^.Left) < MinWidth then
begin
if PRect(Msg.LPARAM)^.Left = Left then
PRect(Msg.LPARAM)^.Right := PRect(Msg.LPARAM)^.Left + MinWidth
else
PRect(Msg.LPARAM)^.Left := PRect(Msg.LPARAM)^.Right - MinWidth;
end;
end;
找了很久，發現下面的寫法可以實現，在form改變大小時，畫面上的控件的相對位置不變，但控件的大小及控件上的文字大小隨之改變。
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons;
type
TForm1 = class(TForm)
Button1: TButton;
SpeedButton1: TSpeedButton;
procedure FormResize(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
FWidth: Integer;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormResize(Sender: TObject);
begin
ScaleBy(Width, FWidth);
FWidth := Width;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FWidth := Width;
end;
end.
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);
end;