module2.bas

来自「自动化测试程序」· BAS 代码 · 共 114 行

Attribute VB_Name = "Module2"
Option Explicit
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Const GWL_STYLE = (-16)
Public Const ES_UPPERCASE = &H8& '大写
Public Const ES_LOWERCASE = &H10& '小写
Public Const ES_NUMBER = &H2000& '全部
Public Const ES_All = &H0& '全部可以输入

Type data
    ControlCode As Integer '控制码
    Datalen As Integer '数据长度
    sum As Single '校验和
    TempData() As Byte
End Type

Public RData As data
Public SData As data

Public StartAddress As Byte
Public EndAddress As Byte

Public ParaType As Integer
Public ParaList() As Double

Public Function SetModel(tBox As TextBox, InputStyle As Long)
Dim DefaultStyle As Long, new_style As Long
DefaultStyle = GetWindowLong(tBox.hwnd, GWL_STYLE)
DefaultStyle = DefaultStyle And (Not ES_NUMBER) And Not ES_LOWERCASE And Not ES_UPPERCASE
If InputStyle <> ES_All Then
DefaultStyle = DefaultStyle Or InputStyle
new_style = SetWindowLong(tBox.hwnd, GWL_STYLE, DefaultStyle)
tBox.Refresh
End If
End Function
'sfsf

Public Function FormatHex(temp) As String
Dim str As String

str = Hex(temp)

If Len(str) = 1 Then
    str = "0" & str
End If

FormatHex = str
End Function

Public Sub MakeDataHead(ControlCode As Integer, Datalen As Integer)

SData.ControlCode = ControlCode
SData.Datalen = Datalen + 7
ReDim SData.TempData(SData.Datalen - 1)

SData.TempData(0) = &HEB
SData.TempData(1) = &H90

SData.TempData(2) = EndAddress
SData.TempData(3) = StartAddress

SData.TempData(4) = SData.ControlCode

SData.TempData(5) = SData.Datalen

SData.TempData(6) = &H0  '起始地址

SData.TempData(7) = &H68 '源地址

End Sub

Public Sub MakeDataEnd()
Dim i As Integer

SData.sum = 0
For i = 0 To SData.Datalen - 1
    SData.sum = SData.sum + SData.TempData(i)
Next i

SData.TempData(SData.Datalen - 1) = SData.sum Mod 256

Call SendData(SData.TempData)

End Sub

Public Sub SendData(TempData)
On Error Resume Next

Dim Tempstr As String
Dim i As Integer
Dim data

data = TempData

fMainForm.Comm.Output = data
'fMainForm.Timer1.Enabled = True
If BaoWen_Refresh Then
For i = 0 To UBound(data)
    Tempstr = Tempstr & FormatHex(data(i)) & " "
Next i

With frmMsgList.Text1(0)
    .Text = Tempstr & vbCrLf & .Text
    .Text = "发送数据  " & .Text
    .Text = Now & vbCrLf & .Text
End With
End If
End Sub