module1.bas

本人转载的一个用VB写的云台控制系统 本人转载的一个用VB写的云台控制系统

Attribute VB_Name = "modPublic"
Option Explicit
'***********************************************
'声明
'***********************************************
'指定下述一个或多个标志 (用OR运算符合并到一起)
'强迫中止没有响应的进程
Public Const EWX_FORCE = 4
'中止进程，然后注销
Public Const EWX_LOGOFF = 0
'关掉系统电源（如果可能的话，ATX电源就可以）
Public Const EWX_SHUTDOWN = 1
'重新引导系统
Public Const EWX_REBOOT = 2
'如果可能，关掉电源
Public Const EWX_POWEROFF = 8

'***********************************************
'声明重启动Windows的函数
'***********************************************
Private Declare Function SHRestartSystemMB Lib "shell32" Alias "#59" (ByVal hOwner As Long, ByVal sExtraPrompt As String, ByVal uFlags As Long) As Long
Private Declare Function GetActiveWindow Lib "user32" () As Long            'Use Me.hwnd in VB
'***********************************************
'声明引用winio.dll中的函数
'***********************************************
Declare Function InstallWinIoDriver Lib "winio.dll" _
    (ByRef pszWinIoDriverPath As String, _
    ByVal IsDemandLoaded As Boolean) As Boolean

Declare Function InitializeWinIo Lib "winio.dll" () As Boolean

Declare Function SetPortVal Lib "winio.dll" _
    (ByVal wPortAddr As Integer, ByVal dwPortVal As Integer, _
    ByVal bSize As Byte) As Boolean

Declare Sub ShutdownWinIo Lib "winio.dll" ()
Declare Sub RemoveWinIoDriver Lib "winio.dll" ()
'***********************************************
'声明结束
'***********************************************

'********************************************************
'功能：提示用户系统设置更新后是否重新启动系统
'      用户点击“是”则重新启动，“否”不重新启动，
'      无选则等待15秒后自动重启
'参数：[sExtraMessage]  显示组户的额外信息
'      [lMode]          以EWX_开头的常量
'*********************************************************
Function SystemUpdatedRestart(Optional ByVal sExtraMessage As String = vbNullString, Optional lMode As Long = EWX_LOGOFF) As Long
    On Error Resume Next
    If Len(sExtraMessage) Then
        'Format and convert extra message
        If Right$(sExtraMessage, 2) <> vbNewLine Then
            sExtraMessage = sExtraMessage & vbNewLine & vbNewLine
        End If
        sExtraMessage = StrConv(sExtraMessage, vbUnicode)
    End If
    SystemUpdatedRestart = SHRestartSystemMB(GetActiveWindow, sExtraMessage, EWX_FORCE + lMode)
    On Error GoTo 0
End Function

'***********************************************
'功能：将一个字节形的数转换为二进制数，以字符串形式返回
'***********************************************
Public Function CBin(ByVal Number As Byte) As String
    Dim temp As Byte
    '将1置于一个字节的首位
    temp = &H80
    
    Do Until temp < 1
        If Number >= temp Then  'Number在此位为1
           CBin = CBin + "1"
           Number = Number - temp
        Else                    'Number在此位为0
            CBin = CBin + "0"
        End If
        temp = temp / 2 'temp 所表示的1右移
    Loop '循环直到1从一个字节右端移出去
End Function

'***********************************************
'功能：将一个以字符串形式表示的二进制数转换为十进制数
'***********************************************
Public Function CDecFromBin(ByVal xBin As String) As Integer
    Dim i As Integer
    Dim res As Integer
    res = 0
    '逐位计算得到
    For i = 1 To Len(xBin)
        res = res * 2 + CByte(Mid(xBin, i, 1))
    Next i
    CDecFromBin = res
End Function