Современные решения

для защиты Windows приложений

и восстановления исходного кода
Автор: vbcode. Дата публикации: 04.08.2004

Какое слово под курсором мыши


Данный пример покажет вам, какое слово находится под курсором мыши в элементе RichTextBox.
Добавьте на форму элемент RichTextBox и элемент Label

Private Const EM_CHARFROMPOS& = &HD7 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 Public Function RichWordOver(rch As RichTextBox, X As Single, Y As Single) As String Dim pt As POINTAPI Dim pos As Integer Dim start_pos As Integer Dim end_pos As Integer Dim ch As String Dim txt As String Dim txtlen As Integer pt.X = X \ Screen.TwipsPerPixelX pt.Y = Y \ Screen.TwipsPerPixelY pos = SendMessage(rch.hWnd, EM_CHARFROMPOS, 0&, pt) If pos <= 0 Then Exit Function txt = rch.Text For start_pos = pos To 1 Step -1 ch = Mid$(rch.Text, start_pos, 1) If Not ((ch >= "0" And ch <= "9") Or (ch >= "a" And ch <= "z") Or (ch >= "A" And ch <= "Z") Or ch = "_") Then Exit For Next start_pos start_pos = start_pos + 1 txtlen = Len(txt) For end_pos = pos To txtlen ch = Mid$(txt, end_pos, 1) If Not ((ch >= "0" And ch <= "9") Or (ch >= "a" And ch <= "z") Or (ch >= "A" And ch <= "Z") Or ch = "_") Then Exit For Next end_pos end_pos = end_pos - 1 If start_pos <= end_pos Then RichWordOver = Mid$(txt, start_pos, end_pos - start_pos + 1) End Function Private Sub Form_Load() Label1.Caption = "" RichTextBox1.Text = "Ready-To-Run Visual Basic Algorithms, Second Edition" & vbCrLf & vbCrLf & "Extend your applications with powerful algorithms written in Visual Basic. Sorting, searching, trees, hashing, advanced recursion, network algorithms, object-oriented programming, and much more. Visual Basic Algorithms updated and expanded for Visual Basic 5." & vbCrLf & vbCrLf & "http://www.vb-helper.com/vba.htm" End Sub Private Sub RichTextBox1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim txt As String txt = RichWordOver(RichTextBox1, X, Y) If Label1.Caption <> txt Then Label1.Caption = txt End Sub


Комментарии

отсутствуют

Добавление комментария


Ваше имя (на форуме):

Ваш пароль (на форуме):

Комментарии могут добавлять только пользователи,
зарегистрированные на форуме данного сайта. Если Вы не
зарегистрированы, то сначала зарегистрируйтесь тут

Комментарий: