各位大虾：如何获取RICHTEXT的行号?并在鼠标当前位置插入文字、图片？

[colorrain]

请教：RichTex控件装载一段文字后，用户点击鼠标，需要返回鼠标当前位置的行号。
并在焦点后插入文字或图片。

[colorrain]

大虾：我看了。谢谢。我主要是要知道在richtext的光标当前位置插入图片，并且要知道光标的所在行的行号。

[colorrain]

大虾：我看了您关于richtext删除行，获取行数据的帖子的demo，我想知道光标所在行的行号是怎么获取的。
谢谢

[colorrain]

Public Function GetLineText(ByVal handle As Long, ByVal Index As Long) As String

Dim LineText() As Byte
Dim size As Long
Dim pos As Long

pos = SendMessage(handle, EM_LINEINDEX, Index, 0)
size = SendMessage(handle, EM_LINELENGTH, pos, 0)
If size = 0 Then
GetLineText = ""
Else
ReDim LineText((size - 1) + 1)
CopyMemory LineText(0), size, 2
size = SendMessage(handle, EM_GETLINE, Index, LineText(0))
GetLineText = StrConv(LeftB(LineText, size), vbUnicode)
End If

End Function
请问：函数中index行号该怎么获取（光标所在行的行号）

[VBAdvisor]

这都是基础问题，我没那么多时间，你自己改一下。把Property Get改为Function.m_hWndEB改为Textbox.hWnd,RichEdit应该也支持吧。

Public Property Get CurrentLine() As Long

CurrentLine = LineForCharacterIndex(SelStart)

End Property

Public Property Get LineForCharacterIndex(lIndex As Long) As Long

LineForCharacterIndex = SendMessageLong(m_hWndEB, EM_LINEFROMCHAR, lIndex, 0)

End Property

Public Property Get SelStart() As Long

Dim lEnd As Long
Dim lStart As Long

If m_hWndEB Then
SendMessageLong m_hWndEB, EM_GETSEL, VarPtr(SelStart), VarPtr(lEnd)
End If

End Property


Public Property Get CurrentColumn() As Long

Dim lCharPos As Long
Dim lResult As Long
Dim udtPT As POINTAPI

GetCaretPos udtPT
lCharPos = MakeDWord(CInt(udtPT.y), CInt(udtPT.x))
lResult = SendMessage(m_hWndEB, EM_CHARFROMPOS, ByVal 0&, ByVal lCharPos)
lCharPos = LoWord(lResult)
CurrentColumn = lCharPos - SendMessage(m_hWndEB, EM_LINEINDEX, ByVal -1, 0&)

End Property

Function LoWord(ByVal DWord As Long) As Integer

If DWord And &H8000& Then
LoWord = DWord Or &HFFFF0000
Else
LoWord = DWord And &HFFFF&
End If

End Function

Function HiWord(ByVal DWord As Long) As Integer

HiWord = (DWord And &HFFFF0000) \ 65536

End Function

Function MakeDWord(wHi As Integer, wLo As Integer) As Long

If wHi And &H8000& Then
MakeDWord = (((wHi And &H7FFF&) * 65536) Or (wLo And &HFFFF&)) Or &H80000000
Else
MakeDWord = (wHi * 65536) + wLo
End If

End Function

[VBAdvisor]

Private Const WM_USER = &H400
Private Const EM_EXGETSEL = WM_USER + 52

Private Const EM_LINEFROMCHAR = &HC9
Private Const EM_LINEINDEX = &HBB
Private Const EM_GETSEL = &HB0

Private Type CHARRANGE
cpMin As Long
cpMax As Long
End Type

Private Type POINTAPI
x As Long
y As Long
End Type

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

Private Declare Sub CopyMemory Lib "kernel32" Alias _
"RtlMoveMemory" (pDst As Any, pSrc As Any, _
ByVal ByteLen As Long)


'取得光标所在的行和列
Private Function GetCurPos(ByRef TextControl As Control) As POINTAPI
Dim LineIndex As Long
Dim SelRange As CHARRANGE
Dim TempStr As String
Dim TempArray() As Byte
Dim CurRow As Long
Dim CurPos As POINTAPI

TempArray = StrConv(TextControl.Text, vbFromUnicode)

'取得当前被选中文本的位置适用于RichTextBox
'TextControl用EM_GETSEL消息
Call SendMessage(TextControl.hWnd, EM_EXGETSEL, 0, SelRange)

'根据参数wParam指定的字符位置返回该字符所在的行号
CurRow = SendMessage(TextControl.hWnd, EM_LINEFROMCHAR, SelRange.cpMin, 0)

'取得指定行第一个字符的位置
LineIndex = SendMessage(TextControl.hWnd, EM_LINEINDEX, CurRow, 0)

If SelRange.cpMin = LineIndex Then
GetCurPos.x = 1
Else

TempStr = String(SelRange.cpMin - LineIndex, 13)

'复制当前行开始到选择文本开始的文本
CopyMemory ByVal StrPtr(TempStr), ByVal StrPtr(TempArray) + LineIndex, SelRange.cpMin - LineIndex
TempArray = TempStr

'删除无用的信息
ReDim Preserve TempArray(SelRange.cpMin - LineIndex - 1)

'转换为Unicode
TempStr = StrConv(TempArray, vbUnicode)

GetCurPos.x = Len(TempStr) + 1
End If
GetCurPos.y = CurRow + 1
End Function

Private Sub RichEdit1_Click()
Debug.Print "y=" & GetCurPos(RichEdit1).y
Debug.Print "x=" & GetCurPos(RichEdit1).x
End Sub

[colorrain]

请VBAdvisor解答：
如何获取RICHTEXT的行号?并在鼠标当前位置插入文字、图片？
请教：RichTex控件装载一段文字后，用户点击鼠标，需要返回鼠标当前位置的行号。
并在焦点后插入文字或图片。

[VBAdvisor]

先看看：
RichTextBox picture import, resize, reorient, crop and export
http://www.Planet-Source-Code.com/vb/scripts/ShowCode.asp?txtCodeId=41311&lngWId=1