VB串口通讯软件2
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 s_set
Caption = "sys_set"
ClientHeight = 5025
ClientLeft = 60
ClientTop = 450
ClientWidth = 9360
LinkTopic = "Form1"
ScaleHeight = 5025
ScaleWidth = 9360
StartUpPosition = 3 '窗口缺省
Begin VB.TextBox Text1
Alignment = 1 'Right Justify
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Index = 3
Left = 7200
TabIndex = 25
Text = "1.0"
Top = 2280
Width = 735
End
Begin VB.VScrollBar VScroll1
Height = 375
Index = 3
Left = 7920
Max = 255
Min = 1
TabIndex = 24
Top = 2280
Value = 1
Width = 255
End
Begin VB.CommandButton Command1
Caption = "确认"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 735
Left = 7080
TabIndex = 21
Top = 3720
Width = 1095
End
Begin VB.VScrollBar VScroll1
Height = 375
Index = 2
Left = 7920
Max = 255
Min = 1
TabIndex = 20
Top = 1680
Value = 10
Width = 255
End
Begin VB.VScrollBar VScroll1
Height = 375
Index = 1
Left = 7920
Max = 5
Min = 1
TabIndex = 19
Top = 1080
Value = 1
Width = 255
End
Begin VB.VScrollBar VScroll1
Height = 375
Index = 0
Left = 7920
Max = 99
Min = 1
TabIndex = 18
Top = 480
Value = 1
Width = 255
End
Begin VB.TextBox Text1
Alignment = 1 'Right Justify
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Index = 2
Left = 7200
TabIndex = 17
Text = "1.0"
Top = 1680
Width = 735
End
Begin VB.TextBox Text1
Alignment = 1 'Right Justify
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Index = 1
Left = 7200
TabIndex = 16
Text = "1"
Top = 1080
Width = 735
End
Begin VB.TextBox Text1
Alignment = 1 'Right Justify
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Index = 0
Left = 7200
TabIndex = 15
Text = "1"
Top = 480
Width = 735
End
Begin VB.ComboBox Combo1
Height = 300
Index = 5
ItemData = "sys_set.frx":0000
Left = 2760
List = "sys_set.frx":0016
TabIndex = 5
Text = "100ms"
Top = 4080
Width = 1215
End
Begin VB.ComboBox Combo1
Height = 300
Index = 4
ItemData = "sys_set.frx":0043
Left = 2760
List = "sys_set.frx":0059
TabIndex = 4
Text = "100ms"
Top = 3240
Width = 1215
End
Begin VB.ComboBox Combo1
Height = 300
Index = 3
ItemData = "sys_set.frx":0086
Left = 2760
List = "sys_set.frx":0090
TabIndex = 3
Text = "上升沿"
Top = 2520
Width = 1215
End
Begin VB.ComboBox Combo1
Height = 300
Index = 2
ItemData = "sys_set.frx":00A2
Left = 2760
List = "sys_set.frx":00B2
TabIndex = 2
Text = "保护模式"
Top = 1800
Width = 1215
End
Begin VB.ComboBox Combo1
Height = 300
Index = 1
ItemData = "sys_set.frx":00E1
Left = 2760
List = "sys_set.frx":00F1
TabIndex = 1
Text = "Ia"
Top = 1080
Width = 1215
End
Begin VB.ComboBox Combo1
Height = 300
Index = 0
ItemData = "sys_set.frx":0105
Left = 2760
List = "sys_set.frx":0112
TabIndex = 0
Text = "面板"
Top = 480
Width = 1215
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
Caption = "CT 变比"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 9
Left = 5400
TabIndex = 23
Top = 2400
Width = 1455
End
Begin VB.Label Label2
Caption = "CT变比"
Height = 15
Left = 5280
TabIndex = 22
Top = 2400
Width = 1215
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
Caption = "星-三角启动切换时间"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 8
Left = 4440
TabIndex = 14
Top = 1800
Width = 2415
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
Caption = "散热时间系数"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 7
Left = 5160
TabIndex = 13
Top = 1200
Width = 1695
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
Caption = "通信站号"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 6
Left = 5160
TabIndex = 12
Top = 600
Width = 1695
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
Caption = "启停出口方式"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 5
Left = 720
TabIndex = 11
Top = 4080
Width = 1695
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
Caption = "跳闸出口方式"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 4
Left = 720
TabIndex = 10
Top = 3240
Width = 1695
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
Caption = "接点检测方式"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 3
Left = 720
TabIndex = 9
Top = 2520
Width = 1695
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
Caption = "控制模式"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 2
Left = 720
TabIndex = 8
Top = 1800
Width = 1695
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
Caption = "模拟量输出"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 1
Left = 720
TabIndex = 7
Top = 1080
Width = 1695
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
Caption = "操作权限"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 0
Left = 720
TabIndex = 6
Top = 510
Width = 1695
End
End
Attribute VB_Name = "s_set"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim hcd(32) As Byte
Private Sub Command1_Click()
For i = 0 To 2
If Combo1(i * 2).ListIndex < 0 Then Combo1(i * 2).ListIndex = 0
If Combo1(i * 2 + 1).ListIndex < 0 Then Combo1(i * 2 + 1).ListIndex = 0
hcd(i) = (Combo1(i * 2).ListIndex + 1) * 16 + (Combo1(i * 2 + 1).ListIndex + 1)
hcd(i + 3) = VScroll1(i).Value
Next
hcd(7) = VScroll1(3).Value
hcd(10) = &H34: hcd(11) = &HDA
For i = 0 To 4
hcd(10) = hcd(10) Xor hcd(i * 2): hcd(11) = hcd(11) Xor hcd(i * 2 + 1)
Next
i = 14 * 8 + &H100
tx_b(16) = Array(&H8, &H10, i \ 256, i Mod 256, 0, &H8, &H10, Hour(Time), Minute(Time), Second(Time), 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
hcd(12) = &HFF: hcd(13) = &HFF: hcd(14) = &H12: hcd(15) = &H34
For i = 7 To 7 + 32: tx_b(16)(i) = hcd(i - 7): Next
tx_REQ = 16
End Sub
Private Sub VScroll1_Change(Index As Integer)
If Index = 2 Then
Text1(2).Text = Format(VScroll1(2).Value / 10, "0.0")
Else
Text1(Index).Text = VScroll1(Index).Value
End If
End Sub
第二段程序
第二段程序
VERSION 5.00
Begin VB.Form Comptform
BorderStyle = 1 'Fixed Single
Caption = "参数设置"
ClientHeight = 3810
ClientLeft = 45
ClientTop = 330
ClientWidth = 3120
Icon = "Compt.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3810
ScaleWidth = 3120
StartUpPosition = 3 '窗口缺省
Begin VB.CommandButton Command2
Caption = "下装"
Height = 495
Left = 1080
Picture = "Compt.frx":038A
Style = 1 'Graphical
TabIndex = 9
Top = 3120
Width = 975
End
Begin VB.TextBox Text3
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H00FFFFFF&
DataField = "定值3比例"
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 = 2
Left = 1080
TabIndex = 8
Text = "1"
Top = 2020
Width = 975
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 = &H00800000&
Height = 315
Index = 1
Left = 1080
TabIndex = 7
Text = "100"
Top = 1420
Width = 975
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 = &H00800000&
Height = 315
Index = 0
Left = 1080
TabIndex = 6
Text = "200"
Top = 820
Width = 975
End
Begin VB.ComboBox Combo3
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 300
ItemData = "Compt.frx":0714
Left = 1080
List = "Compt.frx":0745
TabIndex = 1
Text = "启动时间长保护"
Top = 220
Width = 1935
End
Begin VB.ComboBox Combo1
Appearance = 0 'Flat
BackColor = &H00FFFFFF&
DataField = "类型"
DataSource = "Data1"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 300
ItemData = "Compt.frx":0813
Left = 1080
List = "Compt.frx":0832
TabIndex = 0
Text = " 跳闸"
Top = 2620
Width = 1575
End
Begin VB.Label Label2
Caption = "保护参数"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 0
Left = 120
TabIndex = 5
Top = 260
Width = 855
End
Begin VB.Label Label2
Caption = "定 值"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 1
Left = 120
TabIndex = 4
Top = 860
Width = 855
End
Begin VB.Label Label2
Caption = "时 限"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 2
Left = 120
TabIndex = 3
Top = 1460
Width = 855
End
Begin VB.Label Label2
Caption = "参数1"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 3
Left = 120
TabIndex = 2
Top = 2060
Width = 855
End
End
Attribute VB_Name = "Comptform"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim hcd(32) As Byte
Private Sub Combo1_Click()
If Combo1.Text = "调试0mA" Then
Label2(1).Caption = "调试0mA"
Label2(2).Caption = "调试4mA"
Label2(3).Caption = "调试20mA"
ElseIf Combo1.Text = "调试4mA" Then
Label2(1).Caption = "调试0mA"
Label2(2).Caption = "调试4mA"
Label2(3).Caption = "调试20mA"
ElseIf Combo1.Text = "调试20mA" Then
Label2(1).Caption = "调试0mA"
Label2(2).Caption = "调试4mA"
Label2(3).Caption = "调试20mA"
ElseIf Combo1.Text = "0_20mA" Then
Label2(1).Caption = "调试0mA"
Label2(2).Caption = "调试4mA"
Label2(3).Caption = "调试20mA"
ElseIf Combo1.Text = "4_20mA" Then
Label2(1).Caption = "调试0mA"
Label2(2).Caption = "调试4mA"
Label2(3).Caption = "调试20mA"
Else
Label2(1).Caption = "定 值"
Label2(2).Caption = "时 限"
Label2(3).Caption = "参数1"
End If
End Sub
Private Sub Command2_Click()
Dim h As Integer
If Combo3.Text = "启动时间长保护" Then
h = 1
ElseIf Combo3.Text = "定时限过负荷保护" Then
h = 2
ElseIf Combo3.Text = "反时限过负荷保护" Then
h = 3
ElseIf Combo3.Text = "堵转保护" Then
h = 4
ElseIf Combo3.Text = "电流不平衡保护" Then
h = 5
ElseIf Combo3.Text = "接地保护" Then
h = 6
ElseIf Combo3.Text = "过热保护" Then
h = "7"
ElseIf Combo3.Text = "欠电压保护" Then
h = 8
ElseIf Combo3.Text = "过电压保护" Then
h = 9
ElseIf Combo3.Text = "欠电流保护" Then
h = 10
ElseIf Combo3.Text = "断相保护" Then
h = 11
ElseIf Combo3.Text = "电压回路断相保护" Then
h = 12
ElseIf Combo3.Text = "欠压重启动功能" Then
h = 13
ElseIf Combo3.Text = "TE时间保护" Then
h = 14
ElseIf Combo3.Text = "变送值设定" Then
h = 15
End If
If Combo1.ListIndex < 0 Then Combo1.ListIndex = 1
hcd(6) = &HFF: hcd(7) = &HFF: hcd(8) = &H66: hcd(9) = &H66
hcd(12) = &HFF: hcd(13) = &HFF: hcd(14) = &H12: hcd(15) = &H34
If Combo1.ListIndex = 1 Then
hcd(8) = &HA5
hcd(9) = &H5A
ElseIf Combo1.ListIndex = 2 Then
hcd(8) = &H5A
hcd(9) = &HA5
ElseIf Combo1.ListIndex = 4 Then
hcd(6) = &H0
hcd(7) = &H1
ElseIf Combo1.ListIndex = 5 Then
hcd(6) = &H0
hcd(7) = &H2
ElseIf Combo1.ListIndex = 6 Then
hcd(6) = &H0
hcd(7) = &H3
ElseIf Combo1.ListIndex = 7 Then
hcd(6) = &H0
hcd(7) = &H55
ElseIf Combo1.ListIndex = 8 Then
hcd(6) = &H0
hcd(7) = &HAA
End If
For i = 0 To 2
temp = Val(Text3(i).Text)
hcd(i * 2) = temp \ 256
hcd(i * 2 + 1) = temp Mod 256 'para0-2
Next
hcd(10) = &H34
hcd(11) = &HDA
For i = 0 To 4
hcd(10) = hcd(10) Xor hcd(i * 2)
hcd(11) = hcd(11) Xor hcd(i * 2 + 1)
Next
If h = 15 Then
i = (Val(h) + 1) * 8 + &H100
Else
i = (Val(h) - 1) * 8 + &H100
End If
tx_b(16) = Array(&H8, &H10, i \ 256, i Mod 256, 0, &H8, &H10, Hour(Time), Minute(Time), Second(Time), 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
For i = 7 To 7 + 32
tx_b(16)(i) = hcd(i - 7)
Next
tx_REQ = 16
End Sub
VERSION 5.00
Begin VB.Form controlform
BorderStyle = 1 'Fixed Single
Caption = "操作电机"
ClientHeight = 1995
ClientLeft = 45
ClientTop = 330
ClientWidth = 5430
Icon = "controlform.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 1995
ScaleWidth = 5430
StartUpPosition = 3 '窗口缺省
Begin VB.CommandButton J_ctrl
Caption = "校时"
Height = 615
Index = 5
Left = 3960
Picture = "controlform.frx":08CA
Style = 1 'Graphical
TabIndex = 5
Top = 1200
Width = 975
End
Begin VB.CommandButton J_ctrl
Caption = "清除电度"
Height = 615
Index = 4
Left = 2280
Picture = "controlform.frx":0C54
Style = 1 'Graphical
TabIndex = 4
Top = 1200
Width = 975
End
Begin VB.CommandButton J_ctrl
Caption = "复归"
Height = 615
Index = 3
Left = 480
Picture = "controlform.frx":1A96
Style = 1 'Graphical
TabIndex = 3
Top = 1200
Width = 975
End
Begin VB.CommandButton J_ctrl
Caption = "停车"
Height = 615
Index = 2
Left = 3960
Picture = "controlform.frx":1E20
Style = 1 'Graphical
TabIndex = 2
Top = 240
Width = 975
End
Begin VB.CommandButton J_ctrl
Caption = "启动B"
Height = 615
Index = 1
Left = 2280
Picture = "controlform.frx":21AA
Style = 1 'Graphical
TabIndex = 1
Top = 240
Width = 975
End
Begin VB.CommandButton J_ctrl
Caption = "启动A"
Height = 615
Index = 0
Left = 480
Picture = "controlform.frx":2534
Style = 1 'Graphical
TabIndex = 0
Top = 240
Width = 975
End
End
Attribute VB_Name = "controlform"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub J_ctrl_Click(Index As Integer)
If Index < 5 Then '继电器
tx_b(16) = Array(0, 0, &H0, &HD2, &H0, &H1, &H2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
tx_b(16)(7) = (Index + 1) * 17
tx_b(16)(8) = (Index + 1) * 17
' tx_b(16)(14 + 8) = 40
Else '校时
ts = d_BCD(Second(Time)): tm = d_BCD(Minute(Time)): th = d_BCD(Hour(Time))
dd = d_BCD(Day(Date)): dM = d_BCD(Month(Date)): dY = d_BCD(Year(Date) Mod 100)
tx_b(16) = Array(0, 0, &H0, &HD8, &H0, &H4, &H8, dY, dM, dd, th, tm, ts, &H12, &H34, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
End If
tx_REQ = 16 '0x10 命令
End Sub
VERSION 5.00
Begin VB.Form Factor_Seting
Appearance = 0 'Flat
BorderStyle = 3 'Fixed Dialog
Caption = "通道校正系数"
ClientHeight = 2400
ClientLeft = 1980
ClientTop = 4365
ClientWidth = 11895
BeginProperty Font
Name = "System"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
Picture = "Factor_seting.frx":0000
ScaleHeight = 2400
ScaleWidth = 11895
Begin VB.CommandButton Command1
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 0
Left = 9840
Picture = "Factor_seting.frx":0342
Style = 1 'Graphical
TabIndex = 1
Top = 600
Width = 375
End
Begin VB.TextBox Text0
Alignment = 2 'Center
Height = 360
Index = 7
Left = 5880
TabIndex = 42
Text = "0.0"
Top = 1200
Width = 735
End
Begin VB.TextBox Text0
Alignment = 2 'Center
Height = 360
Index = 6
Left = 5880
TabIndex = 41
Text = "0.0"
Top = 720
Width = 735
End
Begin VB.TextBox Text0
Alignment = 2 'Center
Height = 360
Index = 5
Left = 5880
TabIndex = 40
Text = "0.0"
Top = 240
Width = 735
End
Begin VB.TextBox Text0
Alignment = 2 'Center
Height = 360
Index = 4
Left = 1080
TabIndex = 39
Text = "0.0"
Top = 240
Width = 735
End
Begin VB.TextBox Text0
Alignment = 2 'Center
Height = 360
Index = 3
Left = 1080
TabIndex = 38
Text = "0.0"
Top = 720
Width = 735
End
Begin VB.TextBox Text0
Alignment = 2 'Center
Height = 360
Index = 2
Left = 1080
TabIndex = 37
Text = "0.0"
Top = 1200
Width = 735
End
Begin VB.TextBox Text0
Alignment = 2 'Center
Height = 360
Index = 1
Left = 1080
TabIndex = 36
Text = "0.0"
Top = 1680
Width = 735
End
Begin VB.CheckBox Check0
Caption = "Check1"
Height = 225
Index = 7
Left = 5520
TabIndex = 35
Top = 1320
Width = 255
End
Begin VB.CheckBox Check0
Caption = "Check1"
Height = 225
Index = 6
Left = 5520
TabIndex = 34
Top = 840
Width = 255
End
Begin VB.CheckBox Check0
Caption = "Check1"
Height = 225
Index = 5
Left = 5520
TabIndex = 33
Top = 360
Width = 255
End
Begin VB.CheckBox Check0
Caption = "Check1"
Height = 225
Index = 4
Left = 720
TabIndex = 32
Top = 360
Width = 255
End
Begin VB.CheckBox Check0
Caption = "Check1"
Height = 225
Index = 3
Left = 720
TabIndex = 31
Top = 840
Width = 255
End
Begin VB.CheckBox Check0
Caption = "Check1"
Height = 255
Index = 2
Left = 720
TabIndex = 30
Top = 1320
Width = 255
End
Begin VB.CheckBox Check0
Caption = "Check1"
Height = 225
Index = 1
Left = 720
TabIndex = 29
Top = 1800
Width = 255
End
Begin VB.CheckBox Check0
Caption = "Check1"
Height = 225
Index = 0
Left = 5520
TabIndex = 28
Top = 1800
Width = 255
End
Begin VB.TextBox Text0
Alignment = 2 'Center
Height = 360
Index = 0
Left = 5880
TabIndex = 27
Text = "0.0"
Top = 1680
Width = 735
End
Begin VB.CommandButton command3
Caption = "计算"
Height = 495
Left = 10080
TabIndex = 26
Top = 1560
Width = 855
End
Begin VB.VScrollBar VScroll1
Height = 345
Index = 7
Left = 9240
Max = 127
Min = -127
TabIndex = 25
Top = 1200
Width = 255
End
Begin VB.VScrollBar VScroll1
Height = 345
Index = 6
Left = 9240
Max = 127
Min = -127
TabIndex = 24
Top = 720
Width = 255
End
Begin VB.VScrollBar VScroll1
Height = 345
Index = 5
Left = 9240
Max = 127
Min = -127
TabIndex = 23
Top = 240
Width = 255
End
Begin VB.VScrollBar VScroll1
Height = 345
Index = 4
Left = 4440
Max = 127
Min = -127
TabIndex = 22
Top = 240
Width = 255
End
Begin VB.VScrollBar VScroll1
Height = 345
Index = 3
Left = 4440
Max = 127
Min = -127
TabIndex = 21
Top = 720
Width = 255
End
Begin VB.VScrollBar VScroll1
Height = 345
Index = 2
Left = 4440
Max = 127
Min = -127
TabIndex = 20
Top = 1200
Width = 255
End
Begin VB.VScrollBar VScroll1
Height = 345
Index = 1
Left = 4440
Max = 127
Min = -127
TabIndex = 19
Top = 1680
Width = 255
End
Begin VB.CommandButton Command2
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 0
Left = 10560
Picture = "Factor_seting.frx":06CC
Style = 1 'Graphical
TabIndex = 2
Top = 600
Width = 375
End
Begin VB.VScrollBar VScroll1
Height = 345
Index = 0
Left = 9240
Max = 127
Min = -127
TabIndex = 0
Top = 1680
Width = 255
End
Begin VB.Label Label9
Caption = "Ua"
Height = 255
Left = 360
TabIndex = 58
Top = 360
Width = 405
End
Begin VB.Label Label13
Caption = "Ipa"
Height = 255
Left = 5160
TabIndex = 57
Top = 360
Width = 405
End
Begin VB.Label Label12
Caption = "Ub"
Height = 255
Left = 360
TabIndex = 56
Top = 840
Width = 405
End
Begin VB.Label Label11
Caption = "Ia"
Height = 255
Left = 360
TabIndex = 55
Top = 1800
Width = 405
End
Begin VB.Label Label10
Caption = "Ipb"
Height = 255
Left = 5160
TabIndex = 54
Top = 840
Width = 405
End
Begin VB.Label Label8
Caption = "Uc"
Height = 255
Left = 360
TabIndex = 53
Top = 1320
Width = 405
End
Begin VB.Label Label7
Caption = "Ic"
Height = 255
Left = 5160
TabIndex = 52
Top = 1800
Width = 405
End
Begin VB.Label Label4
Caption = "Ipc"
Height = 255
Left = 5160
TabIndex = 51
Top = 1320
Width = 405
End
Begin VB.Label Label2
Alignment = 2 'Center
BackColor = &H80000005&
Caption = "0.0"
Height = 330
Index = 7
Left = 7800
TabIndex = 50
Top = 1200
Width = 615
End
Begin VB.Label Label2
Alignment = 2 'Center
BackColor = &H80000005&
Caption = "0.0"
Height = 330
Index = 6
Left = 7800
TabIndex = 49
Top = 720
Width = 615
End
Begin VB.Label Label2
Alignment = 2 'Center
BackColor = &H80000005&
Caption = "0.0"
Height = 330
Index = 5
Left = 7800
TabIndex = 48
Top = 240
Width = 615
End
Begin VB.Label Label2
Alignment = 2 'Center
BackColor = &H80000005&
Caption = "0.0"
Height = 330
Index = 4
Left = 3000
TabIndex = 47
Top = 240
Width = 615
End
Begin VB.Label Label2
Alignment = 2 'Center
BackColor = &H80000005&
Caption = "0.0"
Height = 330
Index = 3
Left = 3000
TabIndex = 46
Top = 720
Width = 615
End
Begin VB.Label Label2
Alignment = 2 'Center
BackColor = &H80000005&
Caption = "0.0"
Height = 330
Index = 2
Left = 3000
TabIndex = 45
Top = 1200
Width = 615
End
Begin VB.Label Label2
Alignment = 2 'Center
BackColor = &H80000005&
Caption = "0.0"
Height = 330
Index = 1
Left = 3000
TabIndex = 44
Top = 1680
Width = 615
End
Begin VB.Label Label2
Alignment = 2 'Center
BackColor = &H80000005&
Caption = "0.0"
Height = 330
Index = 0
Left = 7800
TabIndex = 43
Top = 1680
Width = 615
End
Begin VB.Label Factor_label
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
Caption = "0.0 "
ForeColor = &H00800000&
Height = 330
Index = 7
Left = 8640
TabIndex = 18
Top = 1200
Width = 615
End
Begin VB.Label Factor_label
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
Caption = "0.0 "
ForeColor = &H00800000&
Height = 330
Index = 6
Left = 8640
TabIndex = 17
Top = 720
Width = 615
End
Begin VB.Label Factor_label
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
Caption = "0.0 "
ForeColor = &H00800000&
Height = 330
Index = 5
Left = 8640
TabIndex = 16
Top = 240
Width = 615
End
Begin VB.Label Factor_label
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
Caption = "0.0 "
ForeColor = &H00800000&
Height = 330
Index = 4
Left = 3840
TabIndex = 15
Top = 240
Width = 615
End
Begin VB.Label Factor_label
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
Caption = "0.0 "
ForeColor = &H00800000&
Height = 330
Index = 3
Left = 3840
TabIndex = 14
Top = 720
Width = 615
End
Begin VB.Label Factor_label
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
Caption = "0.0 "
ForeColor = &H00800000&
Height = 330
Index = 2
Left = 3840
TabIndex = 13
Top = 1200
Width = 615
End
Begin VB.Label Factor_label
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
Caption = "0.0 "
ForeColor = &H00800000&
Height = 330
Index = 1
Left = 3840
TabIndex = 12
Top = 1680
Width = 615
End
Begin VB.Label Factor_label
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
Caption = "0.0 "
ForeColor = &H00800000&
Height = 330
Index = 0
Left = 8640
TabIndex = 11
Top = 1680
Width = 615
End
Begin VB.Label AC_data
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H00404000&
BorderStyle = 1 'Fixed Single
Caption = "000.00 "
ForeColor = &H0000FFFF&
Height = 315
Index = 7
Left = 6720
TabIndex = 10
Top = 1200
Width = 855
End
Begin VB.Label AC_data
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H00404000&
BorderStyle = 1 'Fixed Single
Caption = "000.00 "
ForeColor = &H0000FFFF&
Height = 315
Index = 6
Left = 6720
TabIndex = 9
Top = 720
Width = 855
End
Begin VB.Label AC_data
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H00404000&
BorderStyle = 1 'Fixed Single
Caption = "000.00 "
ForeColor = &H0000FFFF&
Height = 315
Index = 5
Left = 6720
TabIndex = 8
Top = 240
Width = 855
End
Begin VB.Label AC_data
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H00404000&
BorderStyle = 1 'Fixed Single
Caption = "000.00 "
ForeColor = &H0000FFFF&
Height = 315
Index = 4
Left = 1920
TabIndex = 7
Top = 240
Width = 855
End
Begin VB.Label AC_data
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H00404000&
BorderStyle = 1 'Fixed Single
Caption = "000.00 "
ForeColor = &H0000FFFF&
Height = 315
Index = 3
Left = 1920
TabIndex = 6
Top = 720
Width = 855
End
Begin VB.Label AC_data
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H00404000&
BorderStyle = 1 'Fixed Single
Caption = "000.00 "
ForeColor = &H0000FFFF&
Height = 315
Index = 2
Left = 1920
TabIndex = 5
Top = 1200
Width = 855
End
Begin VB.Label AC_data
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H00404000&
BorderStyle = 1 'Fixed Single
Caption = "000.00 "
ForeColor = &H0000FFFF&
Height = 315
Index = 1
Left = 1920
TabIndex = 4
Top = 1680
Width = 855
End
Begin VB.Label AC_data
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H00404000&
BorderStyle = 1 'Fixed Single
Caption = "000.00 "
ForeColor = &H0000FFFF&
Height = 315
Index = 0
Left = 6720
TabIndex = 3
Top = 1680
Width = 855
End
End
Attribute VB_Name = "Factor_Seting"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub Command1_Click(Index As Integer)
Dim i, x As Single
tx_b(4) = Array(&HF0, 3, &H4, &HC0, &H0, &H40, 0, 0, Hour(Time), Minute(Time), Second(Time), 0, 0, 0, 0)
tx_REQ = 4
End Sub
Private Sub Command2_Click(Index As Integer)
Dim i, sumL, sumH As Integer
tx_b(4) = Array(&H68, 28, 28, &H68, &H40, 0, 4, Hour(Time), Minute(Time), Second(Time), 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
sumL = 0
sumH = 0
For i = 0 To 7
tx_b(4)(i + 8) = -VScroll1(Index * 8 + i).Value
If i Mod 2 = 0 Then
sumL = sumL Xor tx_b(4)(i + 8)
Else
sumH = sumH Xor tx_b(4)(i + 8)
End If
Next
tx_b(4)(20) = 0 'ID
tx_b(4)(21) = &HFF
sumL = sumL Xor tx_b(4)(20)
sumH = sumH Xor tx_b(4)(21)
tx_b(4)(22) = 0
tx_b(4)(23) = &H9A 'switch
sumL = sumL Xor tx_b(4)(22)
sumH = sumH Xor tx_b(4)(23)
tx_b(4)(24) = 255 - Abs(tx_b(4)(8)) 'para1 bk
tx_b(4)(25) = 255 - Abs(tx_b(4)(9))
tx_b(4)(26) = sumL Xor tx_b(4)(24)
tx_b(4)(27) = sumH Xor tx_b(4)(25)
tx_REQ = 4
End Sub
Private Sub Command3_Click()
Dim i As Integer
For i = 0 To 7
If Check0(i).Value = 1 Then
Label2(i).Caption = Format(((Text0(i).Text - AC_data(i).Caption) / AC_data(i).Caption * 100), "0.0")
VScroll1(i).Value = -Label2(i).Caption * 10 + VScroll1(i).Value
End If
Next i
Command2_Click (0)
End Sub
Private Sub Command4_Click()
Factor_Seting.Hide
End Sub
Private Sub Form_Load()
Dim i As Integer, KeyName As String
For i = 0 To 7
KeyName = "Text0(" & i & ")" & ".Text"
Text0(i).Text = GetSetting(App.Title, Me.Name, KeyName, "0.00") '读取设置
Next i
tx_b(3) = Array(&H68, 4, 4, &H68, &H40, 0, 3, 11, 7, 7)
' End If
tx_REQ = 3
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim i As Integer, KeyName As String
For i = 0 To 7
KeyName = "Text0(" & i & ")" & ".Text"
Call SaveSetting(App.Title, Me.Name, KeyName, Me.Text0(i).Text) '存储设置
Next i
End Sub
Private Sub VScroll1_Change(Index As Integer)
Factor_label(Index).Caption = Format(-VScroll1(Index).Value / 10, " 0.0")
End Sub
'3号命令－上传系数定值 group10-12
Private Sub VScroll2_Change(Index As Integer)
Dim x As Single
x = VScroll2(Index).Value: x = x / 10: Text0(Index).Text = Format(x, "#0.0 ")
End Sub
VERSION 5.00
Begin VB.Form Factor_Seting
Appearance = 0 'Flat
BorderStyle = 1 'Fixed Single
Caption = "电力系数校正"
ClientHeight = 3270
ClientLeft = 1980
ClientTop = 4365
ClientWidth = 11385
BeginProperty Font
Name = "System"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "Factor_seting_bk.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
Picture = "Factor_seting_bk.frx":038A
ScaleHeight = 3270
ScaleWidth = 11385
Begin VB.CommandButton Command3
Caption = "计算"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 9960
Picture = "Factor_seting_bk.frx":06CC
Style = 1 'Graphical
TabIndex = 74
Top = 1920
Width = 975
End
Begin VB.VScrollBar VScroll1
Height = 345
Index = 15
Left = 2160
Max = 256
Min = -127
TabIndex = 65
Top = 5160
Value = 256
Width = 255
End
Begin VB.VScrollBar VScroll1
Height = 345
Index = 14
Left = 1920
Max = 256
Min = -127
TabIndex = 1
Top = 5160
Value = 87
Width = 255
End
Begin VB.VScrollBar VScroll1
Height = 345
Index = 13
Left = 1680
Max = 256
Min = -127
TabIndex = 64
Top = 5160
Value = 256
Width = 255
End
Begin VB.VScrollBar VScroll1
Height = 345
Index = 12
Left = 1440
Max = 127
Min = -127
TabIndex = 63
Top = 5160
Value = 1
Width = 255
End
Begin VB.VScrollBar VScroll1
Height = 345
Index = 11
Left = 1200
Max = 127
Min = -127
TabIndex = 62
Top = 5160
Value = 1
Width = 255
End
Begin VB.VScrollBar VScroll1
Height = 345
Index = 10
Left = 960
Max = 127
Min = -127
TabIndex = 61
Top = 5160
Value = 1
Width = 255
End
Begin VB.VScrollBar VScroll1
Height = 345
Index = 9
Left = 720
Max = 127
Min = -127
TabIndex = 60
Top = 5160
Value = 1
Width = 255
End
Begin VB.VScrollBar VScroll1
Height = 345
Index = 8
Left = 480
Max = 127
Min = -127
TabIndex = 59
Top = 5160
Value = 1
Width = 255
End
Begin VB.CommandButton Command1
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 0
Left = 9840
Picture = "Factor_seting_bk.frx":0A56
Style = 1 'Graphical
TabIndex = 2
Top = 1200
Width = 375
End
Begin VB.TextBox Text0
Alignment = 2 'Center
Height = 360
Index = 7
Left = 5880
TabIndex = 42
Text = "0.0"
Top = 2640
Width = 735
End
Begin VB.TextBox Text0
Alignment = 2 'Center
Height = 360
Index = 6
Left = 960
TabIndex = 41
Text = "0.0"
Top = 4080
Width = 735
End
Begin VB.TextBox Text0
Alignment = 2 'Center
Height = 360
Index = 5
Left = 5880
TabIndex = 40
Text = "0.0"
Top = 1440
Width = 735
End
Begin VB.TextBox Text0
Alignment = 2 'Center
Height = 360
Index = 4
Left = 5880
TabIndex = 39
Text = "0.0"
Top = 2040
Width = 735
End
Begin VB.TextBox Text0
Alignment = 2 'Center
Height = 360
Index = 3
Left = 1080
TabIndex = 38
Text = "0.0"
Top = 2040
Width = 735
End
Begin VB.TextBox Text0
Alignment = 2 'Center
Height = 360
Index = 2
Left = 5880
TabIndex = 37
Text = "0.0"
Top = 840
Width = 735
End
Begin VB.TextBox Text0
Alignment = 2 'Center
Height = 360
Index = 1
Left = 1080
TabIndex = 36
Text = "0.0"
Top = 840
Width = 735
End
Begin VB.CheckBox Check0
Caption = "Check1"
Height = 225
Index = 7
Left = 5520
TabIndex = 35
Top = 2760
Width = 255
End
Begin VB.CheckBox Check0
Caption = "Check1"
Height = 225
Index = 6
Left = 600
TabIndex = 34
Top = 4200
Width = 255
End
Begin VB.CheckBox Check0
Caption = "Check1"
Height = 225
Index = 5
Left = 5520
TabIndex = 33
Top = 1560
Width = 255
End
Begin VB.CheckBox Check0
Caption = "Check1"
Height = 225
Index = 4
Left = 5520
TabIndex = 32
Top = 2160
Width = 255
End
Begin VB.CheckBox Check0
Caption = "Check1"
Height = 225
Index = 3
Left = 720
TabIndex = 31
Top = 2160
Width = 255
End
Begin VB.CheckBox Check0
Caption = "Check1"
Height = 255
Index = 2
Left = 5520
TabIndex = 30
Top = 960
Width = 255
End
Begin VB.CheckBox Check0
Caption = "Check1"
Height = 225
Index = 1
Left = 720
TabIndex = 29
Top = 960
Width = 255
End
Begin VB.CheckBox Check0
Caption = "Check1"
Height = 225
Index = 0
Left = 720
TabIndex = 28
Top = 1560
Width = 255
End
Begin VB.TextBox Text0
Alignment = 2 'Center
Height = 360
Index = 0
Left = 1080
TabIndex = 27
Text = "0.0"
Top = 1440
Width = 735
End
Begin VB.VScrollBar VScroll1
Height = 345
Index = 7
Left = 9240
Max = 127
Min = -127
TabIndex = 26
Top = 2640
Width = 255
End
Begin VB.VScrollBar VScroll1
Height = 345
Index = 6
Left = 4320
Max = 127
Min = -127
TabIndex = 25
Top = 4080
Width = 255
End
Begin VB.VScrollBar VScroll1
Height = 345
Index = 5
Left = 9240
Max = 127
Min = -127
TabIndex = 24
Top = 1440
Width = 255
End
Begin VB.VScrollBar VScroll1
Height = 345
Index = 4
Left = 9240
Max = 127
Min = -127
TabIndex = 23
Top = 2040
Width = 255
End
Begin VB.VScrollBar VScroll1
Height = 345
Index = 3
Left = 4440
Max = 127
Min = -127
TabIndex = 22
Top = 2040
Width = 255
End
Begin VB.VScrollBar VScroll1
Height = 345
Index = 2
Left = 9240
Max = 127
Min = -127
TabIndex = 21
Top = 840
Width = 255
End
Begin VB.VScrollBar VScroll1
Height = 345
Index = 1
Left = 4440
Max = 127
Min = -127
TabIndex = 20
Top = 840
Width = 255
End
Begin VB.CommandButton Command2
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 0
Left = 10560
Picture = "Factor_seting_bk.frx":0DE0
Style = 1 'Graphical
TabIndex = 3
Top = 1200
Width = 375
End
Begin VB.VScrollBar VScroll1
Height = 345
Index = 0
Left = 4440
Max = 127
Min = -127
TabIndex = 0
Top = 1440
Width = 255
End
Begin VB.Label Label1
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "校正系数"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 7
Left = 8640
TabIndex = 73
Top = 360
Width = 975
End
Begin VB.Label Label1
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "推荐系数"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 6
Left = 7680
TabIndex = 72
Top = 360
Width = 855
End
Begin VB.Label Label1
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "实测值"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 5
Left = 6720
TabIndex = 71
Top = 360
Width = 735
End
Begin VB.Label Label1
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "标准值"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 4
Left = 5880
TabIndex = 70
Top = 360
Width = 735
End
Begin VB.Label Label1
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "校正系数"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 3
Left = 3840
TabIndex = 69
Top = 360
Width = 975
End
Begin VB.Label Label1
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "推荐系数"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 2
Left = 2880
TabIndex = 68
Top = 360
Width = 855
End
Begin VB.Label Label1
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "实测值"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 1
Left = 1920
TabIndex = 67
Top = 360
Width = 735
End
Begin VB.Label Label1
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "标准值"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 0
Left = 1080
TabIndex = 66
Top = 360
Width = 735
End
Begin VB.Label Label9
Caption = "Ib"
Height = 255
Left = 360
TabIndex = 58
Top = 1560
Width = 405
End
Begin VB.Label Label13
Caption = "Ia"
Height = 255
Left = 360
TabIndex = 57
Top = 960
Width = 405
End
Begin VB.Label Label12
Caption = "Uab"
Height = 255
Left = 5040
TabIndex = 56
Top = 960
Width = 405
End
Begin VB.Label Label11
Caption = "U0"
Height = 255
Left = 240
TabIndex = 55
Top = 4200
Width = 405
End
Begin VB.Label Label10
Caption = "Ic"
Height = 255
Left = 360
TabIndex = 54
Top = 2160
Width = 405
End
Begin VB.Label Label8
Caption = "Ija"
Height = 255
Left = 5040
TabIndex = 53
Top = 2160
Width = 405
End
Begin VB.Label Label7
Caption = "Ijc"
Height = 255
Left = 5040
TabIndex = 52
Top = 2760
Width = 405
End
Begin VB.Label Label4
Caption = "Ubc"
Height = 255
Left = 5040
TabIndex = 51
Top = 1560
Width = 405
End
Begin VB.Label Label2
Alignment = 2 'Center
BackColor = &H80000005&
Caption = "0.0"
Height = 330
Index = 7
Left = 7800
TabIndex = 50
Top = 2640
Width = 615
End
Begin VB.Label Label2
Alignment = 2 'Center
BackColor = &H80000005&
Caption = "0.0"
Height = 330
Index = 6
Left = 2880
TabIndex = 49
Top = 4080
Width = 615
End
Begin VB.Label Label2
Alignment = 2 'Center
BackColor = &H80000005&
Caption = "0.0"
Height = 330
Index = 5
Left = 7800
TabIndex = 48
Top = 1440
Width = 615
End
Begin VB.Label Label2
Alignment = 2 'Center
BackColor = &H80000005&
Caption = "0.0"
Height = 330
Index = 4
Left = 7800
TabIndex = 47
Top = 2040
Width = 615
End
Begin VB.Label Label2
Alignment = 2 'Center
BackColor = &H80000005&
Caption = "0.0"
Height = 330
Index = 3
Left = 3000
TabIndex = 46
Top = 2040
Width = 615
End
Begin VB.Label Label2
Alignment = 2 'Center
BackColor = &H80000005&
Caption = "0.0"
Height = 330
Index = 2
Left = 7800
TabIndex = 45
Top = 840
Width = 615
End
Begin VB.Label Label2
Alignment = 2 'Center
BackColor = &H80000005&
Caption = "0.0"
Height = 330
Index = 1
Left = 3000
TabIndex = 44
Top = 840
Width = 615
End
Begin VB.Label Label2
Alignment = 2 'Center
BackColor = &H80000005&
Caption = "0.0"
Height = 330
Index = 0
Left = 3000
TabIndex = 43
Top = 1440
Width = 615
End
Begin VB.Label Factor_label
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
Caption = "0.0 "
ForeColor = &H00800000&
Height = 330
Index = 7
Left = 8640
TabIndex = 19
Top = 2640
Width = 615
End
Begin VB.Label Factor_label
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
Caption = "0.0 "
ForeColor = &H00800000&
Height = 330
Index = 6
Left = 3720
TabIndex = 18
Top = 4080
Width = 615
End
Begin VB.Label Factor_label
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
Caption = "0.0 "
ForeColor = &H00800000&
Height = 330
Index = 5
Left = 8640
TabIndex = 17
Top = 1440
Width = 615
End
Begin VB.Label Factor_label
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
Caption = "0.0 "
ForeColor = &H00800000&
Height = 330
Index = 4
Left = 8640
TabIndex = 16
Top = 2040
Width = 615
End
Begin VB.Label Factor_label
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
Caption = "0.0 "
ForeColor = &H00800000&
Height = 330
Index = 3
Left = 3840
TabIndex = 15
Top = 2040
Width = 615
End
Begin VB.Label Factor_label
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
Caption = "0.0 "
ForeColor = &H00800000&
Height = 330
Index = 2
Left = 8640
TabIndex = 14
Top = 840
Width = 615
End
Begin VB.Label Factor_label
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
Caption = "0.0 "
ForeColor = &H00800000&
Height = 330
Index = 1
Left = 3840
TabIndex = 13
Top = 840
Width = 615
End
Begin VB.Label Factor_label
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
Caption = "0.0 "
ForeColor = &H00800000&
Height = 330
Index = 0
Left = 3840
TabIndex = 12
Top = 1440
Width = 615
End
Begin VB.Label AC_data
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H00404000&
BorderStyle = 1 'Fixed Single
Caption = "000.00 "
ForeColor = &H0000FFFF&
Height = 315
Index = 7
Left = 6720
TabIndex = 11
Top = 2640
Width = 855
End
Begin VB.Label AC_data
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H00404000&
BorderStyle = 1 'Fixed Single
Caption = "000.00 "
ForeColor = &H0000FFFF&
Height = 315
Index = 6
Left = 1800
TabIndex = 10
Top = 4080
Width = 855
End
Begin VB.Label AC_data
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H00404000&
BorderStyle = 1 'Fixed Single
Caption = "000.00 "
ForeColor = &H0000FFFF&
Height = 315
Index = 5
Left = 6720
TabIndex = 9
Top = 1440
Width = 855
End
Begin VB.Label AC_data
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H00404000&
BorderStyle = 1 'Fixed Single
Caption = "000.00 "
ForeColor = &H0000FFFF&
Height = 315
Index = 4
Left = 6720
TabIndex = 8
Top = 2040
Width = 855
End
Begin VB.Label AC_data
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H00404000&
BorderStyle = 1 'Fixed Single
Caption = "000.00 "
ForeColor = &H0000FFFF&
Height = 315
Index = 3
Left = 1920
TabIndex = 7
Top = 2040
Width = 855
End
Begin VB.Label AC_data
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H00404000&
BorderStyle = 1 'Fixed Single
Caption = "000.00 "
ForeColor = &H0000FFFF&
Height = 315
Index = 2
Left = 6720
TabIndex = 6
Top = 840
Width = 855
End
Begin VB.Label AC_data
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H00404000&
BorderStyle = 1 'Fixed Single
Caption = "000.00 "
ForeColor = &H0000FFFF&
Height = 315
Index = 1
Left = 1920
TabIndex = 5
Top = 840
Width = 855
End
Begin VB.Label AC_data
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H00404000&
BorderStyle = 1 'Fixed Single
Caption = "000.00 "
ForeColor = &H0000FFFF&
Height = 315
Index = 0
Left = 1920
TabIndex = 4
Top = 1440
Width = 855
End
End
Attribute VB_Name = "Factor_Seting"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim hcd(32) As Integer
Option Explicit
Private Sub Check0_Click(Index As Integer)
If Check0(1).Value = 1 Then
AAA = "128"
ElseIf Check0(0).Value = 1 Then
AAA = "128"
ElseIf Check0(3).Value = 1 Then
AAA = "128"
ElseIf Check0(2).Value = 1 Then
AAA = "128"
ElseIf Check0(5).Value = 1 Then
AAA = "128"
ElseIf Check0(4).Value = 1 Then
AAA = "128"
ElseIf Check0(7).Value = 1 Then
AAA = "128"
Else
AAA = BBB
End If
End Sub
Private Sub Command1_Click(Index As Integer)
tx_b(4) = Array(&HF0, 3, &H1, &H78, &H0, &H40, 0, 0, Hour(Time), Minute(Time), Second(Time), 0, 0, 0, 0)
tx_REQ = 4
End Sub
Private Sub Command2_Click(Index As Integer)
Dim i, sumH, sumL As Integer
tx_b(16) = Array(&H8, &H10, &H1, &H78, 0, &H8, &H10, Hour(Time), Minute(Time), Second(Time), 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
For i = 0 To 7
hcd(i) = -VScroll1(i).Value
Next
hcd(10) = &H34: hcd(11) = &HDA
For i = 0 To 4
hcd(10) = hcd(10) Xor hcd(i * 2): hcd(11) = hcd(11) Xor hcd(i * 2 + 1)
Next
hcd(12) = &HFF: hcd(13) = &HFF: hcd(14) = &H12: hcd(15) = &H34
For i = 7 To 7 + 32: tx_b(16)(i) = hcd(i - 7): Next
tx_REQ = 16
End Sub
Private Sub Command3_Click()
Dim i As Integer
For i = 0 To 7
If Check0(i).Value = 1 And AC_data(i).Caption <> 0 Then
Label2(i).Caption = Format(((Text0(i).Text - AC_data(i).Caption) / AC_data(i).Caption * 100), "0.0")
' If Abs(Val(Label2(i).Caption)) < 12 Then VScroll1(i).Value = -Val(Label2(i).Caption) * 10 + VScroll1(i).Value
End If
Next i
End Sub
Private Sub VScroll1_Change(Index As Integer)
Factor_label(Index).Caption = Format(-VScroll1(Index).Value / 10, " 0.0")
End Sub
VERSION 5.00
Begin VB.Form frmAbout
BorderStyle = 3 'Fixed Dialog
Caption = "电动机保护器调试软件"
ClientHeight = 3555
ClientLeft = 2340
ClientTop = 1935
ClientWidth = 5730
ClipControls = 0 'False
Icon = "frmAbout.frx":0000
LinkTopic = "Form2"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 2453.724
ScaleMode = 0 'User
ScaleWidth = 5380.766
ShowInTaskbar = 0 'False
Begin VB.PictureBox picIcon
AutoSize = -1 'True
ClipControls = 0 'False
Height = 540
Left = 240
Picture = "frmAbout.frx":08CA
ScaleHeight = 337.12
ScaleMode = 0 'User
ScaleWidth = 337.12
TabIndex = 1
Top = 240
Width = 540
End
Begin VB.CommandButton cmdOK
Cancel = -1 'True
Caption = "确定"
Default = -1 'True
Height = 345
Left = 4125
TabIndex = 0
Top = 2625
Width = 1500
End
Begin VB.CommandButton 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
Caption = "西安亚川电力科技有限公司 版权所有"
ForeColor = &H00000000&
Height = 825
Left = 255
TabIndex = 4
Top = 2625
Width = 3630
End
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。
Next
KeyVal = Format$("&h" + KeyVal) ' 转换四字节的字符为字符串
End Select
GetKeyValue = True ' 返回成功
rc = RegCloseKey(hKey) ' 关闭注册表关键字
Exit Function ' 退出
GetKeyError: ' 错误发生后将其清除...
KeyVal = "" ' 设置返回值到空字符串
GetKeyValue = False ' 返回失败
rc = RegCloseKey(hKey) ' 关闭注册表关键字
End Function