unit1.pas

来自「scale属性的应用演示」· PAS 代码 · 共 101 行

unit Unit1;

interface

uses
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    Dialogs, StdCtrls;

type
    TForm1 = class(TForm)
        Smaller: TButton;
        bigger: TButton;
        Button2: TButton;
        Memo1: TMemo;
        Button1: TButton;
        procedure SmallerClick(Sender: TObject);
        procedure biggerClick(Sender: TObject);
        procedure FormCreate(Sender: TObject);
        procedure Button2Click(Sender: TObject);
        procedure Button1Click(Sender: TObject);
    private
        { Private declarations }
    public
        procedure ScaleForm(F: TForm; ScreenWidth, ScreenHeight: Integer);
        procedure GetSize;
    end;

var
    Form1: TForm1;
    CurrentScreenWidth,
    CurrentScreenHeight,
    OriginalScreenWidth,
    OriginalScreenHeight: Integer;
    ScaleV:     Double;
implementation

{$R *.dfm}

procedure TForm1.SmallerClick(Sender: TObject);
begin
    CurrentScreenWidth := CurrentScreenWidth - 100;
    CurrentScreenHeight := CurrentScreenHeight - 100;
    Form1.ScaleForm(Form1, CurrentScreenWidth, CurrentScreenHeight);
end;

procedure TForm1.ScaleForm(F: TForm; ScreenWidth, ScreenHeight: Integer);
var
    NewFormWidth: Integer;
begin
    F.Scaled := True;
    F.AutoScroll := False;
    F.Position := poScreenCenter;
    F.Font.Name := 'Tahoma';

    NewFormWidth := Round(ScreenWidth * ScaleV);

    F.ScaleBy(NewFormWidth, F.Width);

    GetSize;
end;

procedure TForm1.biggerClick(Sender: TObject);
begin
    CurrentScreenWidth := CurrentScreenWidth + 100;
    CurrentScreenHeight := CurrentScreenHeight + 100;
    Form1.ScaleForm(Form1, CurrentScreenWidth, CurrentScreenHeight);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
    CurrentScreenWidth := Screen.Width;
    CurrentScreenHeight := Screen.Height;
    OriginalScreenWidth := Screen.Width;
    OriginalScreenHeight := Screen.Height;

    ScaleV := Form1.Width / Screen.Width;

    Memo1.Lines.Clear;
    GetSize;
end;

procedure TForm1.GetSize;
begin
    Memo1.Lines.Add(Format('Width: %d  Height: %d', [Form1.Width, Form1.Height]));
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
    Form1.ScaleBy(1, 2);
    GetSize;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
    Form1.ScaleBy(2, 1);
    GetSize;
end;

end.