vb串口通信绘图保存图片dat格式文件

vb串口通信绘图保存图片dat格式文件 VERSION 5.00 Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX" Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX" Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX" Begin VB.Form Form1 AutoRedraw = -1 'True Caption = "综合测试" ClientHeight = 8145 ClientLeft = 165 ClientTop = 255 ClientWidth = 17685 Icon = "Form1.frx":0000 KeyPreview = -1 'True LinkTopic = "Form1" ScaleHeight = 8145 ScaleWidth = 17685 StartUpPosition = 1 '所有者中心 Begin VB.Frame Frame2 Height = 6735 Left = 11880 TabIndex = 7 Top = 120 Width = 2415 Begin VB.CommandButton Command7 BackColor = &H00FFC0C0& Caption = "保存图片" Height = 400 Left = 120 Style = 1 'Graphical TabIndex = 29 Top = 4560 Width = 1050 End Begin VB.CommandButton Command6 Appearance = 0 'Flat BackColor = &H00C0C0FF& Caption = "磁头0" Height = 400 Index = 0 Left = 1200 MaskColor = &H00C0C0FF& Style = 1 'Graphical TabIndex = 27 Top = 1200 Width = 1050 End Begin VB.CommandButton Command6 Appearance = 0 'Flat BackColor = &H00C0C0FF& Caption = "磁头1" = 400 Height Index = 1 Left = 1200 MaskColor = &H00C0C0FF& Style = 1 'Graphical TabIndex = 26 Top = 1680 Width = 1050 End Begin VB.CommandButton Command6 Appearance = 0 'Flat BackColor = &H00C0FFC0& Caption = "磁头2" Height = 400 Index = 2 Left = 1200 MaskColor = &H00C0C0FF& Style = 1 'Graphical TabIndex = 25 Top = 2160 Width = 1050 End Begin VB.CommandButton Command6 Appearance = 0 'Flat BackColor = &H00C0FFFF& Caption = "磁头3" Height = 400 Index = 3 Left = 1200 MaskColor = &H00C0C0FF& Style = 1 'Graphical TabIndex = 24 Top = 2640 Width = 1050 End Begin VB.CommandButton Command6 Appearance = 0 'Flat BackColor = &H008080FF& Caption = "磁头4" Height = 400 Index = 4 Left = 1200 MaskColor = &H00C0C0FF& Style = 1 'Graphical TabIndex = 23 Top = 3120 Width = 1050 End Begin VB.CommandButton Command6 Appearance = 0 'Flat BackColor = &H008080FF& Caption = "磁头5" Height = 400 Index = 5 Left = 1200 MaskColor = &H00C0C0FF& Style = 1 'Graphical TabIndex = 22 Top = 3600 Width = 1050 End Begin VB.CommandButton Command6 Appearance = 0 'Flat BackColor = &H00C0FFFF& Caption = "磁头6" Height = 400 Index = 6 Left = 1200 MaskColor = &H00C0C0FF& Style = 1 'Graphical TabIndex = 21 Top = 4080 Width = 1050 End Begin VB.CommandButton Command6 Appearance = 0 'Flat BackColor = &H00C0FFC0& Caption = "磁头7" Height = 400 Index = 7 Left = 1200 MaskColor = &H00C0C0FF& Style = 1 'Graphical TabIndex = 20 Top = 4560 Width = 1050 End Begin VB.CommandButton Command6 Appearance = 0 'Flat BackColor = &H00C0C0FF& Caption = "磁头8" Height = 400 Index = 8 Left = 1200 MaskColor = &H00C0C0FF& Style = 1 'Graphical TabIndex = 19 Top = 5040 Width = 1050 End Begin VB.CommandButton Command6 Appearance = 0 'Flat BackColor = &H00C0C0FF& Caption = "磁头9" Height = 400 Index = 9 Left = 1200 MaskColor = &H00C0C0FF& Style = 1 'Graphical TabIndex = 18 Top = 5520 Width = 1050 End Begin VB.CommandButton Command6 Appearance = 0 'Flat BackColor = &H00FF8080& Caption = "磁头10" Height = 400 Index = 10 Left = 120 MaskColor = &H00C0C0FF& Style = 1 'Graphical TabIndex = 17 Top = 4080 Width = 1050 End Begin VB.CommandButton Command5 BackColor = &H00FFFFC0& Caption = "装载文件" Height = 400 Left = 120 Style = 1 'Graphical TabIndex = 16 Top = 5520 Width = 1050 End Begin VB.CommandButton Command4 BackColor = &H00FFFFC0& Caption = "保存文件" Height = 400 Left = 120 Style = 1 'Graphical TabIndex = 15 Top = 5040 Width = 1050 End Begin VB.CommandButton Command1 BackColor = &H00FFC0C0& Caption = "数据处理" Height = 400 Left = 120 Style = 1 'Graphical TabIndex = 14 Top = 3600 Width = 1050 End Begin VB.CommandButton Command3 BackColor = &H0000FF00& Caption = "联机" Height = 400 Left = 120 Style = 1 'Graphical TabIndex = 13 Top = 2640 Width = 1050 End Begin VB.CommandButton Command2 BackColor = &H00C0C0C0& Caption = "清空数据" Height = 400 Left = 120 Style = 1 'Graphical TabIndex = 12 Top = 3120 Width = 1050 End Begin VB.CommandButton ComOpen BackColor = &H00C0C0FF& Caption = "关闭串口" Height = 400 Left = 120 Style = 1 'Graphical TabIndex = 11 Top = 2160 Width = 1050 End Begin VB.ComboBox Combo6 Enabled = 0 'False BeginProperty Font Name = "Arial" Size = 9 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 345 ItemData = "Form1.frx":4B85A Left = 120 List = "Form1.frx":4B85C Style = 2 'Dropdown List TabIndex = 10 Top = 720 Width = 2130 End Begin VB.ComboBox Combo2 BeginProperty Font Name = "Arial" Size = 9 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 345 ItemData = "Form1.frx":4B85E Left = 120 List = "Form1.frx":4B860 TabIndex = 9 Text = "9600" Top = 1680 Width = 1050 End Begin VB.ComboBox Combo1 BackColor = &H80000000& BeginProperty Font Name = "Arial" Size = 9 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 345 Left = 120 TabIndex = 8 Text = "COM1" Top = 1200 Width = 1050 End Begin VB.Label Label2 = 2 'Center Alignment BackColor = &H80000012& Caption = "200,255" BeginProperty Font Name = "宋体" Size = 15.75 Charset = 134 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H0000FF00& Height = 420 Left = 120 TabIndex = 28 Top = 240 Width = 2130 End End Begin VB.Timer Timer1 Interval = 1 Left = 6840 Top = 3600 End Begin MSComDlg.CommonDialog CommonDialog1 Left = 9240 Top = 7320 _ExtentX = 847 _ExtentY = 847 _Version = 393216 CancelError = -1 'True Filter = "*.txt|*.txt" End Begin MSComctlLib.StatusBar StatusBar1 Align = 2 'Align Bottom Height = 285 Left = 0 TabIndex = 1 Top = 7860 Width = 17685 _ExtentX = 31194 _ExtentY = 503 _Version = 393216 BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} NumPanels = 6 BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} Alignment = 1 Bevel = 2 Object.Width = 1499 MinWidth = 1499 Text = "综合测试" TextSave = "综合测试" EndProperty BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628} Alignment = 1 Bevel = 0 Object.Width = 1058 MinWidth = 1058 Text = "张数:" TextSave = "张数:" EndProperty BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628} Alignment = 1 Object.Width = 1058 MinWidth = 1058 Text = "0" TextSave = "0" EndProperty BeginProperty Panel4 {8E3867AB-8586-11D1-B16A-00C0F0283628} Alignment = 1 Bevel = 0 Object.Width = 1058 MinWidth = 1058 Text = "信息:" TextSave = "信息:" EndProperty BeginProperty Panel5 {8E3867AB-8586-11D1-B16A-00C0F0283628} AutoSize = 1 Object.Width = 23918 EndProperty BeginProperty Panel6 {8E3867AB-8586-11D1-B16A-00C0F0283628} Alignment = 1 Object.Width = 1940 MinWidth = 1940 EndProperty EndProperty BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "宋体" Size = 9 Charset = 134 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty End Begin MSCommLib.MSComm MSComm1 Left = 12120 Top = 2040 _ExtentX = 1005 _ExtentY = 1005 _Version = 393216 DTREnable = -1 'True RThreshold = 1 SThreshold = 1 InputMode = 1 End Begin VB.Frame Frame3 Height = 6735 Left = 120 TabIndex = 0 Top = 120 Width = 11625 Begin VB.PictureBox Picture1 AutoRedraw = -1 'True BackColor = &H00000000& BorderStyle = 0 'None BeginProperty Font Name = "宋体" Size = 14.25 Charset = 134 Weight = 400 Underline = 0 'False = 0 'False Italic Strikethrough = 0 'False EndProperty ForeColor = &H0000FF00& Height = 4575 Left = 840 ScaleHeight = 4575 ScaleWidth = 11415 TabIndex = 5 Top = 120 Visible = 0 'False Width = 11415 End Begin VB.ListBox List1 BeginProperty Font Name = "Courier" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 4155 Left = 120 TabIndex = 3 Top = 600 Width = 11235 End Begin VB.TextBox Text1 BeginProperty Font Name = "Courier" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 1995 Left = 120 MultiLine = -1 'True TabIndex = 2 Top = 4560 Width = 11235 End Begin VB.TextBox Text2 BackColor = &H00C0C0FF& BorderStyle = 0 'None BeginProperty Font Name = "新宋体" Size = 9 Charset = 134 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 285 Left = 120 MultiLine = -1 'True TabIndex = 6 Top = 240 Width = 11115 End End Begin VB.Label Label1 Caption = $"Form1.frx":4B862 Height = 4575 Left = 14760 TabIndex = 4 Top = 1080 Visible = 0 'False Width = 1695 End Begin VB.Menu MenuList Caption = "MenuList" Visible = 0 'False Begin VB.Menu MenuDel Caption = "Delete Selected" End End End Attribute VB_Name = "Form1" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Dim LastCombo1Text As String Dim DataOrder As Integer Dim i As Integer Dim DataStr(100) As String Dim StrConn(100) As String Dim StrConn2(100) As String Dim datajm(100, 3) As Byte Dim Iniflag As Boolean Dim strName(100) As String Public OrderType As Integer As String Dim strBuff Dim ListData() As Byte Dim state As Integer Dim ListIndex As Integer Dim Datalen As Integer Dim NotePiece As Integer Dim TimeDelay As Integer Dim Apppath As String Dim NumRec As Integer Dim ValD(60, 3) Dim MTdata(255) As Byte Dim DrawWaveFlag As Boolean Dim TotalSample As Byte Dim AvgMg As Byte Dim MinMg As Byte Dim MaxMg As Byte Dim Mgbuffer(252) As Byte Dim Mgx As Integer Dim Slant As Integer Dim ViewFlag As Boolean Dim WaveTop As Integer Dim WaveButtom As Integer Dim WaveTopMT As Integer Dim WaveButtomMT As Integer Private Sub Combo6_Click() OrderType = Me.Combo6.ListIndex Me.Text2 = DataStr(OrderType) End Sub Private Sub Command1_Click() Call DataProce End Sub Private Sub Command2_Click() Me.List1.Clear MsgStr "Clear all data" MsgNum "" NumRX = 0 state = 0 End Sub Sub Command_conn(N As Integer) Dim Temp() As Byte Dim strBuff As String Dim s Dim strcom As String ' On Error GoTo Err If Me.MSComm1.PortOpen = False Then Call ComOpen_Click 'SetCom If ViewFlag = False Then strcom = StrConn(N) Else strcom = StrConn2(N) End If If strcom = "" Then Exit Sub s = Split(strcom) DataOrder = "&H" & s(2) ReDim Temp(UBound(s)) For i = 0 To UBound(s) Temp(i) = "&H" & s(i) Next i MSComm1.Output = Temp MsgStr "联机命令:" & strcom Exit Sub Err: MsgBox Err.Description End Sub Private Sub Command3_Click() ViewFlag = False Me.Picture1.Visible = ViewFlag Command_conn OrderType End Sub Private Sub Command4_Click() On Error GoTo Err Dim str1 As String Dim strfilename As String On Error GoTo Err If ViewFlag = False Then Me.CommonDialog1.Filter = "*.txt|*.txt" Me.CommonDialog1.ShowSave strfilename = Me.CommonDialog1.FileName If strfilename = "" Then Exit Sub Open strfilename For Output As #1 Print #1, "CommData:" & OrderType & "-" & Me.Combo6.List(OrderType) Print #1, "Title:" & Me.Text2.Text Print #1, "Piece:" & Me.List1.ListCount Print #1, "" For i = 0 To Me.List1.ListCount - 1 Print #1, Me.List1.List(i) Next i MsgStr "保存成功!" Close #1 Else Me.CommonDialog1.Filter = "*.WMG|*.WMG" Me.CommonDialog1.ShowSave strfilename = Me.CommonDialog1.FileName If strfilename = "" Then Exit Sub Open strfilename For Binary As #1 Put #1, 1, TotalSample Put #1, 2, Mgx Put #1, 3, AvgMg Put #1, 4, Slant Put #1, 5, Mgbuffer MsgStr "保存成功!" Close #1 End If Exit Sub Err: If Err.Number <> 32755 Then MsgBox Err.Description End Sub Private Sub Command5_click() On Error GoTo Err Dim str1 As String Dim BB As Integer Dim NextL As Boolean Dim BZ As Boolean Dim strfilename As String On Error GoTo Err If ViewFlag = False Then Me.CommonDialog1.Filter = "*.txt|*.txt" Me.CommonDialog1.ShowOpen strfilename = Me.CommonDialog1.FileName Open strfilename For Input As #1 NumRX = 0 Do While (Not EOF(1)) Line Input #1, str1 If str1 = "" Then BB = BB + 1 End If If BB = 1 And str1 <> "" Then List1.AddItem str1 NumRX = NumRX + 1 ElseIf BB = 0 Then If Left(str1, 5) = "Title" Then Me.Text2 = Replace(str1, "Title:", "") End If If Left(str1, 9) = "CommData:" Then OrderType = Val(Mid(str1, 10, 1)) Me.Combo6.ListIndex = OrderType End If End If Loop MsgNum Me.List1.ListCount MsgStr "装载文件" Close #1 Else Me.CommonDialog1.Filter = "*.WMG|*.WMG" Me.CommonDialog1.ShowOpen strfilename = Me.CommonDialog1.FileName ReDim ListData(255) Open strfilename For Binary As #1 Get #1, , ListData Close #1 If ListData(254) = Asc("M") And ListData(255) = Asc("G") Then Call DrawWave Else MsgBox "文件格式错误～", vbCritical End If End If Exit Sub Err: If Err.Number <> 32755 Then MsgBox Err.Description End Sub Function InData(str1, num0) Dim i For i = 0 To 9 DataRun(num0, i) = Val(Trim(Mid(str1, i * 4 + 1, 4))) Next i End Function Private Sub Command6_Click(Index As Integer) ViewFlag = True Command_conn Index End Sub Private Sub Command7_Click() Dim str1 On Error GoTo Err Me.CommonDialog1.Filter = "*.bmp|*.bmp" Me.CommonDialog1.ShowSave str1 = Me.CommonDialog1.FileName If str1 <> "" Then SavePicture Me.Picture1.Image, str1 MsgStr "Save Picture:" & str1 End If Exit Sub Err: End Sub Private Sub ComOpen_Click() On Error GoTo Err Call SetCom MSComm1.InputMode = comInputModeBinary MSComm1.InputLen = 0 If ComOpen.Caption = "关闭串口" Then MSComm1.PortOpen = False ComOpen.Caption = "打开串口" Else SetCom If MSComm1.PortOpen = True Then Me.MSComm1.PortOpen = False MSComm1.InputMode = comInputModeBinary MSComm1.CommPort = Val(Replace(Me.Combo1, "COM", "")) MSComm1.PortOpen = True ComOpen.Caption = "关闭串口" Call SaveIni End If If MSComm1.PortOpen = True Then LedOn Else LedOff End If MsgStr "串口已打开!" Exit Sub Err: MsgBox Err.Description, vbInformation End Sub Sub WriteDefaultIni() Open Apppath For Output As #1 Print #1, Me.Label1.Caption Close #1 End Sub Sub SaveIni() WriteToIni Apppath, "port", "cur", Me.Combo1.ListIndex WriteToIni Apppath, "baud", "cur", Me.Combo2.ListIndex WriteToIni Apppath, "order", "cur", Me.Combo6.ListIndex End Sub Private Sub Form_Load() Dim tem Dim m Dim num As Integer Apppath = App.Path & "\Set.ini" MenuList.Visible = False Me.StatusBar1.Panels(6) = Year(Now) & "-" & Month(Now) & "-" & Day(Now) Loop1: tem = ReadFromIni(Apppath, "order", "num") m = Val(tem) If m = 0 Then If MsgBox("配置文件出错,是否恢复默认设置,", vbCritical + vbYesNo + vbDefaultButton1) = vbYes Then Call WriteDefaultIni GoTo Loop1 End If End If '装载初始化数据 m = Val(tem) For i = 0 To m - 1 strName(i) = ReadFromIni(Apppath, "Order", "name" & i) DataStr(i) = ReadFromIni(Apppath, "Order", "title" & i) StrConn(i) = ReadFromIni(Apppath, "Order", "cmd" & i) Me.Combo6.AddItem strName(i) Next i tem = ReadFromIni(Apppath, "Order", "cur") m = Val(tem) If (m > Me.Combo6.ListCount - 1) Then Me.Combo6.ListIndex = 0 Else Me.Combo6.ListIndex = m End If tem = ReadFromIni(Apppath, "MGwave", "num") m = Val(tem) For i = 0 To m - 1 StrConn2(i) = ReadFromIni(Apppath, "MGwave", "cmd" & i) Next i tem = ReadFromIni(Apppath, "baud", "num") m = Val(tem) For i = 0 To m - 1 tem = ReadFromIni(Apppath, "baud", "name" & i) Me.Combo2.AddItem tem Next i tem = ReadFromIni(Apppath, "baud", "cur") m = Val(tem) If (m > Me.Combo2.ListCount - 1) Then Me.Combo2.ListIndex = 0 Else Me.Combo2.ListIndex = m End If Call CommportRef tem = ReadFromIni(Apppath, "port", "cur") m = Val(tem) If (m > Me.Combo1.ListCount - 1) Then Me.Combo1.ListIndex = 0 Else Me.Combo1.ListIndex = m End If Iniflag = True tem = ReadFromIni(Apppath, "size", "width") m = Val(tem) If m > 2000 Then Me.Width = m tem = ReadFromIni(Apppath, "size", "height") m = Val(tem) If m > 2000 Then Me.Height = m tem = ReadFromIni(Apppath, "MGwave", "top") WaveTop = Val(tem) tem = ReadFromIni(Apppath, "MGwave", "Buttom") WaveButtom = Val(tem) tem = ReadFromIni(Apppath, "MGwave", "MTtop") WaveTopMT = Val(tem) tem = ReadFromIni(Apppath, "MGwave", "MTButtom") WaveButtomMT = Val(tem) tem = ReadFromIni(Apppath, "font", "title") Me.Text2.FontSize = Val(tem) tem = ReadFromIni(Apppath, "font", "list") Me.Text1.FontSize = Val(tem) Me.List1.FontSize = Val(tem) Me.Picture1.Scale (0, 180)-(200, 0) End Sub Sub CommportRef() Dim hkey3 As Long Dim lpsubkey3 As String On Error GoTo Err hkey3 = &H80000002 'HKEY_LOCAL_MACHINE lpsubkey3 = "HARDWARE\DEVICEMAP\SERIALCOMM" DaziEnumerateValue hkey3, lpsubkey3 Dim i As Integer Dim ss As String i = 0 Me.Combo1.Clear Do While (Datalist(i) <> "") ss = ReadRegKey(HKEY_LOCAL_MACHINE, "HARDWARE\DEVICEMAP\SERIALCOMM", Datalist(i)) Me.Combo1.AddItem ss i = i + 1 Loop If Me.Combo1.ListCount > 0 Then Me.Combo1.ListIndex = 0 End If Exit Sub Err: Me.Combo1.Clear For i = 1 To 8 Me.Combo1.AddItem "COM" & i Next i End Sub Sub SetCom() MSComm1.Settings = Str(Combo2) + "N,8,1" End Sub Private Sub Combo1_Change() If Combo1.Text = LastCombo1Text Then Exit Sub If MSComm1.PortOpen = True Then Me.MSComm1.PortOpen = False LedOff ComOpen.Caption = "打开串口" Me.MSComm1.CommPort = Val(Replace(Me.Combo1.Text, "COM", "")) LastCombo1Text = Me.Combo1.Text End Sub Private Sub Combo1_Click() Call Combo1_Change End Sub Private Sub Form_Resize() On Error Resume Next Me.Frame2.Left = Me.Width - Me.Frame2.Width - 100 Me.Frame2.Height = Me.Height - Me.Frame2.Top - Me.StatusBar1.Height - 550 Me.Frame3.Width = Me.Frame2.Left - Me.Frame3.Left - 100 Me.Frame3.Height = Me.Frame2.Height Me.List1.Width = Me.Frame3.Width - 250 Me.Text1.Width = Me.List1.Width Me.Text2.Width = Me.List1.Width Me.List1.Height = Me.Frame3.Height - Me.Text1.Height - 750 Me.Text1.Top = Me.Frame3.Height - Me.Text1.Height - 200 Me.Picture1.Width = Me.Frame3.Width Me.Picture1.Height = Me.Frame3.Height - 100 If Me.WindowState <> 0 Then Exit Sub WriteToIni Apppath, "size", "width", Me.Width WriteToIni Apppath, "size", "height", Me.Height End Sub Private Sub Form_Unload(Cancel As Integer) End End Sub Private Sub List1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) If Button = 2 Then If Me.List1.SelCount > 0 Then Me.PopupMenu MenuList End If End If End Sub MenuDel_Click() Private Sub Me.List1.RemoveItem Me.List1.ListIndex NumRX = Me.List1.ListCount MsgNum NumRX End Sub Private Sub MSComm1_OnComm() Dim BytReceived() As Byte Dim Vrx As Integer Dim i As Integer Dim tem1 On Error GoTo Err Select Case MSComm1.CommEvent Case 2 Cls MSComm1.InputLen = 0 strBuff = MSComm1.Input ProcessData TimeDelay = 30 End Select Exit Sub Err: MsgBox Err.Description End Sub Sub ProcessData() Dim BytReceived() As Byte Dim Vrx As Byte Dim str1 As String Dim j As Integer Dim i As Integer Dim m As Integer Dim bcc As Integer BytReceived() = strBuff For i = 0 To UBound(BytReceived) Vrx = BytReceived(i) If state = 0 Then If Vrx = &H33 Then state = 1 ElseIf state = 1 Then If Vrx = &HBB Then state = 2 ElseIf state = 2 Then If Vrx = DataOrder Then state = 3 ElseIf state = 3 Then Datalen = Vrx state = 4 NumRX = NumRX + 1 MsgNum NumRX ReDim ListData(Datalen + 1) ListIndex = 1 ElseIf state = 4 Then ListData(ListIndex) = Vrx ListIndex = ListIndex + 1 If ListIndex > Datalen + 1 Then state = 0 ListIndex = 0 str1 = "" If DataOrder = &HAF Or DataOrder = &HAE Then bcc = 0 Else bcc = 1 End If If ViewFlag Then DrawWaveFlag = True ListData(0) = Datalen TimeDelay = 10 Else For j = 1 To Datalen + bcc str1 = str1 & GeshiByte(ListData(j)) Next j Me.List1.AddItem str1 Me.List1.Selected(Me.List1.ListCount - 1) = True End If End If Else state = 0: ListIndex = 0 End If Next i End Sub Function Geshi(num1, m) As String Dim N As Integer If num1 < 10 Then N = 1 ElseIf num1 < 100 Then N = 2 ElseIf num1 < 1000 Then N = 3 ElseIf num1 < 10000 Then N = 4 ElseIf num1 < 100000 Then N = 5 ElseIf num1 < 1000000 Then N = 6 End If If m = 0 Then Geshi = Str(num1) ElseIf m > N Then Geshi = Space(m - N) & Str(num1) Else Geshi = Str(num1) End If End Function Function Geshi2(num1, m) Dim N As Integer If num1 < 10 Then Geshi2 = " ." & num1 & "0" Else Geshi2 = " ." & num1 End If End Function Sub MsgXY(x, y) Me.Label2.Caption = x & "," & y End Sub Sub MsgNum(num1) Me.StatusBar1.Panels(3).Text = num1 End Sub Sub MsgStr(str1) Me.StatusBar1.Panels(5).Text = str1 End Sub Sub LedOn() Me.Combo1.BackColor = vbGreen End Sub Sub LedOff() Me.Combo1.BackColor = &H80000000 End Sub Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) MsgXY Int(x + 0.5), Int(y + 0.5) End Sub Private Sub Timer1_Timer() If TimeDelay > 0 Then TimeDelay = TimeDelay - 1 If TimeDelay = 1 Then If ViewFlag = False Then Call DataProce Else If DrawWaveFlag Then DrawWaveFlag = 0 Call DrawWave End If End If End If End Sub Private Function DrawWave() Dim str1 As String Dim str2 As String Me.Picture1.Visible = True Me.Picture1.Cls Mgx = ListData(1) AvgMg = ListData(2) Slant = ListData(3) TotalSample = ListData(0) - 3 If TotalSample < 1 Then Exit Function End If MinMg = 255 MaxMg = 0 Me.Picture1.FontSize = 9 For i = 0 To TotalSample - 1 Mgbuffer(i) = ListData(4 + i) If Mgbuffer(i) < MinMg Then MinMg = Mgbuffer(i) If Mgbuffer(i) > MaxMg Then MaxMg = Mgbuffer(i) Next i Mgbuffer(250) = Asc("M") Mgbuffer(251) = Asc("G") str1 = Mgx & "号磁头" str1 = str1 & " " & "个数=" & TotalSample str1 = str1 & "," & "斜率=" & Slant str1 = str1 & "," & "基准=" & AvgMg str1 = str1 & "," & "上=" & MaxMg - AvgMg str1 = str1 & "," & "下=" & AvgMg - MinMg str1 = str1 & "," & "?=" & MaxMg - MinMg str2 = "最小,最大=(" & MinMg & "," & MaxMg & ")" MsgStr str1 & " " & str2 Me.Picture1.Scale (-10, 270)-(TotalSample + 10, -15) Me.Picture1.Line (0, 0)-(TotalSample, 255), &H8000000C, B Me.Picture1.ForeColor = &H808080 For i = 1 To 255 If i Mod 10 = 0 Then Me.Picture1.Line (0, i)-(-8, i) Me.Picture1.Print i ElseIf i Mod 5 = 0 Then Me.Picture1.Line (0, i)-(-2, i) Else ' Me.Picture1.Line (0, i)-(-5, i) End If Next i For i = 0 To TotalSample If i Mod 10 = 0 Then Me.Picture1.Line (i, 0)-(i, -6) Me.Picture1.CurrentX = i - 2 Me.Picture1.Print i ElseIf i Mod 5 = 0 Then Me.Picture1.Line (i, -3)-(i, 0) Else ' Me.Picture1.Line (0, i)-(-5, i) End If Next i '绘制平均线 Me.Picture1.DrawWidth = 1 Me.Picture1.Line (0, AvgMg)-(TotalSample, AvgMg), &H8000000C If Mgx = 10 Then '绘制top buttom Me.Picture1.Line (0, WaveTopMT)-(TotalSample, WaveTopMT), vbBlue Me.Picture1.Line (0, WaveButtomMT)-(TotalSample, WaveButtomMT), vbBlue Else '绘制top buttom Me.Picture1.Line (0, WaveTop)-(TotalSample, WaveTop), vbBlue Me.Picture1.Line (0, WaveButtom)-(TotalSample, WaveButtom), vbBlue End If '绘制连线 Me.Picture1.DrawWidth = 1 i = 0 Me.Picture1.PSet (i, Mgbuffer(i)), &HFF00& For i = 1 To TotalSample - 1 -(i, Mgbuffer(i)), &HFF00& Me.Picture1.Line Next i Me.Picture1.ForeColor = &H8000000C Me.Picture1.CurrentX = 0 Me.Picture1.CurrentY = 265 Me.Picture1.Print str1 Me.Picture1.FontSize = 12 Me.Picture1.ForeColor = vbGreen Me.Picture1.CurrentX = 120 Me.Picture1.CurrentY = 268 Me.Picture1.Print str2 End Function Private Sub DataProce() Dim j As Integer Dim sum1 As String Dim str1 As String Dim strb As String Dim m As Integer If Me.List1.ListCount = 0 Then Exit Sub NumRec = Me.List1.ListCount m = Len(Me.List1.List(Me.List1.ListCount - 1)) / 4 - 1 For i = 0 To Me.List1.ListCount - 1 For j = 0 To m DataRun(i + 1, j) = Val(Mid(Me.List1.List(i), j * 4 + 1, 4)) Next j DataRun(i + 1, 10) = i Next i For i = 0 To m ValD(i, 0) = DataRun(1, i) 'min ValD(i, 1) = DataRun(1, i) 'avg ValD(i, 2) = DataRun(1, i) 'max sum1 = 0 For j = 1 To NumRX If ValD(i, 0) > DataRun(j, i) Then ValD(i, 0) = DataRun(j, i) If ValD(i, 2) < DataRun(j, i) Then ValD(i, 2) = DataRun(j, i) sum1 = sum1 + DataRun(j, i) Next j ValD(i, 1) = Round(sum1 / NumRX, 2) Next i str1 = "" strb = "" For i = 0 To m strb = strb & Geshi(ValD(i, 0), 3) Next i str1 = str1 & strb & " 最小值" & vbCrLf & vbCrLf strb = "" For i = 0 To m Geshi(Int(ValD(i, 1)), 3) strb = strb & Next i str1 = str1 & strb & " 平均值" & vbCrLf ' vbcrlf strb = "" For i = 0 To m strb = strb & Geshi2(Int(100 * (ValD(i, 1) - Int(ValD(i, 1)))), 2) Next i str1 = str1 & strb & vbCrLf & vbCrLf strb = "" For i = 0 To m strb = strb & Geshi(ValD(i, 2), 3) Next i str1 = str1 & strb & " 最大值" Me.Text1.Text = str1 End Sub