| 1 | unit UFormMain;
|
|---|
| 2 |
|
|---|
| 3 | {$mode objfpc}{$H+}
|
|---|
| 4 |
|
|---|
| 5 | interface
|
|---|
| 6 |
|
|---|
| 7 | uses
|
|---|
| 8 | Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ComCtrls, StdCtrls,
|
|---|
| 9 | ExtCtrls, UDpiControls, UDpiFormMain;
|
|---|
| 10 |
|
|---|
| 11 | type
|
|---|
| 12 |
|
|---|
| 13 | { TFormMain }
|
|---|
| 14 |
|
|---|
| 15 | TFormMain = class(TForm)
|
|---|
| 16 | ButtonNewDpiForm: TButton;
|
|---|
| 17 | Label1: TLabel;
|
|---|
| 18 | Timer1: TTimer;
|
|---|
| 19 | TrackBar1: TTrackBar;
|
|---|
| 20 | procedure ButtonNewDpiFormClick(Sender: TObject);
|
|---|
| 21 | procedure FormDestroy(Sender: TObject);
|
|---|
| 22 | procedure FormShow(Sender: TObject);
|
|---|
| 23 | procedure Timer1Timer(Sender: TObject);
|
|---|
| 24 | procedure TrackBar1Change(Sender: TObject);
|
|---|
| 25 | private
|
|---|
| 26 | DpiForm: TDpiForm;
|
|---|
| 27 | public
|
|---|
| 28 | Redraw: Boolean;
|
|---|
| 29 | end;
|
|---|
| 30 |
|
|---|
| 31 | var
|
|---|
| 32 | FormMain: TFormMain;
|
|---|
| 33 |
|
|---|
| 34 | implementation
|
|---|
| 35 |
|
|---|
| 36 | {$R *.lfm}
|
|---|
| 37 |
|
|---|
| 38 | { TFormMain }
|
|---|
| 39 |
|
|---|
| 40 | procedure TFormMain.FormShow(Sender: TObject);
|
|---|
| 41 | begin
|
|---|
| 42 | DpiScreen.Dpi := 96 * 2;
|
|---|
| 43 | TrackBar1.Position := DpiScreen.Dpi;
|
|---|
| 44 | ButtonNewDpiFormClick(nil);
|
|---|
| 45 | end;
|
|---|
| 46 |
|
|---|
| 47 | procedure TFormMain.Timer1Timer(Sender: TObject);
|
|---|
| 48 | begin
|
|---|
| 49 | Redraw := False;
|
|---|
| 50 | DpiScreen.Dpi := TrackBar1.Position;
|
|---|
| 51 | end;
|
|---|
| 52 |
|
|---|
| 53 | procedure TFormMain.ButtonNewDpiFormClick(Sender: TObject);
|
|---|
| 54 | begin
|
|---|
| 55 | DpiForm := TDpiFormMain.Create(nil);
|
|---|
| 56 | DpiForm.Caption := DpiForm.Name;
|
|---|
| 57 | DpiForm.SetBounds(100, 100, 400, 200);
|
|---|
| 58 | DpiForm.Show;
|
|---|
| 59 | DpiScreen.Forms.Add(DpiForm);
|
|---|
| 60 | end;
|
|---|
| 61 |
|
|---|
| 62 | procedure TFormMain.FormDestroy(Sender: TObject);
|
|---|
| 63 | begin
|
|---|
| 64 | FreeAndNil(DpiForm);
|
|---|
| 65 | end;
|
|---|
| 66 |
|
|---|
| 67 | procedure TFormMain.TrackBar1Change(Sender: TObject);
|
|---|
| 68 | begin
|
|---|
| 69 | Redraw := True;
|
|---|
| 70 | end;
|
|---|
| 71 |
|
|---|
| 72 | end.
|
|---|
| 73 |
|
|---|
