通过下面的组件,可以在输入文字的时候自动垂直居中
直接把下面代码保存到Unit1.pas即可
------------------------------------------
1 unit Unit1; 2 3 interface 4 5 uses 6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 7 Dialogs, StdCtrls; 8 9 type 10 TEdit = class(StdCtrls.TEdit) 11 protected 12 procedure CreateParams(var Params: TCreateParams); override; 13 procedure KeyPress(var Key: Char); override; 14 procedure WMSize(var msg: TWMSize);message WM_SIZE; 15 procedure SetParent(AParent: TWinControl);override; 16 procedure SetCenter; 17 end; 18 TForm1 = class(TForm) 19 Button1: TButton; 20 Edit1: TEdit; 21 procedure FormCreate(Sender: TObject); 22 private 23 { Private declarations } 24 public 25 { Public declarations } 26 Edt: TEdit; 27 end; 28 29 var 30 Form1: TForm1; 31 32 implementation 33 34 {$R *.dfm} 35 { TEdit } 36 37 procedure TForm1.FormCreate(Sender: TObject); 38 begin 39 Edt := TEdit.Create(self); 40 Edt.Parent := self; 41 Edt.AutoSize := False; 42 Edt.Height := 50; 43 end; 44 45 procedure TEdit.CreateParams(var Params: TCreateParams); 46 begin 47 inherited; 48 Params.Style := Params.Style or ES_MULTILINE; 49 end; 50 51 procedure TEdit.KeyPress(var Key: Char); 52 begin 53 inherited; 54 if Key = #13 then 55 key := #0; 56 end; 57 58 procedure TEdit.WMSize(var msg: TWMSize); 59 begin 60 inherited; 61 SetCenter; 62 end; 63 64 procedure TEdit.SetParent(AParent: TWinControl); 65 begin 66 inherited; 67 if Parent <> nil then 68 begin 69 SetCenter; 70 end; 71 end; 72 73 procedure TEdit.SetCenter; 74 var 75 DC: HDC; 76 SaveFont: HFont; 77 Sin: Integer; 78 SysMetrics, Metrics: TTextMetric; 79 Rct: TRect; 80 begin 81 DC := GetDC(0); 82 GetTextMetrics(DC, SysMetrics); 83 SaveFont := SelectObject(DC, Font.Handle); 84 GetTextMetrics(DC, Metrics); 85 SelectObject(DC, SaveFont); 86 ReleaseDC(0, DC); 87 if Ctl3D then Sin := 8 else Sin := 6; 88 Rct := ClientRect; 89 Sin := Height - Metrics.tmHeight - Sin; 90 Rct.Top := Sin div 2; 91 SendMessage(Handle, EM_SETRECT, 0, Integer(@Rct)); 92 end; 93 94 95 96 97 end.
当这个保存成unit1.pas 后,然后通过delphi组件安装功能来安装组件,具体安装方法可以到网上查方法
时间: 2024-11-06 02:39:54