VB串口程序8-数码蛋糕-中国面包师贴吧/中国烘焙网贴吧/烘焙师招聘求职贴吧

Begin VB.Commanon cmdOK

Cancel = -1 'True

Caption = "确定"

Default = -1 'True

Height = 345

Left = 4125

TabIndex = 0

Top = 2625

Width = 1500

End

Begin VB.Commanon cmdSysInfo

Caption = "系统信息(&S)..."

Height = 345

Left = 4140

TabIndex = 2

Top = 3075

Width = 1485

End

Begin VB.Line Line1

BorderColor = &H00808080&

BorderStyle = 6 'Inside Solid

Index = 1

X1 = 84.515

X2 = 5309.398

Y1 = 1687.583

Y2 = 1687.583

End

Begin VB.Label lblDescription

Caption = "本软件是西安亚川电力科技有限公司的电动机保护器专用调试软件。"

ForeColor = &H00000000&

Height = 1170

Left = 1050

TabIndex = 3

Top = 1125

Width = 3885

End

Begin VB.Label lblTitle

Caption = "西安亚川电力科技有限公司电动机保护调试软件"

ForeColor = &H00000000&

Height = 480

Left = 1050

TabIndex = 5

Top = 240

Width = 3885

End

Begin VB.Line Line1

BorderColor = &H00FFFFFF&

BorderWidth = 2

Index = 0

X1 = 98.6

X2 = 5309.398

Y1 = 1697.936

Y2 = 1697.936

End

Begin VB.Label lblVersion

Caption = "版本 2.00"

Height = 225

Left = 1050

TabIndex = 6

Top = 780

Width = 3885

End

Begin VB.Label lblDisclaimer

ForeColor = &H00000000&

Height = 825

Left = 255

TabIndex = 4

Top = 2625

Width = 3630

End

Attribute VB_Name = "frmAbout"

Attribute VB_GlobalNameSpace = False

Attribute VB_Creatable = False

Attribute VB_PredeclaredId = True

Attribute VB_Exposed = False

Option Explicit

' 注册表关键字安全选项...

Const READ_CONTROL = &H20000

Const KEY_QUERY_value = &H1

Const KEY_SET_value = &H2

Const KEY_CREATE_SUB_KEY = &H4

Const KEY_ENUMERATE_SUB_KEYS = &H8

Const KEY_NOTIFY = &H10

Const KEY_CREATE_LINK = &H20

Const KEY_ALL_ACCESS = KEY_QUERY_value + KEY_SET_value + _

KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _

KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL

' 注册表关键字 ROOT 类型...

Const HKEY_LOCAL_MACHINE = &H80000002

Const ERROR_SUCCESS = 0

Const REG_SZ = 1 ' 独立的空的终结字符串

Const REG_DWORD = 4 ' 32位数字

Const gREGKEYSYSINFOLOC = "SOFTWARE\Microsoft\Shared Tools Location"

Const gREGVALSYSINFOLOC = "MSINFO"

Const gREGKEYSYSINFO = "SOFTWARE\Microsoft\Shared Tools\MSINFO"

Const gREGVALSYSINFO = "PATH"

Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long

Private Declare Function RegQueryvalueEx Lib "advapi32" Alias "RegQueryvalueExA" (ByVal hKey As Long, ByVal lpvalueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long

Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long

Private Sub cmdSysInfo_Click()

Call StartSysInfo

End Sub

Private Sub cmdOK_Click()

Unload Me

End Sub

Private Sub Form_Load()

Me.Caption = "西安亚川电力科技有限公司 "

lblVersion.Caption = "版本 " & App.Major & "." & App.Minor & "." & App.Revision

lblTitle.Caption = "电动机保护器调试软件"

End Sub

Public Sub StartSysInfo()

On Error GoTo SysInfoErr

Dim rc As Long

Dim SysInfoPath As String

' 试图从注册表中获得系统信息程序的路径及名称...

If GetKeyvalue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then

' 试图仅从注册表中获得系统信息程序的路径...

ElseIf GetKeyvalue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then

' 已知32位文件版本的有效位置

If (Dir(SysInfoPath & "\MSINFO32.EXE") <> "") Then

SysInfoPath = SysInfoPath & "\MSINFO32.EXE"

' 错误 - 文件不能被找到...

Else

GoTo SysInfoErr

End If

' 错误 - 注册表相应条目不能被找到...

Else

GoTo SysInfoErr

End If

Call Shell(SysInfoPath, vbNormalFocus)

Exit Sub

SysInfoErr:

MsgBox "此时系统信息不可用", vbOKOnly

End Sub

Public Function GetKeyvalue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean

Dim i As Long ' 循环计数器

Dim rc As Long ' 返回代码

Dim hKey As Long ' 打开的注册表关键字句柄

Dim hDepth As Long '

Dim KeyValType As Long ' 注册表关键字数据类型

Dim tmpVal As String ' 注册表关键字值的临时存储器

Dim KeyValSize As Long ' 注册表关键自变量的尺寸

'------------------------------------------------------------

' 打开 {HKEY_LOCAL_MACHINE...} 下的 RegKey

'------------------------------------------------------------

rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' 打开注册表关键字

If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' 处理错误...

tmpVal = String$(1024, 0) ' 分配变量空间

KeyValSize = 1024 ' 标记变量尺寸

'------------------------------------------------------------

' 检索注册表关键字的值...

'------------------------------------------------------------

rc = RegQueryvalueEx(hKey, SubKeyRef, 0, _

KeyValType, tmpVal, KeyValSize) ' 获得/创建关键字值

If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' 处理错误

If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then ' Win95 外接程序空终结字符串...

tmpVal = Left(tmpVal, KeyValSize - 1) ' Null 被找到,从字符串中分离出来

Else ' WinNT 没有空终结字符串...

tmpVal = Left(tmpVal, KeyValSize) ' Null 没有被找到, 分离字符串

End If

'------------------------------------------------------------

' 决定转换的关键字的值类型...

'------------------------------------------------------------

Select Case KeyValType ' 搜索数据类型...

Case REG_SZ ' 字符串注册关键字数据类型

KeyVal = tmpVal ' 复制字符串的值

Case REG_DWORD ' 四字节的注册表关键字数据类型

For i = Len(tmpVal) To 1 Step -1 ' 将每位进行转换

KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1))) ' 生成值字符。 By Char。

KeyVal = Format$("&h" + KeyVal) ' 转换四字节的字符为字符串

End Select

GetKeyvalue = True ' 返回成功

rc = RegCloseKey(hKey) ' 关闭注册表关键字

Exit Function ' 退出

GetKeyError: ' 错误发生后将其清除...

KeyVal = "" ' 设置返回值到空字符串

GetKeyvalue = False ' 返回失败

rc = RegCloseKey(hKey) ' 关闭注册表关键字

End Function

VERSION 5.00

Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"

Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"

Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "comctl32.ocx"

Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"

Begin VB.Form mn_form

BackColor = &H00404000&

Caption = "西安亚川电力科技有限公司电动机保护器调试软件"

ClientHeight = 10020

ClientLeft = 165

ClientTop = 915

ClientWidth = 15615

Icon = "Star_M6.frx":0000

LinkTopic = "Form1"

ScaleHeight = 10020

ScaleWidth = 15615

StartUpPosition = 3 '窗口缺省

Begin VB.Timer T_05s00

Enabled = 0 'False

Interval = 500

Left = 720

Top = 600

End

Begin VB.Timer Timer1

Interval = 1000

Left = 1320

Top = 600

End

Begin VB.PictureBox disp_pic

BackColor = &H00161602&

ForeColor = &H0000C000&

Height = 5895

Left = 0

ScaleHeight = 5835

ScaleWidth = 10035

TabIndex = 7

Top = 3480

Width = 10095

End

Begin MSComctlLib.Toolbar Toolbar1

Align = 1 'Align Top

Height = 420

Left = 0

TabIndex = 0

Top = 0

Width = 15615

_ExtentX = 27543

_ExtentY = 741

ButtonWidth = 609

ButtonHeight = 582

Appearance = 1

ImageList = "imlToolbarIcons"

_Version = 393216

BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628}

NumButtons = 3

BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628}

Key = "打开串口"

Object.ToolTipText = "打开串口"

ImageKey = "Forward1"

Style = 1

EndProperty

BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628}

Key = "关闭串口"

Object.ToolTipText = "关闭串口"

ImageKey = "Permission"

Style = 1

EndProperty

BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628}

Key = "开始通讯"

Object.ToolTipText = "开始通讯"

ImageKey = "Phone"

Style = 1

EndProperty

Begin VB.TextBox RAM_addr1th

Alignment = 2 'Center

Appearance = 0 'Flat

BeginProperty Font

Name = "宋体"

Size = 12

Charset = 134

Weight = 700

Underline = 0 'False

Italic = 0 'False

Strikethrough = 0 'False

EndProperty

ForeColor = &H00800000&

Height = 375

Left = 12000

TabIndex = 6

Text = "0"

Top = 0

Width = 735

End

Begin VB.VScrollBar RAM_VScroll1

Height = 375

Left = 12720

Max = 1216

SmallChange = 32

TabIndex = 5

Top = 0

Width = 255

End

Begin VB.VScrollBar SN_VScroll

Height = 375

Left = 13950

Max = 199

TabIndex = 4

Top = 0

value = 1

Width = 255

End

Begin VB.TextBox SN_Text

Alignment = 2 'Center

Appearance = 0 'Flat

BeginProperty Font

Name = "宋体"

Size = 12

Charset = 134

Weight = 700

Underline = 0 'False

Italic = 0 'False

Strikethrough = 0 'False

EndProperty

ForeColor = &H00800000&

Height = 360

Left = 13330

TabIndex = 3

Text = "01"

Top = 0

Width = 615

End

Begin VB.ComboBox Combo1

Appearance = 0 'Flat

BeginProperty Font

Name = "宋体"

Size = 12

Charset = 134

Weight = 700

Underline = 0 'False

Italic = 0 'False

Strikethrough = 0 'False

EndProperty

ForeColor = &H00800000&

Height = 360

ItemData = "Star_M6.frx":08CA

Left = 14520

List = "Star_M6.frx":08D4

TabIndex = 2

Text = "COM1"

Top = 0

Width = 975

End

Begin MSComctlLib.StatusBar sbStatusBar

Align = 2 'Align Bottom

Height = 270

Left = 0

TabIndex = 1

Top = 9750

Width = 15615

_ExtentX = 27543

_ExtentY = 476

_Version = 393216

BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}

NumPanels = 3

BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}

AutoSize = 1

Object.Width = 21828

Text = "状态"

TextSave = "状态"

EndProperty

BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628}

Style = 6

AutoSize = 2

TextSave = "11-10-8"

EndProperty

BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628}

Style = 5

AutoSize = 2

TextSave = "8:50"

EndProperty

End

Begin MSComDlg.CommonDialog dlgCommonDialog

Left = 11280

Top = 6960

_ExtentX = 847

_ExtentY = 847

_Version = 393216

End

Begin MSComctlLib.ImageList imlToolbarIcons

Left = 11880

Top = 6960

_ExtentX = 1005

_ExtentY = 1005

BackColor = -2147483643

ImageWidth = 16

ImageHeight = 16

MaskColor = 12632256

_Version = 393216

BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}

NumListImages = 3

BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}

Picture = "Star_M6.frx":08E4

Key = "Forward1"

EndProperty

BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}

Picture = "Star_M6.frx":0ABE

Key = "Permission"

EndProperty

BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}

Picture = "Star_M6.frx":0C98

Key = "Phone"

EndProperty

End

Begin MSCommLib.MSComm MSComm1

Left = 120

Top = 600

_ExtentX = 1005

_ExtentY = 1005

_Version = 393216

DTREnable = 0 'False

InputLen = 1

OutBufferSize = 1024

RThreshold = 1

InputMode = 1

End

Begin ComctlLib.StatusBar StatusBar1

Align = 2 'Align Bottom

Height = 255

Left = 0

TabIndex = 11

Top = 9495

Width = 15615

_ExtentX = 27543

_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

TextSave = ""

Key = ""

Object.Tag = ""

EndProperty

BeginProperty Panel2 {0713E89F-850A-101B-AFC0-4210102A8DA7}

Alignment = 2

Object.Width = 1411

MinWidth = 1411

TextSave = ""

Key = ""

Object.Tag = ""

EndProperty

BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}

Name = "宋体"

Size = 9

Charset = 0

Weight = 400

Underline = 0 'False

Italic = 0 'False

Strikethrough = 0 'False

EndProperty

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 = &H0000C000&

Height = 3030

Left = 0

TabIndex = 10

Top = 430

Width = 10095

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 = &H0000C000&

Height = 1935

Left = 10200

TabIndex = 9

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 = 1110

Left = 10200

TabIndex = 8

Top = 430

Width = 5295

End

Begin VB.Menu mnu保护器设置

Caption = "保护器设置 "

Begin VB.Menu mnu保护器设置sys_set

Caption = "基本设置"

End

Begin VB.Menu mnu保护器设置mu_quit

Caption = "退出"

End

Begin VB.Menu mnucompt

Caption = "保护器参数"

End

Begin VB.Menu mnuAC_ch

Caption = "电参校验"

End

Begin VB.Menu mnuop

Caption = "启/停电机"

End

Begin VB.Menu mnuhelp

Caption = "帮助"

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

Dim jhg As Long

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

MSComm1.Output = k: tx_data.Caption = tx_data.Caption + hexbyt(Int(k(0))) + " "

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_Change()

p = Combo1.ListIndex + 1

If p > 0 And p < 3 Then Call Close_OpenPort(Int(p))

End Sub

Private Sub Command1_Click()

T_05s00.Enabled = False

MSComm1.PortOpen = False

End Sub

Private Sub Command3_Click()

MSComm1.CommPort = 1

MSComm1.Settings = "9600,n,8,1"

MSComm1.InputLen = 0

MSComm1.PortOpen = True

End Sub

Private Sub Command4_Click()

T_05s00.Enabled = True

End Sub

Private Sub Form_Load()

Call Close_OpenPort(1)

Call MakeToolbarFlat(Toolbar1)

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)

tx_REQ = 3: num_rxright = 0: num_sent = 0

StatusBar1.Panels(1).Width = 3000 '标题刷新

StatusBar1.Panels(2).Width = 3000 '标题刷新

Dim f As Integer

For f = 1 To 5

sbStatusBar.Panels.Add

Next f

End Sub

Private Sub Form_Unload(Cancel As Integer)

Dim i As Integer

'close all sub forms关闭所有窗体

For i = Forms.Count - 1 To 1 Step -1

Unload Forms(i)

If Me.WindowState <> vbMinimized Then

SaveSetting App.Title, "Settings", "MainLeft", Me.Left

SaveSetting App.Title, "Settings", "MainTop", Me.Top

SaveSetting App.Title, "Settings", "MainWidth", Me.Width

SaveSetting App.Title, "Settings", "MainHeight", Me.Height

End If

Unload controlform

Unload Comptform

Unload Factor_Seting

Unload Me

End

End Sub

Private Sub mnuAC_ch_Click()

Factor_Seting.Visible = True

tx_REQ = 3

End Sub

Private Sub mnucompt_Click()

Comptform.Visible = True

End Sub

Private Sub mnuhelp_Click()

frmAbout.Show

End Sub

Private Sub mnuop_Click()

controlform.Visible = True

End Sub

Private Sub mnu保护器设置mu_quit_Click()

Unload Me

End Sub

Private Sub mnu保护器设置sys_set_Click()

s_set.Visible = True

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

Wend

End Sub

Private Sub RAM_VScroll1_Change()

RAM_addr1th.Text = strhex(RAM_VScroll1.value)

BBB = strhex(RAM_VScroll1.value)

End Sub

Private Sub rx_data_Change()

jhg = jhg + 1

StatusBar1.Panels(2) = "通讯接收" + Str(jhg \ 8) + "次数据" '统计接收次数

End Sub

Private Sub SN_VScroll_Change()

SN_Text.Text = Str(SN_VScroll.value) '站号调整与显示

End Sub

Private Sub T_05s00_Timer()

If rx_CRC = 0 Then

Call Process

num_rxright = (num_rxright + 1) Mod 10000 '显示接收正确次数

jhg = jhg + 1

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

If AAA = "128" Then

RAM_VScroll1.value = AAA

End If

End Sub

Sub Close_OpenPort(port As Byte)

On Error Resume Next ' 改变错误处理的方式。

Err.Clear

If MSComm1.PortOpen = True Then

MSComm1.CommPort = port

MSComm1.Settings = "9600,n,8,1"

MSComm1.InputLen = 0

End If

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 + " "

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)

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)

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)

End If

End Sub

Sub Delay(ByVal msvalue As Long)

Dim EndTime As Long

EndTime = GetTickCount + msvalue

DoEvents

Loop Until GetTickCount >= EndTime

End Sub

Private Sub Timer1_Timer()

With sbStatusBar.Panels

.Item(1).Width = 1500

.Item(1).Text = "当前通讯口COM1,波特率9600bit"

.Item(2).Width = 1100

.Item(2).Text = ""

.Item(3).Width = 1100

.Item(3).Text = ""

.Item(4).Width = 1500

.Item(4).Text = Str(num_rxright)

.Item(5).Width = 3800

.Item(5).Bevel = sbrNoBevel '空白

.Item(6).Width = 1500

.Item(6).Text = Format(Date, " yyyy年mm月dd日 ")

.Item(7).Width = 800

.Item(7).Text = myweekday

.Item(8).Width = 1300

.Item(8).Text = Format(Time, "hh时mm分ss秒 ")

End With

End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)

On Error Resume Next

Select Case Button.Key

Case "打开串口"

MSComm1.CommPort = 1

MSComm1.Settings = "9600,n,8,1"

MSComm1.InputLen = 0

MSComm1.PortOpen = True

Case "关闭串口"

T_05s00.Enabled = False

MSComm1.PortOpen = False

Case "开始通讯"

T_05s00.Enabled = True

End Select

End Sub

招烘焙师十名	生日刀叉盘组	香美人皮草店	马卡龙包装盒	布丁瓶奶瓶泡茶瓶	进口食用墨水
数码蛋糕样品	绵羊皮真皮衣	麻花机油炸锅	广告位10元/月	广告位10元/月	数码蛋糕打印机

中国面包师贴吧-楼主(阅：963/回：0)VB串口程序8