Solved

VB6 - On Screen Keyboard, freezes entire computer at random

Posted on 2008-10-26
1
1,090 Views
Last Modified: 2010-05-18
Hi

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
showTouchView()

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 = ""
        DoEvents
    Else
        If frmFront.touchControl.state <> sckListening Then
            frmFront.touchControl.Close
            DoEvents
            frmFront.touchControl.Listen
        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

Private Const TOPMOST_FLAGS = SWP_NOMOVE Or SWP_NOSIZE

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()

    toggle

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)

    toggle

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))

    Me.top = 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

        toggleOn

    Else

        toggleOff

    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 = Me.top

        placeLeft3 = Me.left

        Call saveSetting("kaTop3", Me.top)

        Call saveSetting("kaLeft3", Me.left)

    Else

        placeTop2 = Me.top

        placeLeft2 = Me.left

        Call saveSetting("kaTop2", Me.top)

        Call saveSetting("kaLeft2", Me.left)

    End If

    Me.top = 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 = Me.top '' Store min loc

    placeLeft1 = Me.left

    If touchNumpad Then

        Me.Width = Frame1.Width + 150

        Me.Height = Frame1.Height + 400

        Me.top = placeTop3

        Me.left = placeLeft3

    Else

        Me.Width = Frame2.Width + 150

        Me.Height = Frame2.Height + 400

        Me.top = 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

        Next

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

            Command2(56).backcolor = &H8000000F

        Else

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

        End If

    Else

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

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

        Else

            SendKeys Command2(Index).Caption

        End If

    End If

        

End Sub
 

Private Sub Form_Unload(Cancel As Integer)

    If padOff Then

        Call saveSetting("kaTop", Me.top)

        Call saveSetting("kaLeft", Me.left)

    Else

        Call saveSetting("kaTop", placeTop1)

        Call saveSetting("kaLeft", placeLeft1)

    End If

End Sub
 

Private Sub touchControl_Close()

    End

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

    Else

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

            storedData = dataBits(UBound(dataBits))

        Else

            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"))

            toggleOff

        ElseIf iSplit(0) = "OFF" Then

            toggleOff

    Next

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

End Sub

Open in new window

0
Comment
Question by:mSchmidt
1 Comment
 
LVL 85

Accepted Solution

by:
Mike Tomlinson earned 500 total points
ID: 22807399
0

Featured Post

Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

Join & Write a Comment

Suggested Solutions

Introduction While answering a recent question about filtering a custom class collection, I realized that this could be accomplished with very little code by using the ScriptControl (SC) library.  This article will introduce you to the SC library a…
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
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…

758 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

17 Experts available now in Live!

Get 1:1 Help Now