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

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
MsgBox 2 59
Sending a email via excel using vba 6 100
Copy a row 12 64
checkbox to hide entire section 10 43
When trying to find the cause of a problem in VBA or VB6 it's often valuable to know what procedures were executed prior to the error. You can use the Call Stack for that but it is often inadequate because it may show procedures you aren't intereste…
This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

821 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