VB6 - On Screen Keyboard, freezes entire computer at random

Posted on 2008-10-26
Last Modified: 2010-05-18

I have created a On Screen Keyboard which i use for my application, i made it simply by creating a form and adding a bucketload of buttons to it.
Q W E R TY and so  on.

As this keyboard needs to be able to manipulate data fields all over my application i need it to retain from aquiring focus and allow it to enter values into the active field.
I have managed this by using
    Call SetWindowPos(Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, TOPMOST_FLAGS)
    Call SetWindowLong(Me.hwnd, GWL_EXSTYLE, GetWindowLong(Me.hwnd, GWL_EXSTYLE) Or WS_EX_NOACTIVATE)

This all works very well, however my customers will call me up and tell me that the computer is stuck, they cant press anything on the screen, not the OnScreenKeyboard (OSK), nor the application running behind it.

Sometimes when this happens it seems that one of the buttons on the OSK is repeadetly recieving and losing focus, but nothing happens trying to click anything.
As soon as you try to shut down the computer though or changing the focus to something else like using CTRL+ALT+DELETE everything is fine again.

I think this is happening when i activate the keyboard from my main application, iam using a socket connection which send different commands to the keyboard (ON, ONOFF, OFF).

In the Form_Load of a form where i need the keyboard i will be doing something like

Sub showTouchView(Optional nPad As Boolean)
    If Not frmFront.currentSetup.ws_touchTast Then Exit Sub
    nextTouchCommand = "ON|" & IIf(nPad, 1, 0) & "|" & IIf(frmFront.currentSetup.ws_chkTouchView, 1, 0) & "<EOF>"
    submitToTouch (nextTouchCommand)
End Sub
Function submitToTouch(aStr As String)
    If frmFront.touchControl.state = sckConnected Then
        frmFront.touchControl.SendData (aStr)
        nextTouchCommand = ""
        If frmFront.touchControl.state <> sckListening Then
        End If
        glPid = Shell(App.path & "\FlexyBook.exe -touch")

    End If
End Function

So does anyone have any idea what could be happening to make the entire windows interface freeze up until you press something as dractically as CTRL+ALT+DELETE.
I have been thinking that maybe it is because two forms may get loaded simultaneusly and they both want to recieve focus, however my OSK shouldnt want focus.
The fact that iam using a socket may also be the reason that this is only happening sometimes since data may be more or less delayed, meaning the OSK will be loaded at different times at each point, however this could also vary from pc to pc.
Option Explicit

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long

Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, Y, ByVal CX As Long, ByVal CY As Long, ByVal wFlags As Long) As Long

Dim storedData As String

Private Const HWND_TOPMOST = -1

Private Const SWP_NOMOVE = &H2

Private Const SWP_NOSIZE = &H1


Dim touchNumpad As Boolean

Dim padOff As Boolean

Dim showKeyBoardButton As Boolean

Dim placeTop1 As Long

Dim placeLeft1 As Long

Dim placeTop2 As Long

Dim placeLeft2 As Long

Dim placeTop3 As Long ' numpad loc

Dim placeLeft3 As Long ' numpad loc

Private Const WS_EX_NOACTIVATE = &H8000000

Private Const GWL_EXSTYLE = (-20)

Dim curAlarms As New Collection

Private Sub Command1_Click(Index As Integer)

    Me.Label1.Caption = "enter"

    SendKeys Chr(vbKeyReturn)

End Sub

Private Sub Command4_Click()

    Me.Label1.Caption = "space"

    SendKeys Chr(vbKeySpace)

End Sub

Private Sub Command5_Click()


End Sub

Private Sub Command6_Click(Index As Integer)

    Me.Label1.Caption = "{F" & Index + 1 & "}"

    SendKeys ("{F" & Index + 1 & "}")

End Sub

Private Sub Command7_Click(Index As Integer)


End Sub

Private Sub CommandBack_Click(Index As Integer)

    Me.Label1.Caption = "back"

    SendKeys Chr(vbKeyBack)

End Sub

Private Sub Form_Load()

    Call SetWindowPos(Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, TOPMOST_FLAGS)

    Call SetWindowLong(Me.hwnd, GWL_EXSTYLE, GetWindowLong(Me.hwnd, GWL_EXSTYLE) Or WS_EX_NOACTIVATE)

    placeTop3 = getSetting("kaTop3", True, 2009)

    placeLeft3 = getSetting("kaLeft3", True, 2000)

    placeTop2 = getSetting("kaTop2", True, 2009)

    placeLeft2 = getSetting("kaLeft2", True, 2000)

    placeTop1 = getSetting("kaTop", True, 0)

    placeLeft1 = getSetting("kaLeft", True, Screen.Width - (2000)) = placeTop1

    Me.left = placeLeft1

    Me.Frame1.Visible = False

    Me.Frame2.Visible = False

    Me.Width = Me.Command5.Width + 80

    Me.Height = Me.Command5.Height + 330

    Me.Command5.Visible = True

    showKeyBoardButton = False

    padOff = True

End Sub

Function toggle()

    If Me.Command5.Visible = True Then




    End If

End Function

Sub toggleOff()

    If padOff Then Exit Sub

    padOff = True

    Me.Frame1.Visible = False

    Me.Frame2.Visible = False

    Me.Visible = showKeyBoardButton

    Me.Width = Me.Command5.Width + 80

    Me.Height = Me.Command5.Height + 330

    If touchNumpad Then

        placeTop3 =

        placeLeft3 = Me.left

        Call saveSetting("kaTop3",

        Call saveSetting("kaLeft3", Me.left)


        placeTop2 =

        placeLeft2 = Me.left

        Call saveSetting("kaTop2",

        Call saveSetting("kaLeft2", Me.left)

    End If = placeTop1

    Me.left = placeLeft1

    Me.Command5.Visible = True

End Sub

Sub toggleOn(Optional nPad As Boolean)

    If Not padOff Then toggleOff

    padOff = False

    touchNumpad = nPad


    placeTop1 = '' Store min loc

    placeLeft1 = Me.left

    If touchNumpad Then

        Me.Width = Frame1.Width + 150

        Me.Height = Frame1.Height + 400 = placeTop3

        Me.left = placeLeft3


        Me.Width = Frame2.Width + 150

        Me.Height = Frame2.Height + 400 = placeTop2

        Me.left = placeLeft2

    End If

    Me.Visible = True

    Me.Frame1.Visible = touchNumpad

    Me.Frame2.Visible = Not touchNumpad

    Me.Command5.Visible = False

End Sub

Private Sub Command2_Click(Index As Integer)

    Me.Label1.Caption = Command2(Index).Caption

    If Index = 56 Then

        Dim tStr As String, i As Long

        For i = 0 To Command2.UBound

            If Command2(i).Tag <> "" Then

                tStr = Command2(i).Caption

                Command2(i).Caption = Command2(i).Tag

                Command2(i).Tag = tStr

            End If


        If Command2(56).backcolor = RGB(255, 0, 0) Then '

            Command2(56).backcolor = &H8000000F


            Command2(56).backcolor = RGB(255, 0, 0)

        End If


        If Command2(Index).Caption = ")" Or Command2(Index).Caption = "(" Then

            SendKeys "{" & Command2(Index).Caption & "}"


            SendKeys Command2(Index).Caption

        End If

    End If


End Sub

Private Sub Form_Unload(Cancel As Integer)

    If padOff Then

        Call saveSetting("kaTop",

        Call saveSetting("kaLeft", Me.left)


        Call saveSetting("kaTop", placeTop1)

        Call saveSetting("kaLeft", placeLeft1)

    End If

End Sub

Private Sub touchControl_Close()


End Sub

Private Sub touchControl_DataArrival(ByVal bytesTotal As Long)

Dim jj As Long

    Dim sItemData As String

    Dim dataBits() As String

    Dim commandBits() As String

    Dim i As Long

    ' get data from client

    touchControl.GetData sItemData, vbString

    sItemData = storedData & sItemData

    dataBits = Split(sItemData, "<EOF>")

    If UBound(dataBits) = 0 Then

        storedData = sItemData


        If dataBits(UBound(dataBits)) <> "" Then

            storedData = dataBits(UBound(dataBits))


            storedData = ""

        End If

    End If

    For i = 0 To UBound(dataBits) - 1

        Dim iSplit() As String

        iSplit = Split(dataBits(i), "|")

        If iSplit(0) = "ON" Then

            showKeyBoardButton = iSplit(2)

            toggleOn ((iSplit(1) = "1"))

        ElseIf iSplit(0) = "ONOFF" Then

            showKeyBoardButton = iSplit(2)

            toggleOn ((iSplit(1) = "1"))


        ElseIf iSplit(0) = "OFF" Then



End Sub

Private Sub touchControl_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)


End Sub

Open in new window

Question by:mSchmidt
1 Comment
LVL 85

Accepted Solution

Mike Tomlinson earned 500 total points
ID: 22807399

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

If you have ever used Microsoft Word then you know that it has a good spell checker and it may have occurred to you that the ability to check spelling might be a nice piece of functionality to add to certain applications of yours. Well the code that…
If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

895 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

15 Experts available now in Live!

Get 1:1 Help Now