VB的TextBox文本框实现垂直居中显示的方法

技术  /  管理员 发布于 7年前   152

本文实例代码可以实现让VB的TextBox文本框垂直居中显示效果。此处需要注意：Form_Load()窗体代码中的多行属性设置必须为真，即Text1.MultiLine = True，该属性为只读属性，请在设计时修改，换行会被之后的代码屏蔽，不想屏蔽可自行修改，调用此函数就好了。

具体的功能代码如下：

'================================================================================'| 模 块 名 | TextBoxMiddle'| 说  明 | 文本框居中显示'=================================================================================Option ExplicitPrivate Type RECT  Left  As Long  Top  As Long  Right  As Long  Bottom  As LongEnd TypePrivate Declare Function SendMessage Lib "user32 " Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As LongPrivate Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As LongPrivate Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As LongPrivate Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As LongPrivate Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPrivate Const EM_GETRECT = &HB2Private Const EM_SETRECTNP = &HB4Private Const GWL_WNDPROC = (-4)Private Const WM_CHAR = &H102Private Const WM_PASTE As Long = &H302Private prevWndProc   As LongPublic ClipText As StringPublic Sub DisableAbility(TargetTextBox As TextBox)  prevWndProc = GetWindowLong(TargetTextBox.hwnd, GWL_WNDPROC)  SetWindowLong TargetTextBox.hwnd, GWL_WNDPROC, AddressOf WndProcEnd SubPrivate Function WndProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long  Dim Temp As String  Select Case Msg  Case WM_CHAR    If wParam <> 13 Then WndProc = CallWindowProc(prevWndProc, hwnd, Msg, wParam, lParam)  Case WM_PASTE    ClipText = Clipboard.GetText    Temp = Replace(ClipText, Chr(10), "")    Temp = Replace(Temp, Chr(13), "")    Clipboard.Clear    Clipboard.SetText Temp    WndProc = CallWindowProc(prevWndProc, hwnd, Msg, wParam, lParam)    Clipboard.Clear    Clipboard.SetText ClipText  Case Else    WndProc = CallWindowProc(prevWndProc, hwnd, Msg, wParam, lParam)  End SelectEnd FunctionSub VerMiddleText(mForm As form, mText As TextBox)  If mText.MultiLine = False Then Exit Sub  Dim rc   As RECT, tmpTop    As Long, tmpBot    As Long  SendMessage mText.hwnd, EM_GETRECT, 0, rc  With mForm.Font    .Name = mText.Font.Name    .Size = mText.Font.Size    .Bold = mText.Font.Bold  End With  tmpTop = ((rc.Bottom - rc.Top) - _  (mText.Parent.TextHeight("H ") \ Screen.TwipsPerPixelY)) \ 2 + 2  tmpBot = ((rc.Bottom - rc.Top) + _  (mText.Parent.TextHeight("H ") \ Screen.TwipsPerPixelY)) \ 2 + 2  rc.Top = tmpTop  rc.Bottom = tmpBot  mText.Alignment = vbCenter  SendMessage mText.hwnd, EM_SETRECTNP, 0&, rc  mText.Refresh  DisableAbility mTextEnd Sub'///////////////////////////////////////////////////////'以下为窗体代码'///////////////////////////////////////////////////////Private Sub Form_Load()  '================注意！！！=================  '多行属性必须为真，暨Text1.MultiLine = True  '该属性为只读属性，请在设计时修改  '换行会被之后的代码屏蔽，不想屏蔽可自行修改  '===========================================  '调用此函数就好了  VerMiddleText Me, Text1  Caption = Len(Text1)End Sub