您的位置：程序门 -> vb ->



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


[收藏此页] [打印本页]选择字色：背景色：字体：[大][中][小]


各位大虾：如何获取richtext的行号?并在鼠标当前位置插入文字、图片？[已结贴,结贴人:colorrain]
发表于：2007-07-04 11:21:18 楼主
请教：richtex控件装载一段文字后，用户点击鼠标，需要返回鼠标当前位置的行号。
并在焦点后插入文字或图片。
发表于：2007-07-04 11:50:361楼 得分:0
请vbadvisor解答：
如何获取richtext的行号?并在鼠标当前位置插入文字、图片？
请教：richtex控件装载一段文字后，用户点击鼠标，需要返回鼠标当前位置的行号。
并在焦点后插入文字或图片。
发表于：2007-07-04 12:54:402楼 得分:0
先看看：
richtextbox   picture   import,   resize,   reorient,   crop   and   export
http://www.planet-source-code.com/vb/scripts/showcode.asp?txtcodeid=41311&lngwid=1
发表于：2007-07-04 15:43:203楼 得分:0
大虾：我看了。谢谢。我主要是要知道在richtext的光标当前位置插入图片，并且要知道光标的所在行的行号。
发表于：2007-07-04 15:46:054楼 得分:0
大虾：我看了您关于richtext删除行，获取行数据的帖子的demo，我想知道光标所在行的行号是怎么获取的。
谢谢
发表于：2007-07-04 15:52:395楼 得分:0
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行号该怎么获取（光标所在行的行号）
发表于：2007-07-04 16:38:056楼 得分:100
这都是基础问题，我没那么多时间，你自己改一下。把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
发表于：2007-07-04 18:04:247楼 得分:0
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

相关文章
其他资讯

快速检索
分类导航标签a

最新资讯
热门点击