前往小程序,Get更优阅读体验!
立即前往
首页
学习
活动
专区
工具
TVP
发布
社区首页 >专栏 >VB的TextBox文本框实现垂直居中显示的方法

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

原创
作者头像
大师级码师
发布2022-11-06 19:24:47
2.6K0
发布2022-11-06 19:24:47
举报
文章被收录于专栏:大师级码师大师级码师

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

原创声明:本文系作者授权腾讯云开发者社区发表,未经许可,不得转载。

如有侵权,请联系 cloudcommunity@tencent.com 删除。

原创声明:本文系作者授权腾讯云开发者社区发表,未经许可,不得转载。

如有侵权,请联系 cloudcommunity@tencent.com 删除。

评论
登录后参与评论
0 条评论
热度
最新
推荐阅读
领券
问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档