VB的TextBox文本框完成垂直居中顯示的辦法

VB的TextBox文本框完成垂直居中顯示的辦法。本站提示廣大學習愛好者：（VB的TextBox文本框完成垂直居中顯示的辦法）文章只能為提供參考，不一定能成為您想要的結果。以下是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