Масштабирование окна

implementation

const
  ScreenWidth: Integer = 800; {Я разрабатывал свою форму в режиме 800x600.}
  ScreenHeight: Integer = 600;

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
var
  x, y: LongInt; {Тип Integer не достаточно большой для наших значений.}
begin
  form1.scaled := true;
  x := getSystemMetrics(SM_CXSCREEN);
  y := getSystemMetrics(SM_CYSCREEN);
  if (x <> ScreenHeight) or (y <> ScreenWidth) then
  begin
    form1.height := form1.height * x div ScreenWidth;
    form1.width := form1.width * y div ScreenHeight;
  end;
  if x <> ScreenWidth then
    scaleBy(x, ScreenWidth);
end;

unit scale;

interface

uses
  Forms, WinTypes, WinProcs, SysUtils;

procedure ScaleForm(Sender: TObject);

implementation

procedure ScaleForm(Sender: TObject);

const

  {измените это так, чтобы это соответствовало
  режиму разрешения во время разработки}
  DesignScrY: LongInt = 480;
  DesignScrX: LongInt = 640;
  DesignBorder: LongInt = 4; {значение в Панели Управления + 1}

var

  SystemScrY: LongInt;
  SystemScrX: LongInt;
  SystemBorder: LongInt;
  OldHeight: LongInt;
  OldWidth: LongInt;

begin

  SystemScrY := GetSystemMetrics(SM_CYSCREEN);
  SystemScrX := GetSystemMetrics(SM_CXSCREEN);
  SystemBorder := GetSystemMetrics(SM_CYFRAME);
  with Sender as TForm do
  begin
    Scaled := True;
    AutoScroll := False;
    Top := Top * SystemScrX div DesignScrX;
    Left := Left * SystemScrX div DesignScrX;
    OldHeight := Height + (DesignBorder - SystemBorder) * 2;
    OldWidth := Width + (DesignBorder - SystemBorder) * 2;
    ScaleBy((OldWidth * SystemScrX div DesignScrX - SystemBorder * 2),
      (OldWidth - DesignBorder * 2));
    {
    Для форм не имеющих границ измените предшествующие
    три строки следующим способом:

    OldHeight := Height;
    OldWidth  := Width;
    ScaleBy(SystemScrX, DesignScrX);
    }

    Height := OldHeight * SystemScrY div DesignScrY;
    Width := OldWidth * SystemScrX div DesignScrX;
  end;
end;

begin
end.