form1.frm

三菱FX与PC通讯程序源码以及与OMRON通迅的原程序和源码,等

VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   3195
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3195
   ScaleWidth      =   4680
   StartUpPosition =   3  'Windows Default
   Begin VB.TextBox Text1 
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   375
      Index           =   1
      Left            =   2160
      TabIndex        =   1
      Text            =   "Text1"
      Top             =   480
      Width           =   1095
   End
   Begin VB.TextBox Text1 
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000000FF&
      Height          =   375
      Index           =   0
      Left            =   480
      TabIndex        =   0
      Text            =   "Text1"
      Top             =   480
      Width           =   1095
   End
   Begin VB.Timer Timer1 
      Interval        =   1000
      Left            =   4800
      Top             =   2040
   End
   Begin MSCommLib.MSComm MSComm1 
      Left            =   5760
      Top             =   1800
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      DTREnable       =   -1  'True
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Form_Load()         '初始化
  Call INIT_comm
End Sub

Private Sub Timer1_Timer()              '定时数据读写
 Dim L, m, J, I, K As Integer
 Dim temp As Long
 Dim n As String
   L = 0
  Call read_db("00", "rd", "0100", 20, value1()) '读取DM0100－DM0119中数据
       
  For L = 0 To 1
     Text1(L).Text = value1(L)  '显示读取的数值
  Next
  
  '向DM0100－DM0119写数据
  For J = 0 To 19
    If an_set(J) = True Then
      value4(J) = 100 + J
      value5(J) = Val(set_v(J))   '(set_v(J))为程序中设置值的变量
      Call Write_db("00", "wd", value4(J), 1, value5())
      an_set(J) = False
    End If
  Next
  
  '读取IR016－IR019中数据
  Call read_db("00", "rr", "0016", 4, value3())
  I = 0
  J = 0
  For I = 0 To 3
    For J = 0 To 15
      temp = value3(I) And 2 ^ J
      If temp > 0 Then
        DIGIT_IN(I, J) = True  '程序中其它部份
      Else
        DIGIT_IN(I, J) = False '程序中其它部份
      End If
    Next
  Next
End Sub

Public Function read_db(ByVal pntNumber As String, _
  ByVal Order As String, ByVal startAddress As String, _
  ByVal Lengh As Integer, ByRef value() As Single)
  Dim outstring As String
  MSComm1.InBufferCount = 0 'clear off  inbuffer
  Order = UCase(Order)      '命令大写
  keyorder = startAddress   '首地址
  If Lengh > 20 Then
   Lengh = 20
  End If
    outstring = "@" + pntNumber + Order + keyorder + "00" + Trim(Str(Lengh))
    fcdd$ = XORR(outstring)
    outstring = outstring + fcdd$ + "*" + Chr$(13)
    MSComm1.Output = outstring
    Time_out = Timer
    
   '判断通讯错误
    Do
      If Timer > (Time_out + 1) Then
        ERROR_COM = True
      Else
        ERROR_COM = False
      End If
        DoEvents
    Loop Until ((MSComm1.InBufferCount >= 11 + 4 * Lengh) Or (ERROR_COM = True))
    Instring = MSComm1.Input
    order1 = Mid(Instring, 6, 2)  '结束码
    Call ErrMessage(order1)
    For I = 0 To Lengh - 1
      zhancun = Mid(Instring, 8 + I * 4, 4)  '取出数据位
      value(I) = Revert(zhancun)
      
    Next
End Function

Public Function Write_db(ByVal pntNumber As String, _
    ByVal Order As String, ByVal startAddress As String, _
    ByVal Lengh As Integer, ByRef value() As Single)
    Dim value1(19) As String
 
    MSComm1.InBufferCount = 0
    If Lengh > 8 Then
     Lengh = 8
    End If
    Order = UCase(Order)
     outstring = "@" + pntNumber + Order + "0" + startAddress
     For J = 0 To 19
      If an_set(J) = True Then
        value1(J) = four_bit(value5(J))
        outstring = outstring + value1(J)
      End If
    Next
     fcdd$ = XORR(outstring)
     outstring = outstring + fcdd$ + "*" + Chr$(13)
     MSComm1.Output = outstring
     Time_out = Timer
     Do
       If Timer > (Time_out + 1) Then
         ERROR_COM = True
       Else
         ERROR_COM = False
       End If
       DoEvents
     Loop Until ((MSComm1.InBufferCount >= 11) Or (ERROR_COM = True))
      Instring = MSComm1.Input
      endcode = Mid(Instring, 6, 2)
      Call ErrMessage(endcode)
End Function

Public Sub INIT_comm()
  'Buffer to hold input string
  Dim Instring, outstring As String
    MSComm1.CommPort = 1   'Use COM1.
    MSComm1.Settings = "9600,e,7,2"  '9600 baud, e parity, 7 data, and 2 stop bit.
    MSComm1.InputLen = 0   'Tell the control to read entire buffer when Input
    MSComm1.PortOpen = True   'Open the port.
End Sub