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

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) thenbeginform1.height := form1.height * x DIV ScreenWidth;form1.width := form1.width * y DIV ScreenHeight;end;if x <> ScreenWidth then scaleBy(x, ScreenWidth);end;

Спасибо за ценные замечания.

Дополнение

Файл DELSEQ07.FAQ содержит код примера отображения форм в различных разрешениях. К сожалению, он не учитывал ширину границы окна. Я публикую изменение, масштабирующее компоненты вне зависимости от разрешения экрана и ширины границ окон. Включите нижеследующий модуль в секцию uses каждого модуля и вызывайте ScaleForm в обработчике формы OnCreate, передавая в качестве параметра имя формы. Я надеюсь что помог тем, кто столкнулся с данной проблемой.

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 dobeginScaled := 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.

[000433]

Содержание раздела