![]() |
中国面包师贴吧-楼主(阅:2380/回:0)VB串口程序1下面介绍几个使用VB6.0开发的计算机串口通讯程序,这些程序可以自动发送16进制字符,并接收这些字符。这些程序可以在链接:https://pan.baidu.com/s/1-SMLa3UwbxArwY3QRNtswg 提取码:hdze 下载 VERSION 5.00 Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX" Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "comctl32.ocx" Begin VB.Form mn_form BackColor = &H00404000& BorderStyle = 1 'Fixed Single ClientHeight = 9795 ClientLeft = 45 ClientTop = 615 ClientWidth = 12735 FillColor = &H00E0E0E0& BeginProperty Font Name = "宋体" Size = 12 Charset = 134 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty LinkTopic = "Form1" ScaleHeight = 9795 ScaleWidth = 12735 StartUpPosition = 2 '屏幕中心 WindowState = 2 'Maximized Begin ComctlLib.Toolbar Toolbar1 Align = 1 'Align Top Height = 480 Left = 0 TabIndex = 2 Top = 0 Width = 12735 _ExtentX = 22463 _ExtentY = 847 ButtonWidth = 714 ButtonHeight = 688 Appearance = 1 ImageList = "ImageList1" _Version = 327682 BeginProperty Buttons {0713E452-850A-101B-AFC0-4210102A8DA7} NumButtons = 8 BeginProperty Button1 {0713F354-850A-101B-AFC0-4210102A8DA7} Object.ToolTipText = "校时" Object.Tag = "" ImageIndex = 1 EndProperty BeginProperty Button2 {0713F354-850A-101B-AFC0-4210102A8DA7} Object.ToolTipText = "轮询" Object.Tag = "" ImageIndex = 2 Style = 1 EndProperty BeginProperty Button3 {0713F354-850A-101B-AFC0-4210102A8DA7} Object.ToolTipText = "定值" Object.Tag = "" ImageIndex = 3 EndProperty BeginProperty Button4 {0713F354-850A-101B-AFC0-4210102A8DA7} Object.ToolTipText = "设定" Object.Tag = "" ImageIndex = 4 EndProperty BeginProperty Button5 {0713F354-850A-101B-AFC0-4210102A8DA7} Object.ToolTipText = "分闸" Object.Tag = "" ImageIndex = 5 EndProperty BeginProperty Button6 {0713F354-850A-101B-AFC0-4210102A8DA7} Object.ToolTipText = "合闸" Object.Tag = "" ImageIndex = 6 EndProperty BeginProperty Button7 {0713F354-850A-101B-AFC0-4210102A8DA7} Object.ToolTipText = "内存" Object.Tag = "" ImageIndex = 7 Style = 1 EndProperty BeginProperty Button8 {0713F354-850A-101B-AFC0-4210102A8DA7} Object.Tag = "" Style = 3 MixedState = -1 'True EndProperty EndProperty OLEDropMode = 1 Begin VB.Frame Frame1 Appearance = 0 'Flat BorderStyle = 0 'None ForeColor = &H80000008& Height = 375 Left = 9480 TabIndex = 3 Top = 0 Width = 5895 Begin VB.TextBox RAM_addr1th Alignment = 2 'Center Appearance = 0 'Flat ForeColor = &H00800000& Height = 375 Left = 2400 TabIndex = 9 Text = "0" Top = 0 Width = 735 End Begin VB.VScrollBar RAM_VScroll1 Height = 375 Left = 3120 Max = 1216 SmallChange = 32 TabIndex = 8 Top = 0 Width = 255 End Begin VB.VScrollBar SN_VScroll Height = 375 Left = 4440 Max = 199 TabIndex = 7 Top = 0 value = 1 Width = 255 End Begin VB.TextBox SN_Text Alignment = 2 'Center Appearance = 0 'Flat ForeColor = &H00800000& Height = 360 Left = 3960 TabIndex = 6 Text = "01" Top = 0 Width = 495 End Begin VB.ComboBox Combo1 Appearance = 0 'Flat BeginProperty Font Name = "System" Size = 12 Charset = 134 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00800000& Height = 360 ItemData = "Star_M6.frx":0000 Left = 4920 List = "Star_M6.frx":000A TabIndex = 4 Text = "COM1" Top = 0 Width = 975 End End End Begin VB.PictureBox disp_pic BackColor = &H00161602& ForeColor = &H0000FFFF& Height = 5895 Left = 120 ScaleHeight = 5835 ScaleWidth = 10035 TabIndex = 10 Top = 3600 Width = 10095 End Begin ComctlLib.StatusBar StatusBar1 Align = 2 'Align Bottom Height = 255 Left = 0 TabIndex = 5 Top = 9540 Width = 12735 _ExtentX = 22463 _ExtentY = 450 SimpleText = "" _Version = 327682 BeginProperty Panels {0713E89E-850A-101B-AFC0-4210102A8DA7} NumPanels = 2 BeginProperty Panel1 {0713E89F-850A-101B-AFC0-4210102A8DA7} Alignment = 2 Object.Width = 1411 MinWidth = 1411 Object.Tag = "" EndProperty BeginProperty Panel2 {0713E89F-850A-101B-AFC0-4210102A8DA7} Alignment = 2 Object.Width = 1411 MinWidth = 1411 Object.Tag = "" EndProperty EndProperty BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "System" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty End Begin VB.Timer T_05s00 Interval = 500 Left = 600 Top = 480 End Begin MSCommLib.MSComm MSComm1 Left = 1080 Top = 480 _ExtentX = 1005 _ExtentY = 1005 _Version = 393216 CommPort = 2 DTREnable = 0 'False InputLen = 1 RThreshold = 1 ParitySetting = 2 InputMode = 1 End Begin VB.Label disp_area BackColor = &H00161602& BorderStyle = 1 'Fixed Single BeginProperty Font Name = "宋体" Size = 9 Charset = 134 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H0000FFFF& Height = 3015 Left = 120 TabIndex = 11 Top = 480 Width = 10095 End Begin ComctlLib.ImageList ImageList1 Left = 0 Top = 480 _ExtentX = 1005 _ExtentY = 1005 BackColor = -2147483643 ImageWidth = 20 ImageHeight = 20 MaskColor = 12632256 _Version = 327682 BeginProperty Images {0713E8C2-850A-101B-AFC0-4210102A8DA7} NumListImages = 7 BeginProperty ListImage1 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "Star_M6.frx":001A Key = "" EndProperty BeginProperty ListImage2 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "Star_M6.frx":0334 Key = "" EndProperty BeginProperty ListImage3 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "Star_M6.frx":064E Key = "" EndProperty BeginProperty ListImage4 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "Star_M6.frx":0968 Key = "" EndProperty BeginProperty ListImage5 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "Star_M6.frx":0C82 Key = "" EndProperty BeginProperty ListImage6 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "Star_M6.frx":0F9C Key = "" EndProperty BeginProperty ListImage7 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "Star_M6.frx":12B6 Key = "" EndProperty EndProperty End Begin VB.Label rx_data BackColor = &H00000000& BorderStyle = 1 'Fixed Single BeginProperty Font Name = "宋体" Size = 9 Charset = 134 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H0000FFFF& Height = 1935 Left = 10320 TabIndex = 1 Top = 1560 Width = 5295 End Begin VB.Label tx_data BackColor = &H00000000& BorderStyle = 1 'Fixed Single BeginProperty Font Name = "宋体" Size = 9 Charset = 134 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H0000FFFF& Height = 1068 Left = 10320 TabIndex = 0 Top = 480 Width = 5292 End Begin VB.Menu mu_sys Caption = "系统[&S] " Begin VB.Menu sys_set Caption = "设定" End Begin VB.Menu mu_quit Caption = "退出" End End Begin VB.Menu compt Caption = "元件[&C] " End Begin VB.Menu AC_ch Caption = "通道[&F] " End Begin VB.Menu op Caption = "操作[&O] " End Begin VB.Menu help Caption = "帮助[&H]" End End Attribute VB_Name = "mn_form" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Dim V_1, V_1_real, V_1_Image, V_2, V_2_real, V_2_Image, V_1_m6, v_ric, tp00, tp01 As Single Public num_rxright, num_sent, rx_CRC, T_pos Sub Send(ByVal Cmd As Integer) Dim k(0) As Byte tx_data.Caption = "" If Cmd = 4 Then T_pos = &H178: Cmd = 3 Else T_pos = RAM_VScroll1.value tx_b(3) = Array(SN_VScroll.value, 3, T_pos \ 256, T_pos Mod 256, &H0, &H40, 0, 0, Hour(Time), Minute(Time), Second(Time), 0, 0, 0, 0) tx_b(Cmd)(0) = SN_VScroll.value: tx_b(Cmd)(1) = Cmd If Cmd = 16 Then Lenth = tx_b(Cmd)(5) * 2 + 7 Else Lenth = 6 Sum = &HFFFF For i = 0 To Lenth - 1 If tx_b(Cmd)(i) < 0 Then tx_b(Cmd)(i) = 256 + tx_b(Cmd)(i) k(0) = tx_b(Cmd)(i) Sum = Sum Xor (k(0) And &HFF) If Sum < 0 Then Sum = 65536 + Sum For j = 0 To 7 If (Sum And 1) = 1 Then Sum = Int(Sum \ 2): Sum = Sum Xor &HA001 If Sum < 0 Then Sum = 65536 + Sum Else Sum = Int(Sum \ 2) End If Next MSComm1.Output = k: tx_data.Caption = tx_data.Caption + hexbyt(Int(k(0))) + " " Next If Sum < 0 Then Sum = 65536 + Sum k(0) = (Sum Mod 256): tx_data.Caption = tx_data.Caption + hexbyt(Int(k(0))) + " " MSComm1.Output = k k(0) = (Sum \ 256): tx_data.Caption = tx_data.Caption + hexbyt(Int(k(0))) + " " MSComm1.Output = k rx_data = "": rx_CRC = &HFFFF End Sub Private Sub Combo1_Click() p = Combo1.ListIndex + 1 If p > 0 And p < 3 Then Call Close_OpenPort(Int(p)) End Sub Private Sub AC_ch_Click() Factor_Seting.Visible = True tx_REQ = 3 End Sub Private Sub compt_Click() Comptform.Visible = True End Sub Private Sub Form_Load() Call Close_OpenPort(1) Call MakeToolbarFlat(Toolbar1) sys_set.Visible = True For i = 0 To 8 tx_b(i) = Array(&H68, &H3, &H3, &H68, &H20, &H93, &H83, &H85, &H0, &H30 + Second(Time) Mod 10, &H0, &H30 + Second(Time) Mod 10, &H0, &H41 + Second(Time) Mod 10, &H0, &H61 + Second(Time) Mod 10, 0, 0, 0, 0, 1, 7, 6, 5, 4, 3, 2, 1, 7, 6, 5, 4, 3, 2, 1, 0, 0, 0, 0, 1, 7, 6, 5, 4, 3, 2, 1, 7, 6, 5, 4, 3, 2, 1, 0, 0, 0, 0, 1, 7, 6, 5, 4, 3, 2, 1, 7, 6, 5, 4, 3, 2, 1, 0, 0, 0, 0, 1, 7, 6, 5, 4, 3, 2, 1, 7, 6, 5, 4, 3, 2, 1, 0, 0, 0, 0, 1, 7, 6, 5, 4, 3, 2, 1, 7, 6, 5, 4, 3, 2, 1) Next tx_REQ = 3: num_rxright = 0: num_sent = 0 End Sub Private Sub Form_Unload(Cancel As Integer) Unload controlform Unload Comptform Unload Factor_Seting Unload Me End Sub Private Sub MSComm1_OnComm() Dim temp As Variant MSComm1.InputLen = 1 While MSComm1.InBufferCount <> 0 temp = MSComm1.Input If rx_ptr < 150 Then If rx_ptr = 3 Then rx_data.Caption = rx_data.Caption + vbCr rx_b(rx_ptr) = temp(0): rx_data.Caption = rx_data.Caption + hexbyt(Int(temp(0))) + " " rx_ptr = rx_ptr + 1 rx_CRC = rx_CRC Xor (temp(0) And &HFF) If rx_CRC < 0 Then rx_CRC = 65536 + rx_CRC For j = 0 To 7 If (rx_CRC And 1) = 1 Then rx_CRC = Int(rx_CRC \ 2) rx_CRC = rx_CRC Xor &HA001 If rx_CRC < 0 Then rx_CRC = 65536 + rx_CRC Else rx_CRC = Int(rx_CRC \ 2) End If Next End If Wend End Sub Private Sub op_Click() controlform.Visible = True End Sub Private Sub RAM_VScroll1_Change() RAM_addr1th.Text = strhex(RAM_VScroll1.value) End Sub Private Sub SN_VScroll_Change() SN_Text.Text = Str(SN_VScroll.value) '站号调整与显示 End Sub Private Sub sys_set_Click() s_set.Visible = True End Sub Private Sub T_05s00_Timer() mn_form.Caption = " X200测试 " + Format(Date, " yyyy-mm-dd ") + Format(Time, "hh:mm:ss ") '标题刷新 If rx_CRC = 0 Then Call Process num_rxright = (num_rxright + 1) Mod 10000 '显示接收正确次数 StatusBar1.Panels(2) = Str(num_rxright) End If Call Send(tx_REQ) '发送默认命令 If tx_REQ <> 3 Then tx_REQ = 3 num_sent = (num_sent + 1) Mod 10000 StatusBar1.Panels(1) = Str(num_sent) '显示召唤次数 rx_ptr = 0 End Sub Sub Close_OpenPort(port As Byte) On Error Resume Next ' 改变错误处理的方式。 Err.Clear If MSComm1.PortOpen = True Then MSComm1.PortOpen = False MSComm1.CommPort = port MSComm1.Settings = "9600,n,8,1" MSComm1.InputLen = 0 MSComm1.PortOpen = True If Err.Number <> 0 Then msg = "Error # " & Str(Err.Number) & " was generated by " _ & Err.Source & Chr(13) & Err.Description MsgBox msg, , "Error", Err.HelpFile, Err.HelpContext End If End Sub Public Sub Process() If (T_pos < 410) Then disp_area.Caption = "" For i = 0 To 63 D_int(i) = b_i(rx_b(4 + i * 2), rx_b(3 + i * 2)) If D_int(i) >= 0 Then disp_area.Caption = disp_area.Caption + Format(D_int(i), " 00000 ") Else disp_area.Caption = disp_area.Caption + "-" + Format(-D_int(i), "00000 ") End If If (i Mod 8) = 7 Then disp_area.Caption = disp_area.Caption + vbCr + " " Next sindraw (0) End If If T_pos = &H80 Then 'For i = 0 To 7 'Factor_Seting.AC_data(i).Caption = Format(b_i(rx_b(4 + i * 2), rx_b(3 + i * 2)) / 100, "0.00") Factor_Seting.AC_data(1).Caption = Format(b_i(rx_b(8), rx_b(7)) / 100, "0.00") Factor_Seting.AC_data(0).Caption = Format(b_i(rx_b(16), rx_b(15)) / 100, "0.00") Factor_Seting.AC_data(3).Caption = Format(b_i(rx_b(24), rx_b(23)) / 100, "0.00") Factor_Seting.AC_data(2).Caption = Format(b_i(rx_b(32), rx_b(31)) / 1000 * 38, "0.00") Factor_Seting.AC_data(5).Caption = Format(b_i(rx_b(40), rx_b(39)) / 1000 * 38, "0.00") Factor_Seting.AC_data(4).Caption = Format(b_i(rx_b(102), rx_b(101)) / 1000, "0.00") Factor_Seting.AC_data(7).Caption = Format(b_i(rx_b(104), rx_b(103)) / 1000, "0.00") 'Factor_Seting.AC_data(7).Caption = Format(b_i(rx_b(6 + i * 2), rx_b(5 + i * 2)) / 100, "0.00") 'Next End If If T_pos = &H178 Then For i = 0 To 7 If rx_b(3 + i) < 128 Then Factor_Seting.VScroll1(i).value = -rx_b(3 + i) Else Factor_Seting.VScroll1(i).value = 256 - rx_b(3 + i) Next End If End Sub Public Sub sindraw(ByVal ch As Integer) disp_pic.Cls xsc = (disp_pic.Width - 200) / 32: ysc = (disp_pic.Height - 200) / 1280: xax = disp_pic.Height / 2 disp_pic.Line (xsc, xax)-(disp_pic.Width - xsc, xax), RGB(128, 128, 128) disp_pic.Line (xsc, 100)-(xsc, disp_pic.Height - 100), RGB(128, 128, 128) If T_pos < &H60 Then For i = 1 To 31 disp_pic.Line (i * xsc, D_int((i - 1) Mod 16) * ysc + xax)-((i + 1) * xsc, D_int(i Mod 16) * ysc + xax), RGB(250, ch * 50, 0) disp_pic.Line (i * xsc, D_int((i - 1) Mod 16 + 16) * ysc + xax)-((i + 1) * xsc, D_int(i Mod 16 + 16) * ysc + xax), RGB(250, ch * 50, 200) disp_pic.Line (i * xsc, D_int((i - 1) Mod 16 + 32) * ysc + xax)-((i + 1) * xsc, D_int(i Mod 16 + 32) * ysc + xax), RGB(210, 150, 220) disp_pic.Line (i * xsc, D_int((i - 1) Mod 16 + 48) * ysc + xax)-((i + 1) * xsc, D_int(i Mod 16 + 48) * ysc + xax), RGB(150, ch * 50, 100) Next Else For i = 1 To 31 disp_pic.Line (i * xsc, xax)-((i + 1) * xsc, xax), RGB(250, ch * 50, 0) disp_pic.Line (i * xsc, 16 * ysc + xax)-((i + 1) * xsc, 16 * ysc + xax), RGB(250, ch * 50, 200) disp_pic.Line (i * xsc, 32 * ysc + xax)-((i + 1) * xsc, 32 * ysc + xax), RGB(210, 150, 220) disp_pic.Line (i * xsc, 48 * ysc + xax)-((i + 1) * xsc, 48 * ysc + xax), RGB(150, ch * 50, 100) Next End If End Sub VERSION 5.00 Begin VB.Form Comptform Caption = "元件设定" ClientHeight = 4005 ClientLeft = 60 ClientTop = 345 ClientWidth = 3330 LinkTopic = "Form1" ScaleHeight = 4005 ScaleWidth = 3330 StartUpPosition = 3 '窗口缺省 Begin VB.ComboBox Combo3 BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 ItemData = "Compt.frx":0000 Left = 840 List = "Compt.frx":0031 TabIndex = 8 Text = "1" Top = 600 Width = 2175 End Begin VB.Commanon Command2 Caption = "下装" BeginProperty Font Name = "宋体" Size = 10.5 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 1440 TabIndex = 7 Top = 3360 Width = 1575 End Begin VB.ComboBox Combo1 Appearance = 0 'Flat BackColor = &H00FFFFFF& DataField = "类型" DataSource = "Data1" BeginProperty Font Name = "System" Size = 12 Charset = 134 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00800000& Height = 360 ItemData = "Compt.frx":0068 Left = 1440 List = "Compt.frx":0087 TabIndex = 6 Text = "跳闸" Top = 2640 Width = 1575 End Begin VB.TextBox Text2 Alignment = 1 'Right Justify BackColor = &H00FFFFFF& DataField = "定值1" DataSource = "Data1" BeginProperty Font Name = "宋体" Size = 10.5 Charset = 134 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00800000& Height = 315 Index = 0 Left = 840 TabIndex = 5 Text = "1.0 " Top = 1200 Width = 972 End Begin VB.TextBox Text3 Alignment = 1 'Right Justify Appearance = 0 'Flat BackColor = &H00FFFFFF& DataField = "定值1比例" DataSource = "Data1" BeginProperty Font Name = "宋体" Size = 10.5 Charset = 134 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00808080& Height = 315 Index = 0 Left = 2400 TabIndex = 4 Text = "200" Top = 1200 Width = 615 End Begin VB.TextBox Text3 Alignment = 1 'Right Justify Appearance = 0 'Flat BackColor = &H00FFFFFF& DataField = "定值2比例" DataSource = "Data1" BeginProperty Font Name = "宋体" Size = 10.5 Charset = 134 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00808080& Height = 315 Index = 1 Left = 2400 TabIndex = 3 Text = "100" Top = 1680 Width = 615 End Begin VB.TextBox Text2 Alignment = 1 'Right Justify BackColor = &H00FFFFFF& DataField = "定值2" DataSource = "Data1" BeginProperty Font Name = "宋体" Size = 10.5 Charset = 134 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00800000& Height = 315 Index = 1 Left = 840 TabIndex = 2 Text = "1.0 " Top = 1680 Width = 972 End |
| 发帖须知: 1,发帖请遵守《计算机信息网络国际联网安全保护管理办法》、《互联网信息服务管理办法》、 《互联网电子公告服务管理规定》、《维护互联网安全的决定》等法律法规。 2,请对您的言论负责,我们将保留您的上网记录和发帖信息。 3,在此发帖表示认同我们的条款,我们有权利对您的言论进行审核、删除或者采取其他在法律、地方法规等条款规定之内的管理操作。 |