O código de exemplo neste artigo pode obter o efeito de centralizar verticalmente a caixa de texto VB TextBox. Observe aqui: a configuração do atributo multilinha no código do formulário Form_Load() deve ser verdadeira, ou seja, Text1.MultiLine = True. Este atributo é somente leitura. Modifique-o em tempo de design. por códigos subseqüentes, não quero que o escudo possa ser modificado por você mesmo, basta chamar esta função.
Os códigos de função específicos são os seguintes:
'================================================ ============================='| Nome do módulo| TextBoxMiddle'| '==== ============================================= ===== =========================== Opção ExplicitPrivate Tipo RECT Esquerda As Long Top As Long Right As Long Bottom As LongEnd TypePrivate Declare Function SendMessage Lib "user32 " Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As LongPrivate Declare Function SetWindowText Lib "user32 " Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Função de declaração LongPrivate 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 LongPrivate Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As LongPrivate Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPrivate Const EM_GETRECT = &HB2Private Const EM_SETRECTNP = &HB4Private Const GWL_WNDPROC = (-4) Const Privado WM_CHAR = &H102Private Const WM_PASTE As Long = &H302Private prevWndProc As LongPublic ClipText As StringPublic Sub DisableAbility(TargetTextBox As TextBox) prevWindowLong(TargetTextBox.hwnd, GWL_WNDPROC) SetWindowLong TargetTextBox.hwnd, GWL_WNDPROC, AddressOf WndProcEnd SubPrivate 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) Caso WM_PASTE ClipText = Clipboard.GetText Temp = Substituir(ClipText, Chr(10), "") Temp = Substituir(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 SelectEnd FunctionSub VerMiddleText (mForm As form, mText As TextBox) Se mText.MultiLine = False Então saia Sub Dim rc As RECT, tmpTop As Long, tmpBot As SendMessage longo mText.hwnd, EM_GETRECT, 0, rc Com mForm.Font .Name = mText.Font.Name .Size = mText.Font.Size .Bold = mText.Font.Bold Finalizar com 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 mTextEnd Sub'//////////////////////////////////////////////// /// ///////'O seguinte é o formulário Código'//////////////////////////////////////////////// /// ///////Privado Sub Form_Load() '================Atenção! ! ! ================= 'O atributo multilinha deve ser verdadeiro e Text1.MultiLine = True 'Este atributo é somente leitura, modifique-o em tempo de design' Bloqueio de código, se você não quiser bloqueá-lo, você mesmo pode modificá-lo'=============================== ============= == 'Basta chamar esta função de VerMiddleText Me, Text1 Caption = Len(Text1)End Sub