Formの中にText1とLabel1が必要です。
Option Explicit
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Const EM_GETFIRSTVISIBLELINE As Long = &HCE
Private Const EM_GETLINECOUNT As Long = &HBA
'一文字の高さ
Private m_lngChrH As Long
Private Sub Form_Load()
'画面単位をピクセルとする
Me.ScaleMode = vbPixels
'ダミーラベル
With Me.Label1
.Visible = False
.AutoSize = True
'テキストボックスと書式を統一
.FontName = Me.Text1.FontName
.FontBold = Me.Text1.FontBold
.FontItalic = Me.Text1.FontItalic
.FontSize = Me.Text1.FontSize
'1文字の高さを取得する
.Caption = "あ"
m_lngChrH = .Height
End With
End Sub
Private Sub Text1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim l_strMsg As String
Dim l_pnt As POINTAPI
'カーソル座標の取得
Call GetCursorPos(l_pnt)
Call ScreenToClient(Me.Text1.hwnd, l_pnt)
l_strMsg = "X:[" & l_pnt.X & "] Y:[" & l_pnt.Y & "] "
'行数を取得
Dim l_lngRowCount As Long
l_lngRowCount = SendMessage(ByVal Me.Text1.hwnd, ByVal EM_GETLINECOUNT, 0, 0)
'スクロール行数の取得
Dim l_lngScroll As Long
l_lngScroll = SendMessage(ByVal Me.Text1.hwnd, ByVal EM_GETFIRSTVISIBLELINE, 0, 0)
'表示上の高さ
Dim l_lngDispH As Long
l_lngDispH = (l_lngRowCount - l_lngScroll) * m_lngChrH
'行の存在しないY座標であれば未処理
If l_lngDispH < l_pnt.Y Then
l_strMsg = l_strMsg & " 該当なし"
Me.Caption = l_strMsg
Exit Sub
End If
'画面上の行番号
Dim l_lngRowDisp As Long
l_lngRowDisp = ((l_pnt.Y - 1) \ m_lngChrH + 1)
'スクロール分を加算
Dim l_lngRow As Long
l_lngRow = l_lngRowDisp + l_lngScroll
l_strMsg = l_strMsg & " " & l_lngRow & "行目"
Me.Caption = l_strMsg
End Sub
お礼
早速の回答をありがとうございます。 うまくいきました。 今後ともお願いします。