Contoh kode dalam artikel ini dapat mencapai efek memusatkan kotak teks VB TextBox secara vertikal. Catatan di sini: pengaturan atribut multi-baris pada kode formulir Form_Load() harus benar, yaitu Text1.MultiLine = True. Atribut ini adalah atribut read-only, harap diubah pada waktu desain dengan kode selanjutnya. Tidak ingin Perisai dapat dimodifikasi sendiri, panggil saja fungsi ini.
Kode fungsi spesifiknya adalah sebagai berikut:
' ===== = ================'|. Nama modul|.TextBoxMiddle'|.Deskripsi| '==== =============== ===== ============Opsi Eksplisit Tipe Pribadi RECT Kiri Sebagai Panjang Atas Selama Kanan Selama Bawah Selama 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 Fungsi Deklarasi LongPrivate CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc Selama, ByVal hwnd Selama, ByVal Msg Selama, ByVal wParam Selama, ByVal lParam Selama) Sebagai LongPrivate Deklarasi Fungsi GetWindowLong Lib "user32" Alias "GetWindowLongA " (ByVal hwnd As Long, ByVal nIndex As Long) As LongPrivate Deklarasi Fungsi 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) Konst. Swasta WM_CHAR = &H102Private Const WM_PASTE As Long = &H302Private prevWndProc As LongPublic ClipText As StringPublic Sub DisableAbility(TargetTextBox As TextBox) prevWndProc = GetWindowLong(TargetTextBox.hwnd, GWL_WNDPROC) SetWindowLong TargetTextBox.hwnd, GWL_WNDPROC, AddressOf WndProcEnd Fungsi SubPrivate WndProc (ByVal hwnd Selama, ByVal Msg Selama, ByVal wParam Selama, ByVal lParam Selama) Selama Dim Temp As String Select Case Msg Case WM_CHAR Jika wParam <> 13 Kemudian WndProc = CallWindowProc(prevWndProc , hwnd, Msg, wParam, lParam) Kasus WM_PASTE ClipText = Clipboard.GetText Temp = Ganti(ClipText, Chr(10), "") Temp = Ganti(Temp, Chr(13), "") Clipboard.Clear Clipboard.SetText Temp WndProc = CallWindowProc(prevWndProc, hwnd, Msg , wParam, lParam) Clipboard.Hapus Clipboard.SetText ClipText Case Else WndProc = CallWindowProc(prevWndProc, hwnd, Msg, wParam, lParam) End SelectEnd FunctionSub VerMiddleText(mForm As form, mText As TextBox) Jika mText.MultiLine = False Lalu Keluar dari Sub Dim rc As RECT, tmpTop As Long, tmpBot As Kirim Pesan Panjang mText.hwnd, EM_GETRECT, 0, rc Dengan mForm.Font .Name = mText.Font.Name .Size = mText.Font.Size .Bold = mText.Font.Bold Diakhiri Dengan tmpTop = ((rc.Bottom - rc.Top) - _ ( mText.Parent.TextHeight("H ") / Layar.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'//////////////////////////////////////////////// /// ///////'Berikut ini formnya Kode'//////////////////////////////////////////////// /// ///////Pribadi Sub Form_Load() '=Perhatian! ! ! ================= 'Atribut multi-baris harus benar, dan Text1.MultiLine = Benar 'Atribut ini adalah atribut read-only, silakan ubah pada waktu desain' Pemblokiran kode, jika tidak ingin diblokir, Anda dapat memodifikasinya sendiri'================ ============= == 'Panggil saja fungsi ini VerMiddleText Me, Text1 Caption = Len(Text1)End Sub