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
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
1 Comment
LVL 86

Accepted Solution

Mike Tomlinson earned 500 total points
ID: 22807399

Featured Post

Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone 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

Have you ever wanted to restrict the users input in a textbox to numbers, and while doing that make sure that they can't 'cheat' by pasting in non-numeric text? Of course you can do that with code you write yourself but it's tedious and error-prone …
Article by: Martin
Here are a few simple, working, games that you can use as-is or as the basis for your own games. Tic-Tac-Toe This is one of the simplest of all games.   The game allows for a choice of who goes first and keeps track of the number of wins for…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
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…

738 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