?? transducer.frm
字號:
VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form Transducer
BorderStyle = 1 'Fixed Single
Caption = "ABB變頻器測試"
ClientHeight = 6660
ClientLeft = 4890
ClientTop = 780
ClientWidth = 6135
Icon = "Transducer.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 6660
ScaleWidth = 6135
Begin VB.TextBox txtMax
Height = 330
Left = 3675
TabIndex = 17
Text = "0"
Top = 6120
Width = 705
End
Begin VB.TextBox txtMin
Height = 330
Left = 2520
TabIndex = 16
Text = "0"
Top = 6135
Width = 705
End
Begin VB.CommandButton cmdGetAll
Caption = "全采"
Height = 510
Left = 525
TabIndex = 15
Top = 6000
Width = 1110
End
Begin VB.CommandButton cmdClear
Caption = "清除"
Height = 495
Left = 270
TabIndex = 14
Top = 5190
Width = 975
End
Begin VB.CommandButton cmdBin2dec
Caption = ">"
Height = 375
Left = 3510
TabIndex = 13
Top = 5190
Width = 255
End
Begin VB.CommandButton cmdDec2bin
Caption = "<"
Height = 375
Left = 3150
TabIndex = 12
Top = 5190
Width = 255
End
Begin VB.TextBox txtDec
Height = 270
Left = 3870
TabIndex = 9
Text = "0"
Top = 5310
Width = 735
End
Begin VB.TextBox txtBin
Height = 270
Left = 1590
TabIndex = 8
Text = "0"
Top = 5310
Width = 1455
End
Begin VB.CommandButton cmdWrite
Caption = "寫入"
Height = 495
Left = 5070
TabIndex = 7
Top = 5190
Width = 855
End
Begin VB.ComboBox cbRegStart
Height = 300
Left = 3150
TabIndex = 6
Top = 4710
Width = 1455
End
Begin VB.CommandButton cmdRead
Caption = "讀取"
Height = 495
Left = 5070
TabIndex = 4
Top = 4590
Width = 855
End
Begin VB.ComboBox cbAddress
Height = 300
Left = 1590
TabIndex = 2
Top = 4710
Width = 1455
End
Begin VB.ListBox List1
Height = 4200
Left = 120
TabIndex = 1
Top = 60
Width = 5835
End
Begin VB.CommandButton cmdComSet
Caption = "設置"
Height = 495
Left = 270
TabIndex = 0
Top = 4590
Width = 975
End
Begin MSCommLib.MSComm MSComm1
Left = 4950
Top = 6015
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
DTREnable = -1 'True
InputMode = 1
End
Begin VB.Label Label6
Caption = "地址："
Height = 270
Left = 1845
TabIndex = 19
Top = 6150
Width = 615
End
Begin VB.Label Label5
Caption = "到"
Height = 285
Left = 3300
TabIndex = 18
Top = 6180
Width = 315
End
Begin VB.Label Label4
Caption = "十進制："
Height = 255
Left = 3870
TabIndex = 11
Top = 5070
Width = 735
End
Begin VB.Label Label3
Caption = "二進制："
Height = 255
Left = 1590
TabIndex = 10
Top = 5070
Width = 1095
End
Begin VB.Label Label2
Caption = "REG起始地址："
Height = 255
Left = 3150
TabIndex = 5
Top = 4470
Width = 1335
End
Begin VB.Label Label1
Caption = "DIP地址："
Height = 255
Left = 1590
TabIndex = 3
Top = 4470
Width = 975
End
End
Attribute VB_Name = "Transducer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cmdBin2dec_Click()
txtDec.Text = Bin2Dec(Trim(txtBin.Text))
End Sub
Private Sub cmdClear_Click()
List1.Clear
End Sub
Private Sub cmdComSet_Click()
On Error GoTo Errhandle
OpenFlag = False
frmCOMset.Show 1
If OpenFlag Then
If MSComm1.PortOpen = True Then
MSComm1.PortOpen = False
End If
OpenFlag = False
MSComm1.Settings = strSetting
MSComm1.CommPort = MscomPort
MSComm1.RThreshold = 0
MSComm1.OutBufferCount = 0
MSComm1.InBufferCount = 0
MSComm1.PortOpen = True
cmdRead.Enabled = True
End If
Exit Sub
Errhandle:
MsgBox Err.Description, vbOKOnly + vbCritical, "警告"
Err.Clear
End Sub
Private Sub cmdDec2bin_Click()
txtBin.Text = Dec2Bin(Trim(txtDec.Text))
End Sub
Private Sub cmdGetAll_Click()
Dim i As Long
For i = Val(txtMin) To Val(txtMax)
cbRegStart.ListIndex = i
cmdRead_Click
Next
End Sub
Private Sub cmdRead_Click()
Dim dd As Single
Dim tmpstr As String
Dim i As Long, j As Long
Dim CRC() As Byte
Dim d() As Byte '待傳輸數據
Dim rcflg As Boolean
ReDim d(5) As Byte
If cbRegStart.ListIndex < 0 Then
Exit Sub
End If
d(0) = cbAddress.ListIndex + 1
d(1) = 3
d(2) = Int((cbRegStart.ListIndex) / 256)
d(3) = (cbRegStart.ListIndex) Mod 256
d(4) = 0
d(5) = 1
CRC = CRC16_1(d)
'CRC(0)為高位
'CRC(1)為低位
ReDim Preserve d(7)
d(6) = CRC(1)
d(7) = CRC(0)
ReDim ReceiveByte(0 To 6)
If MSComm1.PortOpen = True Then
MSComm1.InBufferCount = 0
MSComm1.Output = d
dd = Timer + 0.15
Do
' Sleep (10)
' DoEvents
TimeDelay (10)
If MSComm1.InBufferCount >= 7 Then
ReceiveByte = MSComm1.Input
rcflg = True
End If
Loop Until rcflg = True Or Timer > dd
If rcflg Then
i = ReceiveByte(1)
j = d(1)
If i = j Then
tmpstr = Dec2Bin(CLng(ReceiveByte(4)))
While (Len(tmpstr) < 8)
tmpstr = "0" & tmpstr
Wend
tmpstr = Dec2Bin(CLng(ReceiveByte(3))) & tmpstr
List1.AddItem cbRegStart.ListIndex + 1 & "_" & tmpstr & "-" & Bin2Dec(tmpstr)
End If
Else
List1.AddItem "Read failed!"
End If
End If
End Sub
Private Sub cmdWrite_Click()
Dim dd As Single
Dim tmpstr As String
Dim CRC() As Byte
Dim d() As Byte '待傳輸數據
Dim rcflg As Boolean
ReDim d(5) As Byte
If cbRegStart.ListIndex < 0 Then
Exit Sub
End If
d(0) = cbAddress.ListIndex + 1
d(1) = 6
d(2) = Int((cbRegStart.ListIndex) / 256)
d(3) = (cbRegStart.ListIndex) Mod 256
d(4) = Int(Val(txtDec) / 256)
d(5) = Val(txtDec) Mod 256
CRC = CRC16_1(d)
'CRC(0)為高位
'CRC(1)為低位
ReDim Preserve d(7)
d(6) = CRC(1)
d(7) = CRC(0)
ReDim ReceiveByte(0 To 6)
If MSComm1.PortOpen = True Then
MSComm1.InBufferCount = 0
MSComm1.Output = d
dd = Timer + 0.2
Do
' Sleep (10)
' DoEvents
TimeDelay (10)
If MSComm1.InBufferCount >= 7 Then
ReceiveByte = MSComm1.Input
rcflg = True
End If
Loop Until rcflg = True Or Timer > dd
If rcflg Then
If ReceiveByte(1) = d(1) Then
tmpstr = Dec2Bin(CLng(ReceiveByte(4)))
While (Len(tmpstr) < 8)
tmpstr = "0" & tmpstr
Wend
tmpstr = Dec2Bin(CLng(ReceiveByte(3))) & tmpstr
List1.AddItem tmpstr & "-" & Bin2Dec(tmpstr)
Call SaveSet
Else
List1.AddItem "Writed failed!"
End If
End If
End If
End Sub
Private Sub SaveSet()
Dim dd As Single
Dim tmpstr As String
Dim CRC() As Byte
Dim d() As Byte '待傳輸數據
Dim rcflg As Boolean
ReDim d(5) As Byte
d(0) = cbAddress.ListIndex + 1
d(1) = 6
d(2) = Int(1606 / 256)
d(3) = 1606 Mod 256
d(4) = 0
d(5) = 1
CRC = CRC16_1(d)
'CRC(0)為高位
'CRC(1)為低位
ReDim Preserve d(7)
d(6) = CRC(1)
d(7) = CRC(0)
ReDim ReceiveByte(0 To 6)
If MSComm1.PortOpen = True Then
MSComm1.InBufferCount = 0
MSComm1.Output = d
dd = Timer + 0.2
Do
TimeDelay (10)
If MSComm1.InBufferCount >= 7 Then
ReceiveByte = MSComm1.Input
rcflg = True
End If
Loop Until rcflg = True Or Timer > dd
If rcflg Then
If ReceiveByte(1) = d(1) Then
List1.AddItem "Save para successed!" 'tmpstr & "-" & Bin2Dec(tmpstr)
Else
List1.AddItem "Save para failed!"
End If
End If
End If
End Sub
Private Sub Form_Load()
Dim i As Long
For i = 1 To 14
cbAddress.AddItem i
Next
For i = 0 To 9907
cbRegStart.AddItem i + 1
Next
cbRegStart.ListIndex = 0
cbAddress.ListIndex = 0
'ADDTransducer1.ReadRegSingle( = True
End Sub
'
Private Sub MSComm1_OnComm()
Dim i As Long
i = 1
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -