Option Explicit　　 'SampleNo=111 WindowsXP VB6.0(SP5) 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("花ちゃん") '１文字でOK
　　textMargin = CharacterHeight \ 4　'フォントサイズの４分の１
　　'(12ポイントの場合 文字高さ=240 最小のText1.Height=360 になり
　　'　　　　　　　　　　　 120Twip 分下側に空白が表示される）
　　'(従ってその半分だけ下側に移動しないと真中に表示しない）
　　CharacterHeight = CharacterHeight * textLine　　 '表示行数
　　CharacterHeight = CharacterHeight + textMargin
　　'文字の表示位置の構造体に求めた位置を設定
　　With RECT
　　　　'テキストボックスの高さー文字の高さ＝空白の部分
　　　　　　　　　　　　'それをピクセル単位で求め２で割センターを求める
　　　　.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