frmserialtokeyboard.frm

Program to convert data from RS232 Serial) to keyboard.

Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" _
          (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
Private Declare Function SetForegroundWindow Lib "user32" _
          (ByVal hwnd As Long) As Long


'//UDT required by Shell_NotifyIcon API call
Private Type NOTIFYICONDATA
    cbSize As Long             '//size of this UDT
    hwnd As Long               '//handle of the app
    uId As Long                '//unused (set to vbNull)
    uFlags As Long             '//Flags needed for actions
    uCallBackMessage As Long   '//WM we are going to subclass
    hIcon As Long              '//Icon we're going to use for the systray
    szTip As String * 64       '//ToolTip for the mouse_over of the icon.
End Type


'//Constants required by Shell_NotifyIcon API call:
Private Const NIM_ADD = &H0             '//Flag : "ALL NEW nid"
Private Const NIM_MODIFY = &H1          '//Flag : "ONLY MODIFYING nid"
Private Const NIM_DELETE = &H2          '//Flag : "DELETE THE CURRENT nid"
Private Const NIF_MESSAGE = &H1         '//Flag : "Message in nid is valid"
Private Const NIF_ICON = &H2            '//Flag : "Icon in nid is valid"
Private Const NIF_TIP = &H4             '//Flag : "Tip in nid is valid"
Private Const WM_MOUSEMOVE = &H200      '//This is our CallBack Message
Private Const WM_LBUTTONDOWN = &H201    '//LButton down
Private Const WM_LBUTTONUP = &H202      '//LButton up
Private Const WM_LBUTTONDBLCLK = &H203  '//LDouble-click
Private Const WM_RBUTTONDOWN = &H204    '//RButton down
Private Const WM_RBUTTONUP = &H205      '//RButton up
Private Const WM_RBUTTONDBLCLK = &H206  '//RDouble-click

Private nid As NOTIFYICONDATA       '//global UDT for the systray function

Dim Reply$
Dim sBaud$(7)
Dim xHeight As Long
Dim xWidth As Long

Private Sub EnableActivate()
    Dim Chk01 As Boolean
    Dim Chk02 As Boolean
    Dim Chk03 As Boolean
    
    If optDATA(1).Value = True Then
        If Len(Trim$(txtLEFT)) > 0 Then
            Chk01 = True
        Else
            Chk01 = False
        End If
    Else
        Chk01 = True
    End If

    If optDATA(2).Value = True Then
        If Len(Trim$(txtRIGHT)) > 0 Then
            Chk02 = True
        Else
            Chk02 = False
        End If
    Else
        Chk02 = True
    End If

    If chkPREFIX.Value = 1 Then
        If Len(Trim$(txtPREFIX)) > 0 Then
            Chk03 = True
        Else
            Chk03 = False
        End If
    Else
        Chk03 = True
    End If
    
    If Chk01 And Chk02 And Chk03 Then
        cmdActivate.Enabled = True
    Else
        cmdActivate.Enabled = False
    End If
End Sub

Private Sub chkENTER_Click()
    If chkENTER.Value = 1 Then
        chkENTER.FontBold = True
    Else
        chkENTER.FontBold = False
    End If
End Sub

Private Sub chkPREFIX_Click()
    If chkPREFIX.Value = 1 Then
        chkPREFIX.FontBold = True
        txtPREFIX.Enabled = True
    Else
        chkPREFIX.FontBold = False
        txtPREFIX.Enabled = False
    End If
    EnableActivate
End Sub

Private Sub cmdActivate_Click()
    Dim sSetting$
    
    On Error GoTo Err_OpenCom
    
    sSetting$ = sBaud$(cmboBAUD.ListIndex)
    sSetting$ = sSetting$ & "," & Left$(Trim$(cmboPARITY.Text), 1)
    sSetting$ = sSetting$ & "," & Trim$(cmboDATABIT.Text)
    sSetting$ = sSetting$ & "," & Trim$(cmboSTOPBIT.Text)
    
    comONLINE.Settings = sSetting$
    comONLINE.CommPort = cmboPORT.ListIndex + 1
    
    comONLINE.PortOpen = True
    
    Me.WindowState = 1
    
Exit_Sub:
    Exit Sub
Err_OpenCom:
    MsgBox Err.Number & "-" & Error$
    Resume Exit_Sub
End Sub

Private Sub cmdEXIT_Click()
    Unload Me
End Sub

Private Sub comONLINE_OnComm()
    Dim i As Integer
    Dim strStr$
    
    Select Case comONLINE.CommEvent
        Case comEvReceive
            Reply$ = Reply$ & comONLINE.Input
            strStr$ = ""
            For i = 1 To Len(Trim$(Reply$))
                If (Mid$(Reply$, i, 1) >= "0" And Mid$(Reply$, i, 1) <= "9") Or _
                    (Mid$(Reply$, i, 1) >= "A" And Mid$(Reply$, i, 1) <= "Z") Or _
                    (Mid$(Reply$, i, 1) >= "a" And Mid$(Reply$, i, 1) <= "z") Then
                    strStr$ = strStr$ & Mid$(Reply$, i, 1)
                End If
            Next
            
            If optDATA(1).Value Then
                strStr$ = Left$(strStr$, Val(txtLEFT))
            ElseIf optDATA(2).Value Then
                strStr$ = Right$(strStr$, Val(txtRIGHT))
            End If
            
            If chkENTER.Value = 1 Then
                strStr$ = strStr$ & Chr$(13)
            End If

            If chkPREFIX.Value = 1 Then
                strStr$ = txtPREFIX & strStr$
            End If
            
            SendKeys strStr$
            
            Reply$ = ""
    End Select
End Sub

Private Sub Form_Activate()
    With nid
        .cbSize = Len(nid)
        .hwnd = Me.hwnd
        .uId = vbNull
        .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
        .uCallBackMessage = WM_MOUSEMOVE
        .hIcon = Me.Icon
        .szTip = "Serial To Keyboard" & vbNullChar
    End With
    
    Shell_NotifyIcon NIM_ADD, nid
End Sub

Private Sub Form_Load()
    Dim i As Integer
    
    sBaud$(0) = "115200"
    sBaud$(1) = "57600"
    sBaud$(2) = "38400"
    sBaud$(3) = "19200"
    sBaud$(4) = "9600"
    sBaud$(5) = "4800"
    sBaud$(6) = "2400"
    
    cmboPORT.Clear
    
    For i = 1 To 16
        cmboPORT.AddItem "COM" & Trim$(Str$(i)) & ":"
    Next
    
    cmboPORT.ListIndex = 0
    cmboBAUD.ListIndex = 4
    cmboPARITY.ListIndex = 0
    cmboDATABIT.ListIndex = 1
    cmboSTOPBIT.ListIndex = 0
    
    optDATA(0).Value = True
    
    xHeight = Me.Height
    xWidth = Me.Width
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim msg As Long     '//The callback value
    
    '//The value of X will vary depending
    '//upon the ScaleMode setting.  Here
    '//we are using that fact to determine
    '//what the value of 'msg' should really be
    If (Me.ScaleMode = vbPixels) Then
        msg = X
    Else
        msg = X / Screen.TwipsPerPixelX
    End If

    Select Case msg
        Case WM_LBUTTONDBLCLK    '515 restore form window
            Me.WindowState = vbNormal
            Call SetForegroundWindow(Me.hwnd)
            Me.Show
            On Error Resume Next
            comONLINE.PortOpen = False
            On Error GoTo 0
        
        Case WM_RBUTTONUP        '517 display popup menu
            Call SetForegroundWindow(Me.hwnd)
            Me.PopupMenu Me.mnuSystray
        
        Case WM_LBUTTONUP        '514 restore form window
        '//commonly an application on the
        '//systray will do nothing on a
        '//single mouse_click, so nothing
    End Select
End Sub

Private Sub Form_Resize()
    If (Me.WindowState = vbMinimized) Then
        Me.Hide
    Else
        On Error Resume Next
        Me.Height = xHeight
        Me.Width = xWidth
        On Error GoTo 0
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
   Shell_NotifyIcon NIM_DELETE, nid
   Set frmSerialToKeyboard = Nothing
End Sub

Private Sub mnuExit_Click()
    cmdEXIT_Click
End Sub

Private Sub mnuRestore_Click()
    Me.WindowState = vbNormal
    Call SetForegroundWindow(Me.hwnd)
    Me.Show
    On Error Resume Next
    comONLINE.PortOpen = False
    On Error GoTo 0
End Sub

Private Sub optDATA_Click(Index As Integer)
    Dim i As Integer
    
    txtLEFT.Enabled = False
    txtRIGHT.Enabled = False
    
    For i = 0 To 2
        If i = Index Then
            optDATA(i).FontBold = True
        Else
            optDATA(i).FontBold = False
        End If
    Next
    
    If Index = 0 Then cmdActivate.Enabled = True

    If Index = 1 Then
        txtLEFT.Enabled = True
        If Len(Trim$(txtLEFT)) = 0 Then
            cmdActivate.Enabled = False
        Else
            cmdActivate.Enabled = True
        End If
    End If

    If Index = 2 Then
        txtRIGHT.Enabled = True
        If Len(Trim$(txtRIGHT)) = 0 Then
            cmdActivate.Enabled = False
        Else
            cmdActivate.Enabled = True
        End If
    End If

    EnableActivate
End Sub

Private Sub txtLEFT_Change()
    EnableActivate
End Sub

Private Sub txtPREFIX_Change()
    EnableActivate
End Sub

Private Sub txtRIGHT_Change()
    EnableActivate
End Sub