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

本文实例代码可以实现让VB的TextBox文本框垂直居中显示效果。此处需要注意：Form_Load()窗体代码中的多行属性设置必须为真，即Text1.MultiLine=True，该属性为只读属性，请在设计时修改，换行会被之后的代码屏蔽，不想屏蔽可自行修改，调用此函数就好了。

具体的功能代码如下：

"================================================================================
"|模块名|TextBoxMiddle
"|说明|文本框居中显示
"=================================================================================
OptionExplicit
PrivateTypeRECT
LeftAsLong
TopAsLong
RightAsLong
BottomAsLong
EndType
PrivateDeclareFunctionSendMessageLib"user32"Alias"SendMessageA"(ByValhwndAsLong,ByValwMsgAsLong,ByValwParamAsLong,lParamAsAny)AsLong
PrivateDeclareFunctionSetWindowTextLib"user32"Alias"SetWindowTextA"(ByValhwndAsLong,ByVallpStringAsString)AsLong
PrivateDeclareFunctionCallWindowProcLib"user32"Alias"CallWindowProcA"(ByVallpPrevWndFuncAsLong,ByValhwndAsLong,ByValMsgAsLong,ByValwParamAsLong,ByVallParamAsLong)AsLong
PrivateDeclareFunctionGetWindowLongLib"user32"Alias"GetWindowLongA"(ByValhwndAsLong,ByValnIndexAsLong)AsLong
PrivateDeclareFunctionSetWindowLongLib"user32"Alias"SetWindowLongA"(ByValhwndAsLong,ByValnIndexAsLong,ByValdwNewLongAsLong)AsLong
PrivateConstEM_GETRECT=&HB2
PrivateConstEM_SETRECTNP=&HB4
PrivateConstGWL_WNDPROC=(-4)
PrivateConstWM_CHAR=&H102
PrivateConstWM_PASTEAsLong=&H302
PrivateprevWndProcAsLong
PublicClipTextAsString
PublicSubDisableAbility(TargetTextBoxAsTextBox)
prevWndProc=GetWindowLong(TargetTextBox.hwnd,GWL_WNDPROC)
SetWindowLongTargetTextBox.hwnd,GWL_WNDPROC,AddressOfWndProc
EndSub

PrivateFunctionWndProc(ByValhwndAsLong,ByValMsgAsLong,ByValwParamAsLong,ByVallParamAsLong)AsLong
DimTempAsString
SelectCaseMsg
CaseWM_CHAR
IfwParam<>13ThenWndProc=CallWindowProc(prevWndProc,hwnd,Msg,wParam,lParam)
CaseWM_PASTE
ClipText=Clipboard.GetText
Temp=Replace(ClipText,Chr(10),"")
Temp=Replace(Temp,Chr(13),"")
Clipboard.Clear
Clipboard.SetTextTemp
WndProc=CallWindowProc(prevWndProc,hwnd,Msg,wParam,lParam)
Clipboard.Clear
Clipboard.SetTextClipText
CaseElse
WndProc=CallWindowProc(prevWndProc,hwnd,Msg,wParam,lParam)
EndSelect
EndFunction
SubVerMiddleText(mFormAsform,mTextAsTextBox)
IfmText.MultiLine=FalseThenExitSub
DimrcAsRECT,tmpTopAsLong,tmpBotAsLong
SendMessagemText.hwnd,EM_GETRECT,0,rc
WithmForm.Font
.Name=mText.Font.Name
.Size=mText.Font.Size
.Bold=mText.Font.Bold
EndWith
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
SendMessagemText.hwnd,EM_SETRECTNP,0&,rc
mText.Refresh
DisableAbilitymText
EndSub
"///////////////////////////////////////////////////////
"以下为窗体代码
"///////////////////////////////////////////////////////
PrivateSubForm_Load()
"================注意！！！=================
"多行属性必须为真，暨Text1.MultiLine=True
"该属性为只读属性，请在设计时修改
"换行会被之后的代码屏蔽，不想屏蔽可自行修改
"===========================================
"调用此函数就好了
VerMiddleTextMe,Text1
Caption=Len(Text1)
EndSub