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

287 阅读 0 评论 190 点赞

我是靠谱客的博主儒雅流沙，最近开发中收集的这篇文章主要介绍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