Переход По Гиперссылке

Тема в разделе "Visual Basic", создана пользователем aiswork, 8 окт 2012.

Статус темы:
Закрыта.
  1. aiswork

    aiswork Гость

    Здравствуйте!
    Как сделать переход по многострочной гиперссылке т.е. размещающейся на нескольких строках в RichTextBox.
    По ссылке в одной строке переход не проблема, а с этой что-то не ладится.
    Если кто знает, пожалуйста помогите.
    Спасибо.
     
  2. aiswork

    aiswork Гость

    Всем Спасибо.
    Я нашел что искал.
    Если кому-то интересно, вот код.

    Определяет какое слово под курсором.
    Естественно, доработаете под свои нужды.

    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
     
Загрузка...
Статус темы:
Закрыта.

Поделиться этой страницей