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

您可能感兴趣的文章:

• VB6实现连接Access数据库的ADODB代码实现方法
• VB的32位程序在64位系统中出现文件和注册表自动转向的解决方法
• VB实现鼠标绘图实例代码
• VB实现屏蔽文本框右键菜单的复制、粘贴等功能的方法
• VB使用XMLHTTP实现Post与Get的方法
• VB读取线程、句柄及写入内存的API代码实例
• VB实现的倒计时类代码详解
• VB调用Word拼写检查功能实例
• VB使用shell函数打开外部exe程序的实现方法