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

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

2021-10-11 15:38VB教程网 VB

这篇文章主要介绍了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