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

2022-11-06 19:24:47 浏览数 (1)

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

0 人点赞