您的位置：首页 > 编程语言 > VB

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

2014-07-31 14:49 1696 查看

本文实例代码可以实现让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

您可能感兴趣的文章:

内容来自用户分享和网络整理，不保证内容的准确性，如有侵权内容，可联系管理员处理

标签： VB TextBox 垂直居中显示

相关文章推荐

新的分享

章节导航