Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0026: Wort unter dem Mauszeiger erfassen [RichTextbox]

VB 5/6-Tipp 0026: Wort unter dem Mauszeiger erfassen [RichTextbox]

 von ActiveVB

Schwierigkeitsgrad:

Verwendete API-Aufrufe: SendMessageA (SendMessage)

Download: Download des Beispielprojektes [3,42 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Project1.vbp -------------
' Die Komponente 'Microsoft Rich Textbox Control 6.0 (RICHTX32.OCX)' wird benötigt.

'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: RichTextBox "RichTextBox1"
' Steuerelement: Beschriftungsfeld "Label1"

Option Explicit

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 Const EM_CHARFROMPOS& = &HD7

Private Type POINTAPI
  X As Long
  Y As Long
End Type

Private Sub Form_Load()
 '### Beispieltext zuweisen
  RichTextBox1.Text = "Es ist für den Unverständigen schwer zu be" _
   & "greifen woran sie eigentlich arbeiten. Befragt man sie, so " _
   & "erhält man übrigens detaillierte und geduldige Auskunft dar" _
   & "über, daß sie an etwas arbeiten, was die unabdingbare Vorau" _
   & "ssetzung für ein weiteres Vorhaben ist, das vielleicht sein" _
   & "erseits nur Mittel zum Zweck ist. Nie findet man sie mit et" _
   & "was Endgültigem, es scheint die Essenz ihres Strebens zu se" _
   & "in, daß sich alles im Fluß befindet. Vielleicht hat ihr Hob" _
   & "by eigentlich keinen Zweck und ist somit das edelste überha" _
   & "upt; sie arbeiten unermüdlich für etwas, das sie nie erreic" _
   & "hen, dem sie nicht einmal nahekommen, ein Zustand endloser " _
   & "Glückseligkeit!"
End Sub

Private Sub RichTextBox1_MouseMove(Button%, Shift%, X As Single, _
                                   Y As Single)
  Dim Text$
    Text = GetWord(RichTextBox1, X, Y)
    If Label1.Caption <> Text Then Label1.Caption = Text
End Sub

Private Function GetWord(Rich As RichTextBox, ByVal X&, _
                         ByVal Y&) As String
  Dim POS&, P1&, P2&
  Dim Char$
  Dim MPointer As POINTAPI

    '### Position des Textzeichens unter dem Mauszeiger auslesen
    MPointer.X = X \ Screen.TwipsPerPixelX
    MPointer.Y = Y \ Screen.TwipsPerPixelY
    POS = SendMessage(Rich.hWnd, EM_CHARFROMPOS, 0&, MPointer)
    If POS <= 0 Then Exit Function

    '### Wortanfang finden
    For P1 = POS To 1 Step -1
      Char = Mid$(Rich.Text, P1, 1)
      If Not CheckChar(Char) Then Exit For
    Next P1
    P1 = P1 + 1

    '### Wortende finden
    For P2 = POS To Len(Rich.Text)
      Char = Mid$(Rich.Text, P2, 1)
      If Not CheckChar(Char) Then Exit For
    Next P2
    P2 = P2 - 1

    If P1 < P2 Then GetWord = Mid$(Rich.Text, P1, P2 - P1 + 1)
End Function

Private Function CheckChar(ByVal Char$) As Boolean
  '### Testen auf Trennzeichen eines Wortes
  If ((Char >= "0" And Char <= "9") Or _
      (Char >= "a" And Char <= "z") Or _
      (Char >= "A" And Char <= "Z") Or _
      (InStr("äöüÄÖÜß", Char))) Then CheckChar = True
End Function
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Project1.vbp --------------

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 5 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.