テキストボックスの総行数・現在行・現在桁の取得
                                                        玄関へお回り下さい。
リッチ及びテキストボックス内の総行数・現在行・現在桁の取得   (076)
    テキストボックスの場合

Option Explicit   'SampleNo=076 WindowsXP VB6.0(SP5) 2002.05.16
'指定のウィンドウにメッセージを送る(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
'複数行テキストボックスにおいてテキストの行数を取得する(P799)
Private Const EM_GETLINECOUNT = &HBA
'  〃    指定行の先頭の文字インデックスを取得する(P803)
Private Const EM_LINEINDEX = &HBB
'  〃    指定の文字インデックスを含む行インデックスを取得(P802)
Private Const EM_LINEFROMCHAR = &HC9
'選択されたテキストの最初と最後の文字インデックスを取得する(P801)
Private Const EM_GETSEL = &HB0


Private Sub Text1_KeyUp(KeyCode As Integer, Shift As Integer)
'マウスカーソル位置の文字数(行の先頭から桁数)を取得
  Dim MaxRow As Long
  Dim PosRow As Long
  Dim PosCol As Long
  Dim Count As Long
  '総行数を取得する
  MaxRow = SendMessage(Text1.hwnd, EM_GETLINECOUNT, 0&, 0&)
  '現在行(マウスカーソル位置の)を取得する
  PosRow = SendMessage(Text1.hwnd, EM_LINEFROMCHAR, -1&, 0&) + 1
  '現在行の先頭位置までのバイト数(vbFromUnicode)を取得
  PosCol = SendMessage(Text1.hwnd, EM_LINEINDEX, -1, 0)
  'カーソル位置から行の先頭までの文字数を求める
  For Count = 0 To Text1.SelStart
  '先頭位置と同じバイト数になるまで文字数をカウント
    If PosCol = LenB(StrConv(Left$(Text1.Text, _
        (Text1.SelStart - Count)), vbFromUnicode)) Then
      PosCol = Count + 1 '+1は Word と同じカウントに合わせる
      Exit For
    End If
  Next Count
  Label1.Caption = "総行数 : " & MaxRow & "  現在行 : " & _
      PosRow & "  現在桁 : " & PosCol
End Sub


リッチテキスト用と同様にプロシージャ化して Text1_KeyUp  イベントや RichTextBox1_Click
イベントから呼び出した方が便利かも知れません。その辺は環境に合わせてご使用下さい。


   リッチテキストボックス用
注意 VB5.0 用のOCX(V.5.01.4319等)では正しい桁数を返しません。
       VB5.0(SP3)  Microsoft Rich Textbox Control 6.0(SP3) で動作確認


Option Explicit   'SampleNo=076 WindowsXP VB6.0(SP5) 2002.05.16
'指定のウィンドウにメッセージを送る(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
'複数行テキストボックスにおいてテキストの行数を取得する(P799)
Private Const EM_GETLINECOUNT = &HBA
'  〃    指定行の先頭の文字インデックスを取得する(P803)
Private Const EM_LINEINDEX = &HBB
'  〃    指定の文字インデックスを含む行インデックスを取得(P802)
Private Const EM_LINEFROMCHAR = &HC9
'選択されたテキストの最初と最後の文字インデックスを取得する(P801)
Private Const EM_GETSEL = &HB0


こちらはプロシージャ化しました
Private Sub sCursorRow()
'マウスカーソル位置の文字数(行の先頭から桁数)を取得
  Dim MaxRow As Long
  Dim PosRow As Long
  Dim PosCol As Long
  Dim Count As Long
  Dim CurPos As Long
  Dim strLin As String

  '総行数を取得する
  MaxRow = SendMessage(RichTextBox1.hwnd, EM_GETLINECOUNT, 0&, 0&)
  '現在行(マウスカーソル位置の)を取得する
  PosRow = SendMessage(RichTextBox1.hwnd, EM_LINEFROMCHAR, -1&, 0&) + 1
  '現在行の先頭位置までのバイト数(vbFromUnicode)を取得
  CurPos = SendMessage(RichTextBox1.hwnd, EM_LINEINDEX, -1&, 0&)
  '現在位置までのバイト数を取得
  PosCol = SendMessage(RichTextBox1.hwnd, EM_GETSEL, 0&, 0&)
  '行の先頭からのバイト数を求める
  PosCol = PosCol \ 65536 - CurPos
  '先頭からの文字列を求める
  strLin = Left$(RichTextBox1.Text, RichTextBox1.SelStart)

  'IME入力時はこの処理ができない
  'バイト数でカウントするならこの処理及びキー制限はいらない
  For Count = 0 To Len(strLin)
  '先頭位置と同じバイト数になるまで文字数をカウント
    If CurPos = LenB(StrConv(Left$(strLin, _
        Len(strLin) - Count), vbFromUnicode)) Then
      PosCol = Count + 1
      Exit For
    End If
  Next Count
  Label2.Caption = "総行数 : " & MaxRow & "  現在行 : " & _
      PosRow & "  現在桁 : " & PosCol
End Sub


Private Sub RichTextBox1_Click()
  sCursorRow 'マウスをクリックした場合も桁位置が判るように
End Sub


Private Sub RichTextBox1_KeyUp(KeyCode As Integer, Shift As Integer)
  '押されたキーを制限(漢字入力時等でうまく処理できない)
  If KeyCode = vbKeyReturn Or (KeyCode >= 36 And KeyCode <= 40) Then
    sCursorRow
  End If
End Sub

   リッチテキストボックス用もテキストボックス用と同様の処理で行けると思ったのですが、IME
が入力出来なくなったり、文字位置がうまく取得出来なかったりで、結構悩みました。
最終的にカーソル移動キーとEnter キーとマウスクリックした場合に取得するように変更しました。バイト単位での位置取得には、問題は無いようです。ご使用時には、その辺十分注意して下さい。(特にOCXのバージョンの違いには)
上記サンプルはVB専用掲示板の#366に(たくボンさん)が投稿されたものです。
又 No.1208 正確な行と列の確保:解決  投稿者:A0k1x さん でも投稿されておられますが、こちらは現在桁は取得できません(現在行の総桁数)

たくボンさんのサンプルでは半角文字と全角文字が混在すると桁位置がずれるのでRichTextBox 用と一部現在桁取得のところは私が変更しました。過去のログも合わせて参照して下さい。
当初のサンプルは事前の改行位置から現在の位置を割り出していましたが、改行でなくワードラップで折り返している場合、位置が違った値になるため、今回は行の先頭位置のバイト数を調べ
それと同じバイト数になる文字数を求めました。




2002/05/16