📄 form1.frm
字号:
Top = 3120
Width = 1695
End
Begin VB.CommandButton Command4
Caption = "SingleToString"
Height = 495
Left = 4440
TabIndex = 21
Top = 3720
Width = 1695
End
Begin VB.CommandButton Command3
Caption = "Convert"
Height = 495
Left = 4440
TabIndex = 20
Top = 4560
Width = 1695
End
Begin VB.TextBox Text15
Height = 375
Left = 8400
TabIndex = 16
Text = "0"
Top = 3480
Width = 1935
End
Begin VB.TextBox Text14
Height = 375
Left = 8400
TabIndex = 15
Text = "0"
Top = 2880
Width = 1935
End
Begin VB.TextBox Text13
Height = 375
Left = 8400
TabIndex = 14
Text = "0"
Top = 2280
Width = 1935
End
Begin VB.TextBox Text12
Height = 375
Left = 8400
TabIndex = 13
Text = "0"
Top = 1680
Width = 1935
End
Begin VB.TextBox Text11
Height = 375
Left = 8400
TabIndex = 12
Text = "0"
Top = 1080
Width = 1935
End
Begin VB.TextBox Text10
Height = 375
Left = 8400
TabIndex = 11
Text = "0"
Top = 480
Width = 1935
End
Begin VB.CommandButton Command2
Caption = "Write Registers"
Height = 495
Left = 8160
TabIndex = 10
Top = 4080
Width = 2415
End
Begin VB.Timer Timer1
Interval = 500
Left = 3120
Top = 4320
End
Begin MSCommLib.MSComm MSComm1
Left = 2880
Top = 3600
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
DTREnable = 0 'False
ParitySetting = 2
End
Begin VB.TextBox Text9
Height = 375
Left = 4440
TabIndex = 9
Text = "1"
Top = 1680
Width = 1935
End
Begin VB.TextBox Text8
Height = 375
Left = 4440
TabIndex = 8
Text = "1"
Top = 1080
Width = 1935
End
Begin VB.TextBox Text7
Height = 375
Left = 4440
TabIndex = 7
Text = "1"
Top = 480
Width = 1935
End
Begin VB.CommandButton Command1
Caption = "Read Registers"
Height = 495
Left = 240
TabIndex = 6
Top = 4080
Width = 2175
End
Begin VB.TextBox Text6
Height = 375
Left = 360
TabIndex = 5
Text = "0"
Top = 3480
Width = 1935
End
Begin VB.TextBox Text5
Height = 375
Left = 360
TabIndex = 4
Text = "0"
Top = 2880
Width = 1935
End
Begin VB.TextBox Text4
Height = 375
Left = 360
TabIndex = 3
Text = "0"
Top = 2280
Width = 1935
End
Begin VB.TextBox Text3
Height = 375
Left = 360
TabIndex = 2
Text = "0"
Top = 1680
Width = 1935
End
Begin VB.TextBox Text2
Height = 375
Left = 360
TabIndex = 1
Text = "0"
Top = 1080
Width = 1935
End
Begin VB.TextBox Text1
Height = 375
Left = 360
TabIndex = 0
Text = "0"
Top = 480
Width = 1935
End
Begin VB.Label Label1
Caption = "Slave Address"
Height = 375
Left = 3120
TabIndex = 17
Top = 600
Width = 1215
End
Begin VB.Label Label3
Caption = "Quantity"
Height = 375
Left = 3240
TabIndex = 19
Top = 1680
Width = 1215
End
Begin VB.Label Label2
Caption = "Start Address"
Height = 375
Left = 3120
TabIndex = 18
Top = 1080
Width = 1695
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'Programmed by Andrzej Sokulski (asokulski@wp.pl,asokulski@megabit.com.pl)
Dim Buffor As String
Dim InBuffor As String
Dim DoWrite As Boolean
Dim Matrix(100) As Long
Dim Counter1 As Long
Function CharToBoolean(Char As String, Position As Integer) As Boolean
If Asc(Char) And 2 ^ Position Then
CharToBoolean = True
Else
CharToBoolean = False
End If
End Function
Function BooleanToChar(Char As String, Position As Integer, Value As Boolean) As String
Dim Temp As Byte
Temp = Asc(Char)
If Value Then
Temp = Temp Or 2 ^ Position
Else
Temp = Temp And (255 - 2 ^ Position)
End If
BooleanToChar = Chr(Temp)
End Function
Function SingleToString(Value As Single) As String
Dim Sign As Integer
Dim Exponent As Integer
Dim Mantissa As Double
Dim Temp As Double, Temp1 As Double
Dim AdValue As Double
Dim Str1 As String, Str2 As String, Str3 As String
Sign = 0
If Value < 0 Then
Sign = 128
End If
Temp = Abs(Value)
If Temp > 0 Then
Exponent = 127
Else
Exponent = 0
End If
Do While Temp > 1
Temp = Temp / 2
Exponent = Exponent + 1
Loop
Temp1 = 0.5
AdValue = 2147483648#
Do While (Temp > 0) And (AdValue > 0)
If Temp >= Temp1 Then
Temp = Temp - Temp1
Mantissa = Mantissa + AdValue
End If
Temp1 = Temp1 / 2
AdValue = AdValue / 2
Loop
If Mantissa > 0 Then
Do While Mantissa < 2147483648#
Mantissa = Mantissa * 2
Exponent = Exponent - 1
Loop
Mantissa = (Mantissa - 2147483648#) * 2
Mantissa = Mantissa / 512
End If
If (CLng(Mantissa) < 8333608) Then
Exponent = Exponent - 1
Else
Mantissa = Mantissa + &H800000
End If
If Exponent Mod 2 > 0 Then
Mantissa = Mantissa + &H800000
End If
If CLng(Mantissa) >= 16777216 Then
Mantysa = CLng(Mantissa - 16777216)
Else
Mantysa = CLng(Mantissa)
End If
Exponent = (Exponent \ 2) + Sign
Str3 = Chr(Mantysa Mod 256)
Mantysa = Mantysa \ 256
Str2 = Chr(Mantysa Mod 256)
Str1 = Chr(Mantysa \ 256)
Text1.Text = Hex(Exponent)
Text2.Text = Hex(Asc(Str1))
Text3.Text = Hex(Asc(Str2))
Text4.Text = Hex(Asc(Str3))
SingleToString = Str2 & Str3 & Chr(Exponent) & Str1
End Function
Function StringToSingle(Value As String) As Single
Dim Mantysa As Double, AdValue As Double
Dim MTemp As Double, Temp As Long
Dim Sign As Integer
Dim Exponenet As Single, Mantissa1 As Long, Mantissa2 As Long, Mantissa3 As Long
Exponent = Asc(Mid(Value, 3, 1))
Mantissa1 = Asc(Mid(Value, 4, 1))
Mantissa2 = Asc(Mid(Value, 1, 1))
Mantissa3 = Asc(Mid(Value, 2, 1))
Sign = 1
If Exponent >= 128 Then
Sign = -1
Exponent = Exponent - 128
End If
Exponent = Exponent * 2
If Mantissa1 >= 128 Then
Exponent = Exponent + 1
Mantissa1 = Mantissa1 - 128
End If
MTemp = Mantissa1 * 65536 + Mantissa2 * 256 + Mantissa3
AdValue = 0.5
If (MTemp > 0) Or (Exponent <> 0) Then
Mantysa = 1
Else
Mantysa = 0
End If
Temp = 4194304
Do While (MTemp > 0) And (Temp > 0)
If (MTemp >= Temp) Then
Mantysa = Mantysa + AdValue
MTemp = MTemp - Temp
End If
AdValue = AdValue / 2
Temp = Temp \ 2
Loop
StringToSingle = Sign * (2 ^ (Exponent - 127)) * Mantysa
End Function
Function Check_CRC(InputString As String) As Boolean
Dim CRC As String, Data As String
CRC = Mid(InputString, Len(InputString) - 2, 2)
Data = Mid(InputString, 1, Len(InputString) - 2)
If CRC = CRC_16(Data) Then
Check_CRC = True
Else
Check_CRC = False
End If
End Function
Function ReadCheckBox() As String
Dim i As Integer
Dim Char1 As String, Char2 As String
Char1 = Chr(0)
Char2 = Chr(0)
For i = 0 To 7
Char1 = BooleanToChar(Char1, i, Check1(i).Value)
Next i
For i = 8 To 15
Char2 = BooleanToChar(Char2, i - 8, Check1(i).Value)
Next i
ReadCheckBox = Char1 & Char2
End Function
Public Sub WriteBoolean()
Dim DataOutput As String
Dim ByteCnt As Integer
DataOutput = Chr(Val(Text7.Text))
DataOutput = DataOutput & Chr(15)
DataOutput = DataOutput & Chr((Val(Text8.Text) - 1) \ 256)
DataOutput = DataOutput & Chr((Val(Text8.Text) - 1) Mod 256)
DataOutput = DataOutput & Chr(0) & Chr(16)
'DataOutput = DataOutput & Chr((Val(Text9.Text)) \ 256)
'DataOutput = DataOutput & Chr((Val(Text9.Text)) Mod 256)
'ByteCnt = CInt(Val(Text9.Text)) \ 8
'If (CInt(Val(Text9.Text)) Mod 8) > 0 Then
' ByteCnt = ByteCnt + 1
'End If
ByteCnt = 2
DataOutput = DataOutput & Chr(Val(ByteCnt))
DataOutput = DataOutput & ReadCheckBox()
DataOutput = DataOutput & CRC_16(DataOutput)
Text1.Text = Str(Asc(Mid(DataOutput, 1, 1)))
Text2.Text = Str(Asc(Mid(DataOutput, 2, 1)))
Text3.Text = Str(Asc(Mid(DataOutput, 3, 1)))
Text4.Text = Str(Asc(Mid(DataOutput, 4, 1)))
Text5.Text = Str(Asc(Mid(DataOutput, 5, 1)))
Text6.Text = Str(Asc(Mid(DataOutput, 6, 1)))
Text10.Text = Str(Asc(Mid(DataOutput, 7, 1)))
Text11.Text = Str(Asc(Mid(DataOutput, 8, 1)))
Text12.Text = Str(Asc(Mid(DataOutput, 9, 1)))
Text13.Text = Str(Asc(Mid(DataOutput, 10, 1)))
Text14.Text = Str(Asc(Mid(DataOutput, 11, 1)))
'Text15.Text = Str(Asc(Mid(DataOutput, 12, 1)))
Dim PauseTime, Start, Finish, TotalTime
InBuffor = ""
' Use COM1.
If MSComm1.PortOpen = False Then
MSComm1.CommPort = 1
' pr阣ko滄 9600 bod體, bez parzysto渃i, 8 bit體 danych, 1 bit stopu.
MSComm1.Settings = "9600,E,8,1"
' Formant powinien odczyta⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -