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