全站仪通讯.frm

全站仪通讯vb源码

If length = "" Then RichTextBox1.SaveFile 文件保存.FileName, rtfText







If length <> "" Then msg = MsgBox("文件名相同，覆盖文件吗？", vbYesNo)

       If msg = 6 Then
       RichTextBox1.SaveFile 文件保存.FileName, rtfText
       文件保存.FileName = ""
       End If
End Sub

Private Sub Command5_Click()
   Dim Counter As Double
   Dim ks As String
   Dim js As Long
MSComm1.InputMode = comInputModeBinary

MSComm1.InputLen = 1
MSComm1.RThreshold = 0
MSComm1.SThreshold = 1







 '在整个数组中循环。

  If RichTextBox1.Text = "" Then
  
  js = MsgBox("数据文件未打开?")
  
  Exit Sub
  End If
   
   If MSComm1.PortOpen = False Then MSComm1.PortOpen = True
   Text1.Text = "正在上传数据..."
 
 
End Sub
Private Sub Command6_Click()
文件保存.DialogTitle = "打开文件"
文件保存.Action = 1
If 文件保存.FileName = "" Then Exit Sub
RichTextBox1.LoadFile 文件保存.FileName, rtfText
filenum = FreeFile
 
Open 文件保存.FileName For Append As #filenum

length = 10000
ReDim fs(length)
ReDim js(length)


i = 1
Do While Not EOF(1)   ' 循环至文件尾。
  fs(i) = Input(1, #filenum)   ' 读入一个字符。

   Debug.Print fs(i)  ' 显示到立即窗口。
  i = i + 1
Loop

Close #filenum
文件保存.FileName = ""


End Sub

Private Sub Command7_Click()
If unsave = 1 Then
msg = MsgBox("正文改动，保存吗?", vbOKCancel)
     If msg = vbOK Then
                       文件保存.DialogTitle = "文件保存"
                        文件保存.Action = 2

                       If 文件保存.FileName = "" Then Exit Sub
                       length = Dir(文件保存.FileName)

                       If length = "" Then
                       RichTextBox1.SaveFile 文件保存.FileName, rtfText
                       unsave = 0
                        RichTextBox1.Text = ""
                       End If




                      If length <> "" Then msg = MsgBox("文件名相同，覆盖文件吗？", vbYesNo)

       If msg = vbYes Then
       RichTextBox1.SaveFile 文件保存.FileName, rtfText
       文件保存.FileName = ""
        unsave = 0
        RichTextBox1.Text = ""
       End If
      If msg = vbNo Then
      文件保存.FileName = ""
      Exit Sub
      End If

     End If
End If
 If msg = vbCancel Then
 RichTextBox1.Text = ""
unsave = 0
End If

RichTextBox1.Text = ""
unsave = 0
End Sub




Private Sub Command8_Click()
 Dim x() As Long
 Dim y() As Long
 Dim z() As Long
 Dim i As Integer
 Dim jl As Integer
 Dim dh() As Integer
  i = 1
  j = 1

 

  
  
  
  
  
  
  
  
  
  
  
  
  For i = 1 To m
     Text1.Text = Text1.Text & js(i)
    

  Next i
  
  ReDim js(MSComm1.InBufferCount) As String



 
 ' Do While (i <= 1024)
  '
   '
    '       Do While (js(j) <> ",")
     '
      '
       '       dh(i) = dh(i) & js(j)
        '      j = j + 1
         '
          '    Loop
           '      j = j + 1
            '   zdh(i) = dh(i)
             '  dh(i) = ""
'           Do While (js(j) <> ",")
 '
  '
   '           x(i) = x(i) & js(j)
    '          j = j + 1
     '
      '     Loop
       '        zx(i) = x(i)
        '       x(i) = ""
         '
          '
           'j = j + 1
'            Do While (js(j) <> ",")
 '
  '
   '           y(i) = y(i) & js(j)
    '          j = j + 1
     '
      '     Loop
       '     zy(i) = y(i)
        '       y(i) = ""
         '
          ' j = j + 1
           
'            Do While (js(j) <> "," Or js(j) <> Chr(13) Or js(j) <> Chr(10))
 '
  '
   '           z(i) = z(i) & js(j)
    '          j = j + 1
     '      Loop
      '
       '     zz(i) = z(i)
        '       z(i) = ""
         '  m = i
           
        '   If js(j) = vbCr Then j = j + 1
         '  If js(j) = vbLf Then j = j + 1
          ' If j > num Then Exit Sub
           
  '   i = i + 1
    
          
 
'  Text1.Text = "点数为：" & m & zx(m) & zy(m) & zz(m)
 


' Loop










End Sub

Private Sub copy_Click()
Clipboard.Clear
   Clipboard.SetText RichTextBox1.SelText


End Sub

Private Sub cut_Click()
Clipboard.Clear
   Clipboard.SetText RichTextBox1.SelText
   Text1.SelText = ""


End Sub

Private Sub Form_Load()
ProcBar1.Visible = False
Command2.Enabled = False
Command3.Enabled = False
command5.Enabled = False
End Sub


Private Sub MSComm1_OnComm()
    
   ck = Combo1.Text
 
  If ck = com1 Then
              c = 1
              MSComm1.CommPort = 1
              End If
       If ck = com2 Then
                       c = 2
                       MSComm1.CommPort = 2
       End If
           If ck = com3 Then
                                 c = 3
                                 MSComm1.CommPort = 3
           End If
               If ck = com4 Then
                                         c = 4
                                         MSComm1.CommPort = 4
                End If
      
      
   Select Case MSComm1.CommEvent
  
   Case comEvReceive
                
               
               ReDim jsdata(MSComm1.InBufferCount) As Byte
               ReDim js(MSComm1.InBufferCount) As String
               num = MSComm1.InBufferCount
              Debug.Print num
               For m = 1 To MSComm1.InBufferCount
              
               jsdata(m) = AscB(MSComm1.Input)
            
               js(m) = Chr(jsdata(m))
               
               
               
               
               
               If js(m) = vbCr Then
                     js(m) = ""
                    
                       
                     
                    RichTextBox1.Text = RichTextBox1.Text & js(m) & Chr(13)
                    
                 ElseIf js(m) = vbLf Then
                       js(m) = ""
    
                       
    
                   ElseIf js(m) = Chr(26) Then
                    js(m) = ""
                    Exit Sub
                Else: RichTextBox1.Text = RichTextBox1.Text & js(m)
              
              End If
            
            
            If m = 1024 Then m = 1
              Next m
             
           
 Case comEvSend
                
                    If RichTextBox1.Text = "" Then MsgBox "未打开文件，无数可上传"
    
                  '设置进度的值为 Min。
  ' RichTextBox1.
  
   ProcBar1.Value = ProcBar1.Min
   ProcBar1.Visible = True
   Dim h As Double
   Dim i As Double
   Dim j As Double
  
  
   Dim time As Single
   num = Len(RichTextBox1.Text)
     
  
MSComm1.Output = "1,20000.0000,200000.0000,50.000,chr(13),chr(10),2,20002.0000,200006.0000,56,"

    
   For Counter = 1 To num
  
       j = num / 100
       h = Counter / j
       c = Int(h)
       
               
            ProcBar1.Value = c
            MSComm1.Output = "1,20000.0000,200000.0000,50.000,chr(13),chr(10),2,20002.0000,200006.0000,56,"
     Next Counter
   
   ProcBar1.Value = ProcBar1.Min
   ProcBar1.Visible = False
   
   
   If MSComm1.EOFEnable = True Then
   Exit Sub
  End If
   
   
   
  




                
                
                
                
                
             
    
    
              
    
  
    
 
  
         ' 错误
        ' Case comEventBreak ' 收到 Break。
        ' Case comEventCDTO ' CD (RLSD) 超时。
        ' Case comEventCTSTO ' CTS Timeout。
        ' Case comEventDSRTO ' DSR Timeout。
         'Case comEventFrame ' Framing Error
         Case comEventOverrun
                      msg = MsgBox("数据丢失") '数据丢失。
                      Exit Sub
         Case comEventRxOver '接收缓冲区溢出。
                      msg = MsgBox("接收缓冲区溢出")
        ' Case comEventRxParity ' Parity 错误。
         Case comEventTxFull '传输缓冲区已满。
                      msg = MsgBox("传输缓冲区已满")
                      Exit Sub
         Case comEventDCB '获取 DCB] 时意外错误

          ' 事件
         Case comEvCD ' CD 线状态变化。
         Case comEvCTS ' CTS 线状态变化。
         Case comEvDSR ' DSR 线状态变化。
         Case comEvRing ' Ring Indicator 变化。
         Case comEvReceive ' 收到 RThreshold # of chars.
         Case comEvSend ' 传输缓冲区有 Sthreshold 个字符 '
         
         Case comEvEOF ' 输入数据流中发现 EOF 字符
          Text1.Text = " 输入数据流中发现 EOF结束字符"
          Exit Sub
     

         Case 380    ' 无效属性值 comInvalidPropertyValue
         Case 383              '属性为只读 comSetNotSupported
         Case 394     '属性为只读 comGetNotSupported
         Case 8000 '端口打开时操作不合法 comPortOpen
         Case 8001 '超时值必须大于 0
         Case 8002 '无效端口号 comPortInvalid
                Text1.Text = " 无效端口号 comPortInvalid"
                Exit Sub


        Case 8003 ' 属性只在运行时有效
        Case 8004 '属性在运行时为只读
        Case 8005 '端口已经打开 comPortAlreadyOpen

           Text1.Text = " 端口已经打开 comPortAlreadyOpen"

          Exit Sub




       Case 8006 '设备标识符无效或不支持该标识符



       Case 8007 '不支持设备的波特率
       Case 8008 '指定的字节大小无效
       Case 8009 '缺省参数错误
       Case 8010 '硬件不可用 (被其它设备锁定)
       Case 8011 '函数不能分配队列
       Case 8012 '设备没有打开 comNoOpen
             Text1.Text = " 端口已经打开 comPortAlreadyOpen"

            Exit Sub



       Case 8013 ' 设备已经打开
       Case 8014 '不能使用 comm 通知
       Case 8015 '不能设置 comm 状态 comSetCommStateFailed
       Case 8016 '不能设置 comm 事件屏蔽
       Case 8018 '仅当端口打开时操作才有效 comPortNotOpen
       Case 8019 '设备忙
       Case 8020 '读 comm 设备错误 comReadError
       Case 8021 '为该端口检索设备控制块时的内部错误 comDCBError

  End Select
    

End Sub



Private Sub paste_Click()
RichTextBox1.SelText = Clipboard.GetText()
 
End Sub

Private Sub RichTextBox1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
 If Button = 2 Then   '   检查是否单击了鼠标右键。
      PopupMenu edit   '   把文件菜单显示为一个弹出式菜单。
   End If

End Sub

Private Sub RichTextBox1_SelChange()
unsave = 1
End Sub