basicmod.bas

VB上位机温度模块程序,包括对温度模块的校准,和参数设置,用于工业现场,非常实用

Attribute VB_Name = "Basicmod"
Option Explicit

Public ArrGet() As Byte  '全局字节数组

Const EM_LINESCROLL = &HB6
'Public Waring As Boolean
Public Declare Sub InitCommonControls Lib "comctl32.dll" ()
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
    ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Public Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
Public Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long)
Private Declare Function GetTickCount Lib "kernel32" () As Long

Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
                                                ByVal wParam As Long, lParam As Any) As Long
                                                
' 延时函数
't is ms
Public Sub TimeDelay(t As Long)
    Dim tt&
    tt = GetTickCount()
      Do
        DoEvents
      Loop Until GetTickCount() - tt >= t
  
End Sub


'十六进制转换成十进制
Public Function SixteenTurnTen(ByVal varNum As String) As Integer
        SixteenTurnTen = Val("&H" & CStr(varNum))
End Function

'Public Function SixToTen(strSix As String) As Integer
'  On Error Resume Next
'    Dim sum  As Integer, n As Integer
'    n = Len(Text1.Text)
'    For i = 0 To n - 1
'        Select Case UCase(Mid(strSix, i + 1, 1))
'            Case "1"
'                sum = sum + 16 ^ (n - 1 - i) * 1
'            Case "2"
'                sum = sum + 16 ^ (n - 1 - i) * 2
'            Case "3"
'                sum = sum + 16 ^ (n - 1 - i) * 3
'            Case "4"
'                sum = sum + 16 ^ (n - 1 - i) * 4
'            Case "5"
'                sum = sum + 16 ^ (n - 1 - i) * 5
'            Case "6"
'                sum = sum + 16 ^ (n - 1 - i) * 6
'            Case "7"
'                sum = sum + 16 ^ (n - 1 - i) * 7
'            Case "8"
'                sum = sum + 16 ^ (n - 1 - i) * 8
'            Case "9"
'                sum = sum + 16 ^ (n - 1 - i) * 9
'            Case "A"
'                sum = sum + 16 ^ (n - 1 - i) * 10
'            Case "B"
'                sum = sum + 16 ^ (n - 1 - i) * 11
'            Case "C"
'                sum = sum + 16 ^ (n - 1 - i) * 12
'            Case "D"
'                sum = sum + 16 ^ (n - 1 - i) * 13
'            Case "E"
'                sum = sum + 16 ^ (n - 1 - i) * 14
'            Case "F"
'                sum = sum + 16 ^ (n - 1 - i) * 15
'            Case Else
'                MsgBox "输入错误，请重新输入."
'        End Select
'    Next i
'    'MsgBox "十六进位: " & strSix & "  等于十进位: " & sum
'    SixToTen = sum
'End Function

'将其他进制转换成十六进制的函数是hex (num)
'将其他进制转换成八进制的函数是oct (num)
'其中   num   可以是不同进制的数值，如：
'八进制，     &o10     (记住前面要加前缀&o或者&0)
'十进制，     10       （和平常一样就行了)
'十六进制,   &h10   （记住前面要加前缀&h或者&H）




'十进制转换为十六进制显示
Public Function DecToHex(dd As Variant, ibegin As Integer, iend As Integer) As String
    Dim i As Integer
    On Error GoTo ErrH
    For i = ibegin To iend
        DecToHex = DecToHex & " " & IIf(dd(i) > &HF, Hex(dd(i)), "0" & Hex(dd(i)))
    Next i
    Exit Function
ErrH:
    DecToHex = "不能解析的数据！"
End Function
 
    
Public Sub ScrollText(tb As TextBox)
   ' 循环发送EM_LINESCROLL   =   &HB6   就会自动滚动显示了
 
    Dim ErrCode     As Long
    ErrCode = SendMessage(tb.hwnd, EM_LINESCROLL, 0, 1)
 
End Sub
Public Sub CenterChildForm(frmObject As Form)

    'If form1.ScaleWidth <= frmObject.Width Then
    '    frmObject.Left = 0
   ' Else
   '     frmObject.Left = (frmMDI.ScaleWidth - frmObject.Width) / 2
   ' End If
    
   ' If form1.ScaleHeight <= frmObject.Height Then
   '     frmObject.Top = 0
   ' Else
        'If frmObject.MDIChild = True Then
            frmObject.Top = (Screen.Height - frmObject.Height) / 2
            frmObject.Left = (Screen.Width - frmObject.Width) / 2
       ' Else
          '  frmObject.Top = (form1.ScaleHeight - frmObject.Height) / 2 ' + 2 * form1.Toolbar1.Height
        
   '   '  End If
   ' End If

End Sub
Public Function StrToHex(dd As Variant, ibegin As Integer, iend As Integer) As Byte

   


End Function