挑战高手！！！100分！！！！

Question

你怎么没有一个象样的nickname
谁能相信你？

Answer 1

你怎么没有一个象样的nickname
谁能相信你？

Answer 2

你怎么没有一个象样的nickname
谁能相信你？

Answer 3

Bardo(巴顿)同志：我的nickname不好吗？

Answer 4

Here are a sample of Track the text insertion position as the user types.Try to  modify it as U wanted to do .
==================================================================
Option ExplicitPrivate Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" _
    (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    
Private Const EM_GETSEL = &HB0
Private Const EM_LINEINDEX = &HBB
Private Const EM_LINEFROMCHAR = &HC9Dim overallCursorPos As Long
Dim currLinePos As Long
Dim chrsBeforeCurrLine As Long
Dim CurrLineCursorPos As LongPrivate Sub Form_Load()
    Label1.Caption = "Type serveral lines for trial.  As you type or move" & _
        " the cursor, statusbar updates the current line and character position"
End SubPrivate Sub Text1_Change()
    DispCaretPos
End SubPrivate Sub Text1_Click()
    DispCaretPos
End SubPrivate Sub text1_KeyUp(KeyCode As Integer, Shift As Integer)
    DispCaretPos
End SubPrivate Sub DispCaretPos()
    On Local Error Resume Next
    'cursor position in the text box (incl CR & LF if any)
    '(Note zero-based)
    overallCursorPos = SendMessageLong(text1.hwnd, EM_GETSEL, 0, 0&) \ &H10000
    'current line pos (Note: zero-based)
    currLinePos = SendMessageLong(text1.hwnd, EM_LINEFROMCHAR, overallCursorPos, 0&)
    'number of chrs upto but before start of the current line
    ' (incl CR & LF f any)
    chrsBeforeCurrLine = SendMessageLong(text1.hwnd, EM_LINEINDEX, _
    currLinePos, 0&)
    'cursor position in terms of current line only (Note: zero-based)
    '
    CurrLineCursorPos = overallCursorPos - chrsBeforeCurrLine
    text1.SetFocus
    ' Note, for example, if you only have 2 sections of the status
    ' bar, then change 3 to 2 below.
    StatusBarMsg "Pos: " & CStr(currLinePos + 1) & ":" & _
    CStr(CurrLineCursorPos + 1) & Space(1), 1
End Sub
 
Private Sub StatusBarMsg(mMsg As String, mPanel As Integer)
    StatusBar1.Panels(mPanel).Text = mMsg
    StatusBar1.Refresh
End Sub

Answer 5

只能通过位置来判断了
GetTextMetrics VB声明 
Declare Function GetTextMetrics Lib "gdi32" Alias "GetTextMetricsA" (ByVal hdc As Long, lpMetrics As TEXTMETRIC) As Long 
说明 
获取与选入一种设备场景的物理字体有关的信息 
返回值 
Long，非零表示成功，零表示失败。会设置GetLastError 
参数表 
参数 类型及说明 
hdc Long，设备场景的句柄 
lpMetrics TEXTMETRIC，用于填充物理字体属性信息的一个结构 

Answer 6

wjying(葡萄) 同志：能更具体一些吗？

Answer 7

通过那个函数得到字与字之间间距
但，做这种事很累的
要是粗糙一点，你可以不用那个api,大概估计一下每个字之间的距离，然后得到鼠标位置判断一下

Answer 8

wjying(葡萄)  同志：每个字的宽度不是相同的啊？

Answer 9

to:ss
你的nickname很好，至少我觉得！  

Answer 10

可以把字的宽度设为相同,或者用api GetTextExtentPoint32

Answer 11

HFONT hFont = (HFONT)GetStockObject(SYSTEM_FIXED_FONT);
SelectObject(hdc, hFont);

Answer 12

对不起，忘了这里是VB版了
ss, 自己改成vb代码把

Answer 13

这样字体就是等宽的啦
然后用GetTextMetrics得到宽度，作hittest就可以了

Answer 14

idoloveyou(我18岁，成人了！) 同志：不行啊！

Answer 15

看不懂大家都在讨论啥？TEXTOUT是什么东西？
如果是textbox的话太简单了：
Private Sub Text1_Click()
    Debug.Print Mid(Text1, Text1.SelStart + 1, 1)
End Sub

Answer 16

如果是Print方法在Form上画字符，那也很简单啊：Dim xx As String, yy As Single, ww As Single, hh As Single
Dim strPrint As String
Dim I As Integer
Private Sub Form_Activate()
    strPrint = "中国人民 Very Good"
    xx = Me.CurrentX
    yy = Me.CurrentY
    For I = 1 To Len(strPrint)
        ww = ww + Me.TextWidth(Mid(strPrint, I, 1))
    Next
    hh = Me.TextHeight(strPrint)
    Me.Print strPrint
End SubPrivate Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim tmpww As Single
    If X < xx Or X > xx + ww Then Exit Sub
    If Y < yy Or Y > yy + hh Then Exit Sub
    For I = 1 To Len(strPrint)
        tmpww = tmpww + Me.TextWidth(Mid(strPrint, I, 1))
        If X < tmpww Then
            Debug.Print Mid(strPrint, I, 1)
            Exit Sub
        End If
    Next
    Debug.Print Right(strPrint, 1)
End Sub

Answer 17

上面一段有点小问题，再改一下：Dim xx As String, yy As Single, ww As Single, hh As Single
Dim strPrint As String
Dim I As Integer
Private Sub Form_Activate()
    strPrint = "中国人民 Very Good 2.1415926"
    Me.CurrentX = 1500
    Me.CurrentY = 1000
    Me.AutoRedraw = True
    xx = Me.CurrentX
    yy = Me.CurrentY
    Me.FontSize = 20
    For I = 1 To Len(strPrint)
        ww = ww + Me.TextWidth(Mid(strPrint, I, 1))
    Next
    hh = Me.TextHeight(strPrint)
    Me.Print strPrint
End SubPrivate Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim tmpww As Single
    If X < xx Or X > xx + ww Then Exit Sub
    If Y < yy Or Y > yy + hh Then Exit Sub
    For I = 1 To Len(strPrint)
        tmpww = tmpww + Me.TextWidth(Mid(strPrint, I, 1))
        If X < xx + tmpww Then
            Debug.Print Mid(strPrint, I, 1)
            Exit Sub
        End If
    Next
    Debug.Print Right(strPrint, 1)
End Sub

Answer 18

fuxc(Michael)  同志：有没有办法实现像Textbox中字符被选定的效果？