エディットボックスのカーソル座標を取得          <TOP>


EditBoxの文字座標を取得します。

SendMessage ウィンドウにメッセージを送信

EM_POSFROMCHAR(&HD6) 指定の文字インデックス座標を取得
 

例では、カーソル色を便宜上赤色で表しています。

'================================================================
'= エディットボックスのカーソル座標を取得
'=    (EM_POSFROMCHAR.bas)
'================================================================
#include "Windows.bi"

Type POINTAPI
    x As Long
    y As Long
End Type

' ウィンドウにメッセージを送信。この関数は、指定したウィンドウのウィンドウプロシージャが処理を終了するまで制御を返さない
Declare Function Api_SendMessage& Lib "user32" Alias "SendMessageA" (ByVal hWnd&, ByVal wMsg&, ByVal wParam&, lParam As Any)

#define EM_POSFROMCHAR &HD6             '指定の文字インデックス座標を取得

Var Shared Edit1 As Object
Var Shared Timer1 As Object

Edit1.Attach GetDlgItem("Edit1") : Edit1.SetFontSize 14
Timer1.Attach GetDlgItem("Timer1")

'================================================================
'=
'================================================================
Declare Sub MainForm_Start edecl ()
Sub MainForm_Start()
    Var txt As String

    txt = "NEW YORK -- The Buses to Baseball program packed up and carried more than 50 kids to Yankee Stadium on Tuesday, treating many of them to their first Major League Baseball game."
    Edit1.SetWindowtext txt

    Timer1.SetInterval 50
    Timer1.Enable -1
End Sub

'================================================================
'=
'================================================================
Declare Sub Timer1_Timer edecl ()
Sub Timer1_Timer()
    Var PosFromChar As Long
    Var pa As POINTAPI
    Var CursorPos As String
    Var Ret As Long

    'カーソル位置の文字番目を指定
    PosFromChar = Edit1.GetSelTextStart

    '指定文字番目の座標を取得
    Ret = Api_SendMessage(Edit1.GethWnd, EM_POSFROMCHAR, PosFromChar, ByVal CLng(0))

    '指定文字番目が取得範囲内
    If PosFromChar < Len(Edit1.GetWindowText) Then

        'カーソル座標を算出
        pa.x = Ret And &H7FFF
        pa.y = Ret \ (2 ^ 16)

        CursorPos = "(" & Str$(pa.x) & "," & Str$(pa.y) & ")"

        '座標を表示
        SetWindowText CursorPos

    'カーソル位置が取得範囲外
    Else
        'エラーを表示
        SetWindowText "取得範囲外!"
    End If
End Sub

'================================================================
'=
'================================================================
While 1
    WaitEvent
Wend
Stop
End