解决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;