irread.frm

一款基于VB的红外遥控系统

         Left            =   4080
         TabIndex        =   8
         Top             =   2280
         Width           =   1695
      End
   End
   Begin MSCommLib.MSComm MSComm1 
      Left            =   7320
      Top             =   4200
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      CommPort        =   2
      DTREnable       =   0   'False
      Handshaking     =   3
      ParityReplace   =   48
      BaudRate        =   19200
      InputMode       =   1
   End
End
Attribute VB_Name = "IRread"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public linediagram As New Cls_diagram
Public Comm_Port As Integer
Private signal(1 To 1024) As Single
Private Grid As Integer

Private Sub Comm_Click()

frmOptions.Show

End Sub

'
Private Sub Form_Load()

    Dim hSysMenu As Long

    If App.PrevInstance = True Then

        Unload Me
        
    End If
    
    cmdClear_Click
    'Set up the Comm port
    Comm_settings

End Sub
'Close Comport when exiting the program
Private Sub Form_Unload(Cancel As Integer)

    If MSComm1.PortOpen = True Then MSComm1.PortOpen = False

End Sub
'Clear the Send_box and the Receive_box text boxes
Private Sub cmdClear_Click()

Dim l, g As Integer

    Grid = RGB(0, Slider1.value * 25, 0)
    Timer2.Enabled = True
    Code_box.Text = ""
    receive_box.Text = ""
    Text1.Text = ""
    Text2.Text = ""
    signal_out_box.Text = ""
    
    For g = 1 To 1024
    
        signal(g) = 0
        
    Next
    
    'Signal Header
    Signal_box.Text = "00000000011111111000000100"
    
    MSComm1.InBufferCount = 0
    MSComm1.OutBufferCount = 0
    
    With linediagram
        .InitDiagram Picture_line, RGB(Slider2.value * 25, 0, 0), True, Grid
        .Max = 10
        .HorzSplits = 10
        .VertSplits = 75
        .DiagramType = TYPE_LINE
        For g = 1 To Picture_line.ScaleWidth  '512 'Len(receive_box.Text)
            
            linediagram.AddValue signal(g) + 2
        Next
        .RePaint
    End With
    
End Sub
'Print serial data received to Receive_box
Private Sub MSComm1_OnComm()

Dim X, g, bum As Integer
Dim value As String


  Select Case MSComm1.CommEvent
  
    Case comEventRxOver
      MsgBox ("Receive buffer overflow")
      
    Case comEventTxFull
      MsgBox ("Send buffer overflow")
          
    Case comEvReceive
            X = Asc(MSComm1.Input)
        receive_box = receive_box + Hex(X)

    Case comEvCD
    
End Select

End Sub
Private Sub cmdExit_Click()

    Unload Me
    
End Sub
Private Function HexToBinStr(ByVal inHex As String) As String

    Dim mDec As Integer
    Dim s As String
    Dim i
    
    mDec = CInt("&h" & inHex)
    s = Trim(CStr(mDec Mod 2))
    i = mDec \ 2
    
    Do While i <> 0
        s = Trim(CStr(i Mod 2)) & s
        i = i \ 2
    Loop
    
    Do While Len(s) < 4 ' 8
        s = "0" & s
    Loop
    
    HexToBinStr = s
    Exit Function
    
End Function
Private Function bin_to_Hex(ByVal inBin As String) As String

Dim n, size, hex_byte, Filter_byte As Integer
Dim bin, ones, twos, fours, eights, temp, Trans_out As String

        temp = Text1 ' receive_box
        size = Len(temp)
        
        For n = 1 To size Step 4
        
            bin = Mid$(temp, n, 4)
            ones = Val(Mid$(bin, 4, 1))
            twos = Val(Mid$(bin, 3, 1))
            fours = Val(Mid$(bin, 2, 1))
            eights = Val(Mid$(bin, 1, 1))

        
            hex_byte = ones + (2 * twos) + (4 * fours) + _
                       (8 * eights)
            Filter_byte = hex_byte 'And &H5
            'Code_box.Text = Code_box.Text & Hex(Filter_byte)
            Text2.Text = Text2.Text + Hex(Filter_byte)
        Next n
        
        'Trans_out = Code_box.Text
        Trans_out = Text2.Text
        
End Function
'Signal and Button formatting
Private Sub Code_thing()

Dim temp, value, value2 As String
Dim size, g, t, h, ty, bob As Integer

    temp = receive_box
    size = Len(temp)
    
    'filter signal
    For g = 1 To size
    
            value = Mid$(temp, g, 1)
                If value = "F" Or value = "E" Or value = "D" Or value = "C" Then value = "1"
                If value = "8" Then value = "0"
            Code_box = Code_box + value
    Next
    
    'decode signal
    For t = 1 To size
        value = Mid$(Code_box, t, 2)
            If value = "00" Then value = "1"
            If value = "10" Then value = "0"
            If value = "01" Then value = ""
        Text1 = Text1 + value
    Next
        
    'Draw the signal
    For t = 1 To Len(Text1.Text)
        value = Mid$(Text1.Text, t, 1)
        
            If value = "1" Then value2 = "010"
            If value = "0" Then value2 = "10"

        Signal_box.Text = Signal_box.Text + value2
        
    Next
           
    For ty = 1 To Len(Signal_box.Text)

        For h = 1 To 5
 
            signal_out_box.Text = signal_out_box.Text & Mid$(Signal_box.Text, ty, 1)
            
        Next
            
    Next
                     
    For g = 1 To Picture_line.ScaleWidth  '512 'Len(receive_box.Text)
    
            bob = bob + 1
   
            value = Mid$(signal_out_box.Text, bob, 1)
            
                If value = "" Then value = 0
                If value = 1 Then value = value + 5
            
            linediagram.AddValue value + 2
            signal(g) = value

    Next
    bob = 0
    linediagram.RePaint
    
    'Convert Binary code to Hex
    bin_to_Hex (Text1)

End Sub
'Com port setup
Private Sub Comm_settings()

On Error Resume Next

    MSComm1.Settings = ("14400" + "," + "n" + "," + "8" + "," + "1")
    MSComm1.InputLen = 1
    MSComm1.PortOpen = True
    MSComm1.InputMode = comInputModeText
    MSComm1.RThreshold = 1

End Sub
'Grid Contrast control
Private Sub Slider1_Scroll()
Dim g As Integer
Grid = RGB(0, Int(Slider1.value * 25.5), 0)

With linediagram
        .InitDiagram Picture_line, RGB(Int(Slider2.value * 25.5), 0, 0), True, Grid
        
        For g = 1 To Picture_line.ScaleWidth  '512 'Len(receive_box.Text)
            
            linediagram.AddValue signal(g) + 2
        Next
        
        .RePaint
End With

End Sub
'Signal Contrast control
Private Sub Slider2_Scroll()
Dim g As Integer
Grid = RGB(0, Int(Slider1.value * 25.5), 0)

With linediagram

        .InitDiagram Picture_line, RGB(Int(Slider2.value * 25.5), 0, 0), True, Grid
        .Max = 10
        .HorzSplits = 10
        .VertSplits = 75
        .DiagramType = TYPE_LINE
        
        For g = 1 To Picture_line.ScaleWidth
            
            linediagram.AddValue signal(g) + 2
            
        Next
        .RePaint
        
End With

End Sub
Private Sub Timer2_Timer()

If Len(receive_box.Text) = 54 Then

    Code_thing
    Timer2.Enabled = False
    Exit Sub
    
End If

    Code_box.Text = ""
    receive_box.Text = ""
    Text1.Text = ""
    Label1.Caption = ""
    MSComm1.InBufferCount = 0
    MSComm1.OutBufferCount = 0

End Sub