'===========================================================================
'    ファイル名    : basGetCaretPosition.bas
'    ファイル説明  : キャレットの位置を取得
'    作成者        : Uz
'                    E-Mail   : uz@violet.plala.or.jp
'                    HomePage : http://www1.plala.or.jp/uz/
'    作成日        : 1998/04/29 (Wed)
'    修正日        : 1998/04/29 (Wed)
'    備考          : なし
'===========================================================================
Option Explicit

' -- API 定数宣言
Public Const EM_GETSEL = &HB0
Public Const EM_LINEFROMCHAR = &HC9
Public Const EM_LINEINDEX = &HBB

' -- API 関数宣言
Public Declare Function SendMessageByNum Lib "user32" Alias "SendMessageA" ( _
    ByVal hWnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Long _
) As Long

'///////////////////////////////////////////////////////////////////////////
'      関数名    : GetCaretPosition
'      目的説明  : キャレットの位置を取得
'      前提条件  : なし
'      結果      : なし
'      引数      : Long hWnd    : テキストボックス 又は リッチエディットボックスの hWnd
'                  Long X       : Ｘ座標を格納する
'                  Long Y       : Ｙ座標を格納する
'      戻り値    : なし
'      備考      ; なし
'///////////////////////////////////////////////////////////////////////////
Public Sub GetCaretPosition(ByVal hWnd As Long, X As Long, Y As Long)
    Dim lngSelStart As Long
    Dim lngLineIndex As Long
    
    lngSelStart = GetSelStart(hWnd)
    
    Y = GetLine(hWnd)
    lngLineIndex = GetLineIndex(hWnd, Y)
    X = lngSelStart - lngLineIndex + 1
End Sub

'///////////////////////////////////////////////////////////////////////////
'      関数名    : GetSelStart
'      目的説明  : 選択開始位置を取得
'      前提条件  : なし
'      結果      : なし
'      引数      : Long hWnd    : テキストボックス 又は リッチエディットボックスの hWnd
'      戻り値    : Long
'      備考      ; なし
'///////////////////////////////////////////////////////////////////////////
Public Function GetSelStart(ByVal hWnd As Long) As Long
    Dim lngRet As Long
    Dim lngSelStart As Long
    Dim lngSelEnd As Long
    
    lngRet = SendMessageByNum(hWnd, EM_GETSEL, lngSelStart, lngSelEnd)
    
    GetSelStart = LOWORD(lngRet)
End Function

'///////////////////////////////////////////////////////////////////////////
'      関数名    : GetLine
'      目的説明  : キャレットのある行を返す
'      前提条件  : なし
'      結果      : なし
'      引数      : Long hWnd    : テキストボックス 又は リッチエディットボックスの hWnd
'      戻り値    : Long
'      備考      ; なし
'///////////////////////////////////////////////////////////////////////////
Public Function GetLine(ByVal hWnd As Long) As Long
    Dim lngRet As Long
    
    lngRet = SendMessageByNum(hWnd, EM_LINEFROMCHAR, -1, 0)
    
    GetLine = lngRet + 1
End Function

'///////////////////////////////////////////////////////////////////////////
'      関数名    : GetLineIndex
'      目的説明  : 指定した行の先頭の位置を返す
'      前提条件  : なし
'      結果      : なし
'      引数      : Long hWnd    : テキストボックス 又は リッチエディットボックスの hWnd
'                  Long Line    : 先頭位置を返す行
'      戻り値    : Long
'      備考      ; なし
'///////////////////////////////////////////////////////////////////////////
Public Function GetLineIndex(ByVal hWnd As Long, ByVal Line As Long) As Long
    Dim lngRet As Long
    
    lngRet = SendMessageByNum(hWnd, EM_LINEINDEX, Line - 1, 0)
    
    GetLineIndex = lngRet
End Function

'///////////////////////////////////////////////////////////////////////////
'      関数名    : HIWORD
'      目的説明  : 上位ビットの値を返す
'      前提条件  : なし
'      結果      : なし
'      引数      : Long lngVal
'      戻り値    : Long
'      備考      ; なし
'///////////////////////////////////////////////////////////////////////////
Public Function HIWORD(ByVal lngVal As Long) As Long
    HIWORD = lngVal \ 2 ^ 16
End Function

'///////////////////////////////////////////////////////////////////////////
'      関数名    : LOWORD
'      目的説明  : 下位ビットの値を返す
'      前提条件  : なし
'      結果      : なし
'      引数      : Long lngVal
'      戻り値    : Long
'      備考      ; なし
'///////////////////////////////////////////////////////////////////////////
Public Function LOWORD(ByVal lngVal As Long) As Long
    LOWORD = lngVal Mod 2 ^ 16
End Function



'===========================================================================
'    ファイル名    : frmMain.frm
'    ファイル説明  : GetCaretPostion の サンプル
'    作成者        : Uz
'                    E-Mail   : uz@violet.plala.or.jp
'                    HomePage : http://www1.plala.or.jp/uz/
'    作成日        : 1998/04/29 (Wed)
'    修正日        : 1998/04/29 (Wed)
'    備考          : なし
'===========================================================================
Option Explicit

'///////////////////////////////////////////////////////////////////////////
'      関数名    : PosChange
'      目的説明  : キャレット位置をフォームのタイトルバーに表示
'      前提条件  : なし
'      結果      : なし
'      引数      : なし
'      戻り値    : なし
'      備考      ; なし
'///////////////////////////////////////////////////////////////////////////
Private Sub PosChange()
    Dim lngX As Long
    Dim lngY As Long
    
    Call GetCaretPosition(Text1.hWnd, lngX, lngY)
    
    Me.Caption = lngX & "," & lngY
End Sub

Private Sub Text1_KeyUp(KeyCode As Integer, Shift As Integer)
    Call PosChange
End Sub

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

Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call PosChange
End Sub