Die Community zu .NET und Classic VB.
Menü

VB 5/6-Tipp 0192: Cursor (Caret) manipulieren

 von 

Beschreibung 

Mit dem Cursor eines Textfeldes läßt sich so allerhand anstellen. Die hier gezeigten Möglichkeiten erstrecken sich von der frei wählbaren Größe bis hin zur Darstellung einer eigenen Bitmap als Caret-Ersatz.

Schwierigkeitsgrad:

Schwierigkeitsgrad 1

Verwendete API-Aufrufe:

CreateCaret, DestroyCaret, GetCaretBlinkTime, GetCaretPos, SetCaretBlinkTime, SetCaretPos, ShowCaret

Download:

Download des Beispielprojektes [3,34 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 -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Optionsfeld-Steuerelement "Option1" (Index von 0 bis 3)
' Steuerelement: Kontrollkästchen-Steuerelement "Check1"
' Steuerelement: Timersteuerelement "Timer1"
' Steuerelement: Horizontale Scrollbar "HScroll1"
' Steuerelement: Bildfeld-Steuerelement "Picture1"
' Steuerelement: Textfeld "Text1"
' Steuerelement: Beschriftungsfeld "Label2"
' Steuerelement: Beschriftungsfeld "Label1"

Option Explicit

Private Declare Function GetCaretBlinkTime Lib "user32" _
        () As Long
        
Private Declare Function SetCaretBlinkTime Lib "user32" _
        (ByVal wMSeconds As Long) As Long
        
Private Declare Function GetCaretPos Lib "user32" _
        (lpPoint As POINTAPI) As Long

Private Declare Function SetCaretPos Lib "user32" _
        (ByVal X As Long, ByVal Y As Long) As Long

Private Declare Function DestroyCaret Lib "user32" () _
        As Long

Private Declare Function CreateCaret Lib "user32" _
        (ByVal hwnd As Long, ByVal hBitmap As Long, _
        ByVal nWidth As Long, ByVal nHeight As Long) _
        As Long
        
Private Declare Function ShowCaret Lib "user32" (ByVal _
        hwnd As Long) As Long

Private Type POINTAPI
  X As Long
  Y As Long
End Type

Dim Blnk&

Private Sub Form_Load()
  Blnk = GetCaretBlinkTime
  Label1.Caption = Blnk
End Sub

Private Sub Form_Unload(Cancel As Integer)
  SetCaretBlinkTime (Blnk)
End Sub

Sub Text1_GotFocus()
  If Option1(1) Then
    Call CreateCaret(Text1.hwnd, 0, 32, 32)
    Call ShowCaret(Text1.hwnd)
  ElseIf Option1(2) Then
    Call CreateCaret(Text1.hwnd, Picture1.Picture, 32, 32)
    Call ShowCaret(Text1.hwnd)
  ElseIf Option1(3) Then
    Call DestroyCaret
  End If
End Sub

Private Sub Text1_MouseMove(Button As Integer, Shift As _
                            Integer, X As Single, Y As Single)
  Dim TPP&
    TPP = Screen.TwipsPerPixelX
      If Check1.Value = vbChecked Then
        Call SetCaretPos(CLng(X / TPP), CLng(Y / TPP))
      End If
End Sub

Private Sub Option1_Click(Index As Integer)
  Text1.SetFocus
End Sub

Private Sub Check1_Click()
  Text1.SetFocus
End Sub

Private Sub HScroll1_Change()
  SetCaretBlinkTime (HScroll1.Value)
  Label1.Caption = HScroll1.Value
  Text1.SetFocus
End Sub

Private Sub Timer1_Timer()
  Dim Pt As POINTAPI
    
    Call GetCaretPos(Pt)
    Label2.Caption = "x-" & Pt.X & " y-" & Pt.Y
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Project1.vbp --------------

Tipp-Kompatibilität:

Windows/VB-VersionWin32sWin95Win98WinMEWinNT4Win2000WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version:

Windows-Version:

Ihre Meinung  

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 4 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.

Kommentar von kdpdot am 24.07.2003 um 05:42

Could you tell me how can I do it with VB.NET? Thank you!

Kommentar von kinjin am 31.07.2002 um 09:09

Hi, this scource is for visual basic, and not for VBA (MS WORD 2000).... Sorry, k

Kommentar von jett am 16.03.2002 um 19:49

Guten Tag! My German is not very good. Hope you don't mind me asking a question in English. I have MS Word 2000 and I hate the blinking cursor. It looks to me that you may have a solution for this! But I can't understand the description. Could you please help me? Danke, jett

Kommentar von jett am 16.03.2002 um 19:45

Guten Tag! My German is not very good. Hope you don't mind me asking a question in English. I have MS Word 2000 and I hate the blinking cursor. It looks to me that you may have a solution for this! But I can't understand the description. Could you please help me? Danke, jett