• Home
 · 
• Windows API Call/Explanation
 · 
• Controlling carat blinking speed using API

Controlling carat blinking speed using API

Controlling carat blinking speed using API

API Declarations



' Returns the current cursor blink rate
Declare Function GetCaretBlinkTime Lib "user32" () As Long

' Sets the cursor blink rate
Declare Function SetCaretBlinkTime Lib "user32" _
(ByVal wMSeconds As Long) As Long

' Returns the error code if either GetCaretBlinkTime or
' SetCaretBlinkTime functions fails
Public Declare Function GetLastError Lib "kernel32" () As Long




Rate Controlling carat blinking speed using API

• 1
• 2
• 3
• 4
• 5

(2(2 Vote))

   Dim lDefaultTime As Long
   Dim lResult As Long
   Dim lErrorCode As Long

   Private Sub Form_Load()
      lResult = GetCaretBlinkTime

      If lResult = 0 Then
         Call DisplayError(0)
      Else
         lDefaultTime = lResult
         HScroll1.Min = 10
         HScroll1.Max = 1000
         HScroll1.Value = lDefaultTime
         Text1.Text = CStr(lDefaultTime)
         Command1.Caption = "Return to Default"
      End If
   End Sub

   Private Sub Command1_Click()
      lResult = SetCaretBlinkTime(lDefaultTime)
      
      ' If the function fails then display a message box with the error code
      If lResult = 0 Then
         Call DisplayError(1)
      Else
         ' Display the new blink rate.
         HScroll1.Value = lDefaultTime
         Text1.Text = CStr(GetCaretBlinkTime)
         HScroll1.SetFocus
      End If
   End Sub

   Private Sub HScroll1_Change()
      lResult = SetCaretBlinkTime(HScroll1.Value)

      If lResult = 0 Then
         Call DisplayError(1)
      Else
         lResult = GetCaretBlinkTime
         If GetCaretBlinkTime = 0 Then
            Call DisplayError(0)
         Else
            Text1.Text = CStr(lResult)
         End If
      End If
   End Sub

   Private Sub HScroll1_Scroll()
      Text1.Text = CStr(HScroll1.Value)
   End Sub

   Private Sub Text1_KeyPress(KeyAscii As Integer)
      If KeyAscii = vbKeyReturn Then
         Dim iTextValue As Integer
         iTextValue = CInt(Text1.Text)

         If iTextValue > 1000 Or iTextValue < 10 Then
            MsgBox "Enter a number between 10 and 1000."
            Text1.Text = CStr(HScroll1.Value)
            Exit Sub
         Else
            HScroll1.Value = iTextValue
         End If
      End If
   End Sub

   Private Sub Form_Terminate()
      lResult = SetCaretBlinkTime(lDefaultTime)

      If lResult = 0 Then
         lErrorCode = GetLastError
         MsgBox ("SetCaretBlinkTime failed. Error" & CStr(lErrorCode))
      End If
   End Sub

   Private Sub DisplayError(iFail As Integer)
      Dim sErrorMsg As String
      lErrorCode = GetLastError

      Select Case iFail
         Case 0   ' GetCaretBlinkRate Function Failed
            sErrorMsg = "GetCaretBlinkRate Failed. Error Code "
            sErrorMsg = sErrorMsg & CStr(lErrorCode)
         Case 1
            sErrorMsg = "SetCaretBlinkRate Failed. Error Code "
            sErrorMsg = sErrorMsg & CStr(lErrorCode)
         Case Else
            sErrorMsg = "Unknown Error"
      End Select

      MsgBox (sErrorMsg)
   End Sub