テキストボックスの[Tab]位置を変更するには

テキストボックスの[Tab]キーを押したときのタブストップの位置を変更してみます。
キーワードは「EM_SETTABSTOPS」メッセージです。
EM_SETTABSTOPSメッセージはテキストボックスにタブストップの位置を設定します。
このメッセージを使うと３つのタブストップの中から選択することができます。
    �@デフォルトのタブストップ
    �A一定間隔のタブストップ
    �B配列を指定することで、間隔を複数設定するタブストップ

サンプルでは�Bの方法を使ってタブストップを設定しています。
なお、タブストップの単位は「ダイアログベース単位」です。
ピクセルではないので注意してください。
また、日本語版の環境と英語版の環境では同じダイアログベース単位でも
ピクセルに直すと違うピクセル値になるので注意が必要です。

実行時の様子
｜線がタブストップを設定した位置


'デバイスコンテキストを解放する
Private Declare Function ReleaseDC Lib "user32.dll" _
    (ByVal hWnd As Long, ByVal hdc As Long) As Long
'現在の位置から指定の位置まで直線を描画する
Private Declare Function LineTo Lib "gdi32.dll" _
    (ByVal hdc As Long, ByVal nXEnd As Long, ByVal nYEnd As Long) As Long
'現在の位置を変更する
Private Declare Function MoveToEx Lib "gdi32.dll" _
    (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpCoord As Long) As Long
'デバイスコンテキストのハンドルを取得する
Private Declare Function GetDC Lib "user32.dll" (ByVal hWnd As Long) As Long
'論理ペンを作成する
Private Declare Function CreatePen Lib "gdi32.dll" _
    (ByVal fnPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
'fnPenStyleの定数
Private Const PS_SOLID = 0              '実線
Private Const PS_DASH = 1               '破線
Private Const PS_DOT = 2                '点線
Private Const PS_DASHDOT = 3            '一点鎖線
Private Const PS_DASHDOTDOT = 4         '二点鎖線
Private Const PS_NULL = 5               '非表示
Private Const PS_INSIDEFRAME = 6        '塗りつぶし
'グラフィックスオブジェクトを削除し､システムリソースを解放する
Private Declare Function DeleteObject Lib "gdi32.dll" _
        (ByVal hObject As Long) As Long
'デバイスコンテキストにオブジェクトを選択する
Private Declare Function SelectObject Lib "gdi32.dll" _
        (ByVal hdc As Long, ByVal hgdiobj As Long) As Long
'指定のウィンドウにメッセージを送る
Private Declare Function SendMessageAny Lib "user32.dll" Alias "SendMessageA" _
    (ByVal hWnd As Long, ByVal MSG As Long, ByVal wParam As Long, lParam As Any) As Long
'テキストボックスのメッセージ
Private Const EM_SETTABSTOPS = &HCB         '複数行テキストボックスのタブストップ位置を設定する
Private Const EM_POSFROMCHAR = &HD6         '指定の文字インデックスの座標値を取得する
Private Type POINTAPI
    x As Long
    y As Long
End Type
Dim Tabstops(3) As Long, TabstopsPOS(3) As POINTAPI

Private Sub Form_Load()
    
    Dim rc As Long, x As Long, y As Long
    'タブストップの設定
    Tabstops(0) = 30
    Tabstops(1) = 20
    Tabstops(2) = 40
    Tabstops(3) = 30
    Call SendMessageAny(Me.Text1.hWnd, EM_SETTABSTOPS, 3, Tabstops(0))
    
    '座標値の取得
    Me.Text1.Text = vbTab & vbTab & vbTab & vbTab
    For a = 0 To 3
        rc = SendMessageAny(Me.Text1.hWnd, EM_POSFROMCHAR, a, ByVal 0)
        TabstopsPOS(a).x = LWORD(rc)
        TabstopsPOS(a).y = HWORD(rc)
    Next
    
End Sub


Private Sub Text1_Change()
    Call DrawLine
End Sub

Private Function LWORD(ByVal LongValue As Long) As Integer
    '長整数値から下位ワードを取得する
    If (LongValue And &HFFFF&) > &H7FFF Then
        LWORD = (LongValue And &HFFFF&) - &H10000
    Else
        LWORD = LongValue And &HFFFF&
    End If
End Function


Private Function HWORD(ByVal LongValue As Long) As Integer
    '長整数値から上位ワードを取得する
    HWORD = (LongValue And &HFFFF0000) \ &H10000
End Function


Private Sub Text1_Click()
    Call DrawLine
End Sub

Private Sub DrawLine()
    Dim hdc As Long, hPen As Long, hOldPen As Long
    
    hdc = GetDC(Me.Text1.hWnd)
    hPen = CreatePen(PS_DOT, 1, vbRed)
    hOldPen = SelectObject(hdc, hPen)
    For a = 0 To 3
        Call MoveToEx(hdc, TabstopsPOS(a).x, TabstopsPOS(a).y, 0)
        Call LineTo(hdc, TabstopsPOS(a).x, Me.Text1.Height)
    Next
    Call SelectObject(hdc, hPen)
    Call ReleaseDC(Me.Text1.hWnd, hdc)
    Call DeleteObject(hPen)
End Sub


Private Sub Text1_KeyPress(KeyAscii As Integer)
    Call DrawLine
End Sub

ダウンロード