source: tags/1.3.3/Inp.pas

Last change on this file was 474, checked in by chronos, 6 months ago
  • Fixed: More high dpi related fixes.
File size: 2.9 KB
Line 
1{$INCLUDE Switches.inc}
2unit Inp;
3
4interface
5
6uses
7 ScreenTools, LCLIntf, LCLType, SysUtils, Classes, DrawDlg, ButtonA,
8 {$IFDEF DPI}Dpi.Graphics, Dpi.Controls, Dpi.Forms, Dpi.StdCtrls, System.UITypes{$ELSE}
9 Graphics, Controls, Forms, StdCtrls{$ENDIF};
10
11type
12 TInputDlg = class(TDrawDlg)
13 ButtonOk: TButtonA;
14 EditInput: TEdit;
15 procedure ButtonOkClick(Sender: TObject);
16 procedure FormPaint(Sender: TObject);
17 procedure FormCreate(Sender: TObject);
18 procedure EInputKeyPress(Sender: TObject; var Key: Char);
19 procedure FormShow(Sender: TObject);
20 procedure FormClose(Sender: TObject; var Action: TCloseAction);
21 public
22 procedure CenterToRect(Rect: TRect);
23 private
24 Center: Boolean;
25 end;
26
27var
28 InputDlg: TInputDlg;
29
30
31implementation
32
33{$R *.lfm}
34
35procedure TInputDlg.FormCreate(Sender: TObject);
36begin
37 Canvas.Font.Assign(UniFont[ftNormal]);
38 Canvas.Brush.Style := TBrushStyle.bsClear;
39 TitleHeight := Height;
40 InitButtons;
41 Center := True;
42end;
43
44procedure TInputDlg.FormPaint(Sender: TObject);
45begin
46 PaintBackground(Self, 3, 3, Width - 6, Height - 6);
47 Frame(Canvas, 0, 0, Width - 1, Height - 1, 0, 0);
48 Frame(Canvas, 1, 1, Width - 2, Height - 2,
49 MainTexture.ColorBevelLight, MainTexture.ColorBevelShade);
50 Frame(Canvas, 2, 2, Width - 3, Height - 3,
51 MainTexture.ColorBevelLight, MainTexture.ColorBevelShade);
52 EditFrame(Canvas, EditInput.BoundsRect, MainTexture);
53 BtnFrame(Canvas, ButtonOk.BoundsRect, MainTexture);
54 RisedTextOut(Canvas, (Width - BiColorTextWidth(Canvas, Caption)) div 2,
55 9, Caption);
56 { Corner(canvas, 1, 1, 0, MainTexture);
57 Corner(Canvas, Width - 9, 1, 1, MainTexture);
58 Corner(Canvas, 1, Height - 9, 2, MainTexture);
59 Corner(Canvas, Width - 9, Height - 9, 3, MainTexture); }
60end;
61
62procedure TInputDlg.ButtonOkClick(Sender: TObject);
63begin
64 if EditInput.Text = '' then
65 ModalResult := mrCancel
66 else
67 ModalResult := mrOK;
68end;
69
70procedure TInputDlg.EInputKeyPress(Sender: TObject; var Key: Char);
71begin
72 if (Key = #13) and (EditInput.Text <> '') then
73 begin
74 Key := #0;
75 ModalResult := mrOK;
76 end
77 else if Key = #27 then
78 begin
79 Key := #0;
80 ModalResult := mrCancel;
81 end;
82end;
83
84procedure TInputDlg.FormShow(Sender: TObject);
85begin
86 ButtonOk.Caption := Phrases.Lookup('BTN_OK');
87 EditInput.Font.Color := MainTexture.ColorMark;
88 EditInput.SelStart := 0;
89 EditInput.SelLength := Length(EditInput.Text);
90 if Center then
91 CenterToRect(Rect(0, 0, Screen.Width, Screen.Height));
92end;
93
94procedure TInputDlg.FormClose(Sender: TObject; var Action: TCloseAction);
95begin
96 Center := True;
97end;
98
99procedure TInputDlg.CenterToRect(Rect: TRect);
100begin
101 Center := False;
102 Left := Rect.Left + (Rect.Right - Rect.Left - Width) div 2;
103 Top := Rect.Top + (Rect.Bottom - Rect.Top - Height) div 2;
104end;
105
106end.
Note: See TracBrowser for help on using the repository browser.