テキストボックスで縦方向中央揃え・下揃え・上揃えをする(VB6.0)

　下記プログラムコードに関する補足・注意事項　
動作確認：Windows Vista・Windows 7 (32bit) / VB6.0(SP6)
Option　：[Option Explicit]
参照設定：
使用 API：SendMessage
その他　：このサンプルは、 Win32 APIを使用しておりますので、ある程度Win32 API が理解できる方がお使い下さい。
　　　　：

Win32 API とは
　Win32 Application Programming Interfaces の略で、32bit プロセッサで動作する Windows
95 等、以降用に対応するアプリケーションの開発者のために、公開されている関数を指します。
尚、Visual Basic 2010 等の .NET 系のバージョンや VBA からも使用する事ができます。
　ここでは、略して Win32 API　とか　Win32 API 関数とか表示スペースの関係から　API　と表記する場合があります。

１．テキストボックスで縦方向中央揃え・下揃え・上揃えをする

Option Explicit　　 'SampleNo=111 2002.05.22

'指定のウィンドウにメッセージを送る(P750)
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 Type RECT
　 Left　 As Long
　 Top　　As Long
　 Right　As Long
　 Bottom As Long
End Type

Private RECT As RECT
'テキストボックスのフォーマット領域の短形を設定する
'(テキストを表示する領域を設定)
Private Const EM_SETRECT = &HB3
'テキストの行数を取得する定数
Private Const EM_GETLINECOUNT = &HBA

Private Sub VerticalAlignment(mytext As TextBox, _
　　　　　　　　　　　　　　Optional Alignment As Integer = 0)
'テキストボックスで縦方向の表示位置設定用プロシージャ
　　Dim CharacterHeight As Long
　　Dim textMargin As Long
　　Dim formFontSize As Long
　　Dim Result As Long
　　Dim textLine As Long
　　'テキストボックスの MultiLine = True に設定しておいて下さい
　　'テキストボックスに表示されている行数を取得
　　textLine = SendMessage(mytext.hwnd, EM_GETLINECOUNT, 0&, 0&) - 1
　　If textLine < 1 Then textLine = 1　　 'Defaultの行数
　　If Alignment > 2 Then
　　　　Exit Sub
　　End If
　　'テキストボックスに使用されているフォントの高さを求める
　　formFontSize = Me.FontSize
　　Me.FontSize = mytext.FontSize

　　CharacterHeight = Me.TextHeight("花ちゃん") '1文字でOK
　　textMargin = CharacterHeight \ 4　'フォントサイズの4分の1
　　'(12ポイントの場合文字高さ=240 最小のText1.Height=360 になり
　　'　　　　　　　　　　　 120Twip 分下側に空白が表示される)
　　'(従ってその半分だけ下側に移動しないと真中に表示しない)
　　CharacterHeight = CharacterHeight * textLine　　 '表示行数
　　CharacterHeight = CharacterHeight + textMargin
　　'文字の表示位置の構造体に求めた位置を設定
　　With RECT
　　　　'テキストボックスの高さー文字の高さ=空白の部分
　　　　　　　　　　　　'それをピクセル単位で求め2で割センターを求める
　　　　.Top = (mytext.Height - CharacterHeight) / Screen.TwipsPerPixelY
　　　　If Alignment = 2 Then
　　　　　　.Top = .Top / 2
　　　　ElseIf Alignment = 0 Then
　　　　　　.Top = 0
　　　　End If
　　　　.Left = 0
　　　　.Right = mytext.Width
　　　　.Bottom = mytext.Height
　　End With
　　Result = SendMessage(mytext.hwnd, EM_SETRECT, 0, RECT)
　　'フォームのフォントサイズを元に戻す
　　Me.FontSize = formFontSize
End Sub

Private Sub Text1_LostFocus()
'縦方向上揃え
　　Call VerticalAlignment(Text1, 0)
End Sub

Private Sub Text2_GotFocus()
'デフォルトの設定に戻す(書き込めないので)
　　Call VerticalAlignment(Text2, 0)
End Sub

Private Sub Text2_LostFocus()
'縦方向下揃え
　　Call VerticalAlignment(Text2, 1)
End Sub

Private Sub Text3_LostFocus()
'縦方向中央揃え
　　Call VerticalAlignment(Text3, 2)
End Sub

Private Sub Text4_LostFocus()
'縦方向中央揃え
　　Call VerticalAlignment(Text4, 2)
End Sub

　　上記実行結果
　

検索キーワード及びサンプルコードの別名(機能名)

VBレスキュー(花ちゃん)

Visual Basic 6.0