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

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

    具体的功能代码如下:

    
    '================================================================================
    '| 模 块 名 | TextBoxMiddle
    '| 说  明 | 文本框居中显示
    '=================================================================================
    Option Explicit
    Private Type RECT
      Left  As Long
      Top  As Long
      Right  As Long
      Bottom  As Long
    End Type
    Private Declare Function SendMessage Lib "user32 " Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
    Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long
    Private 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 Long
    Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
    Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Const EM_GETRECT = &HB2
    Private Const EM_SETRECTNP = &HB4
    Private Const GWL_WNDPROC = (-4)
    Private Const WM_CHAR = &H102
    Private Const WM_PASTE As Long = &H302
    Private prevWndProc   As Long
    Public ClipText As String
    Public Sub DisableAbility(TargetTextBox As TextBox)
      prevWndProc = GetWindowLong(TargetTextBox.hwnd, GWL_WNDPROC)
      SetWindowLong TargetTextBox.hwnd, GWL_WNDPROC, AddressOf WndProc
    End Sub
    
    Private 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 Select
    End Function
    Sub 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 mText
    End Sub
    '///////////////////////////////////////////////////////
    '以下为窗体代码
    '///////////////////////////////////////////////////////
    Private Sub Form_Load()
      '================注意!!!=================
      '多行属性必须为真,暨Text1.MultiLine = True
      '该属性为只读属性,请在设计时修改
      '换行会被之后的代码屏蔽,不想屏蔽可自行修改
      '===========================================
      '调用此函数就好了
      VerMiddleText Me, Text1
      Caption = Len(Text1)
    End Sub