mbit.bas

远端荧幕传输程序,远端荧幕传输程序.rar

Attribute VB_Name = "mBit"
Attribute VB_Description = "位运算模块"
Option Explicit
'项目：位运算模块
'作者：zyl910
'版本：1.0
'日期：2004-1-24
'E-Mail：[e-mail]
'特点：在使用BitPosMask、BitMapMask、BitsMask前必须初始化
'需要初始化

Private m_Inited As Boolean

Public BitPosMask(0 To 31) As Long
Attribute BitPosMask.VB_VarDescription = "位位置掩码（最低位开始）"
Public BitMapMask(0 To 31) As Long
Attribute BitMapMask.VB_VarDescription = "位图位掩码（最左边(最高位)开始）"
Public BitsMask(0 To 32) As Long
Attribute BitsMask.VB_VarDescription = "使用n位"

Public Property Get Inited() As Boolean
Attribute Inited.VB_Description = "初始化"
    Inited = m_Inited
End Property

Public Sub Init()
Attribute Init.VB_Description = "初始化"
    If m_Inited Then Exit Sub
    m_Inited = True
    
    Dim I As Long
    
    For I = 0 To 30
        BitPosMask(I) = 2& ^ I
    Next I
    BitPosMask(31) = &H80000000
    
    For I = 0 To 7
        BitMapMask(I) = BitPosMask(7 - I)
    Next I
    For I = 8 To &HF
        BitMapMask(I) = BitPosMask(&HF - I + 8)
    Next I
    For I = &H10 To &H17
        BitMapMask(I) = BitPosMask(&H17 - I + &H10)
    Next I
    For I = &H18 To &H1F
        BitMapMask(I) = BitPosMask(&H1F - I + &H18)
    Next I
    
    For I = 0 To 30
        BitsMask(I) = 2& ^ I - 1
    Next I
    BitsMask(31) = &H7FFFFFFF
    BitsMask(32) = -1 '&HFFFFFFFF
    
End Sub

'------------------------------------------------

Public Property Get LoBit4(ByRef Data As Byte) As Byte
Attribute LoBit4.VB_Description = "字节：低4位"
    LoBit4 = Data And &HF
End Property

Public Property Let LoBit4(ByRef Data As Byte, ByVal RHS As Byte)
    Data = (Data And &HF0) Or (RHS And &HF)
End Property

Public Property Get HiBit4(ByRef Data As Byte) As Byte
Attribute HiBit4.VB_Description = "字节：高4位"
    HiBit4 = (Data And &HF0) \ &H10
End Property

Public Property Let HiBit4(ByRef Data As Byte, ByVal RHS As Byte)
    Data = (Data And &HF) Or ((RHS And &HF) * &H10)
End Property

Public Function MakeByte(ByVal hi As Long, ByVal Lo As Long) As Byte
Attribute MakeByte.VB_Description = "制造字节"
    MakeByte = ((hi And &HF) * &H10) Or (Lo And &HF)
End Function

'------------------------------------------------

Public Property Get LoByte(ByRef Word As Integer) As Byte
Attribute LoByte.VB_Description = "字：低字节"
    LoByte = Word And &HFF
End Property

Public Property Get HiByte(ByRef Word As Integer) As Byte
Attribute HiByte.VB_Description = "字：高字节"
    HiByte = ((Word And &H7F00) \ &H100) Or (((Word And &H8000) <> 0) And &H80)
End Property

Public Property Let LoByte(ByRef Word As Integer, ByVal vData As Byte)
    Word = (Word And &HFF00) Or vData
End Property

Public Property Let HiByte(ByRef Word As Integer, ByVal vData As Byte)
    Word = (Word And &HFF) Or ((vData And &H7F) * &H100) Or (((vData And &H80) <> 0) And &H8000)
End Property

Public Function MakeWord(ByVal HiByte As Byte, ByVal LoByte As Byte) As Integer
Attribute MakeWord.VB_Description = "制造字"
    MakeWord = ((HiByte And &H7F) * &H100 Or (((HiByte And &H80) <> 0) And &H8000)) Or LoByte
End Function

'------------------------------------------------

Public Property Get ULoWord(ByRef DWord As Long) As Long
Attribute ULoWord.VB_Description = "(无符号)双字：高字"
    ULoWord = DWord And &HFFFF&
End Property

Public Property Get UHiWord(ByRef DWord As Long) As Long
Attribute UHiWord.VB_Description = "(无符号)双字：高字"
    UHiWord = ((DWord And &H7FFF0000) \ &H10000) Or (((DWord And &H80000000) <> 0) And &H8000&)
End Property

Public Property Let ULoWord(ByRef DWord As Long, ByVal vData As Long)
    DWord = (DWord And &HFFFF0000) Or (vData And &HFFFF)
End Property

Public Property Let UHiWord(ByRef DWord As Long, ByVal vData As Long)
    DWord = (DWord And &HFFFF&) Or ((vData And &H7FFF) * &H10000) Or (((vData And &H8000&) <> 0) And &H80000000)
End Property

Public Function UMakeDWord(ByVal HiWord As Long, ByVal LoWord As Long) As Long
Attribute UMakeDWord.VB_Description = "(无符号)制造双字"
    UMakeDWord = ((HiWord And &H7FFF) * &H10000 Or (((HiWord And &H8000&) <> 0) And &H80000000)) _
            Or (LoWord And &HFFFF)
End Function

'------------------------------------------------

Public Property Get LoWord(ByRef DWord As Long) As Integer
Attribute LoWord.VB_Description = "双字：高字"
    LoWord = (DWord And &H7FFF&) Or (((DWord And &H8000&) <> 0) And &H8000)
End Property

Public Property Get HiWord(ByRef DWord As Long) As Integer
Attribute HiWord.VB_Description = "双字：高字"
    HiWord = ((DWord And &H7FFF0000) \ &H10000) Or (((DWord And &H80000000) <> 0) And &H8000)
End Property

Public Property Let LoWord(ByRef DWord As Long, ByVal vData As Integer)
    DWord = (DWord And &HFFFF0000) Or (vData And &H7FFF) Or (((vData And &H8000) <> 0) And &H8000&)
End Property

Public Property Let HiWord(ByRef DWord As Long, ByVal vData As Integer)
    DWord = (DWord And &HFFFF&) Or ((vData And &H7FFF) * &H10000) Or (((vData And &H8000) <> 0) And &H80000000)
End Property

Public Function MakeDWord(ByVal HiWord As Integer, ByVal LoWord As Integer) As Long
Attribute MakeDWord.VB_Description = "制造双字"
    MakeDWord = ((HiWord And &H7FFF) * &H10000 Or (((HiWord And &H8000) <> 0) And &H80000000)) _
            Or ((LoWord And &H7FFF) Or (((LoWord And &H8000) <> 0) And &H8000&))
End Function

Public Function MAKELPARAM(ByVal L As Integer, ByVal H As Integer) As Long
Attribute MAKELPARAM.VB_Description = "制造LPARAM"
    MAKELPARAM = MakeDWord(H, L)
End Function

'DWORD MAKELONG(
'  WORD wLow,  // low-order word of long value
'  WORD wHigh  // high-order word of long value
');
Public Function MAKELONG(ByVal wLow As Integer, ByVal wHigh As Integer) As Long
Attribute MAKELONG.VB_Description = "制造Long"
    MAKELONG = MakeDWord(wHigh, wLow)
End Function

'------------------------------------------------

Public Property Get ColorR(ByRef Color As Long) As Byte
Attribute ColorR.VB_Description = "颜色Red"
    ColorR = Color And &HFF
End Property

Public Property Get ColorG(ByRef Color As Long) As Byte
Attribute ColorG.VB_Description = "颜色Green"
    ColorG = (Color And &HFF00&) \ &H100&
End Property

Public Property Get ColorB(ByRef Color As Long) As Byte
Attribute ColorB.VB_Description = "颜色Blue"
    ColorB = (Color And &HFF0000) \ &H10000
End Property

Public Property Get ColorA(ByRef Color As Long) As Byte
Attribute ColorA.VB_Description = "颜色Alpha"
    ColorA = ((Color And &H7F000000) \ &H1000000) Or (((Color And &H80000000) <> 0) And &H80)
End Property

Public Property Let ColorR(ByRef Color As Long, ByVal vData As Byte)
    Color = (Color And &HFFFFFF00) Or vData
End Property

Public Property Let ColorG(ByRef Color As Long, ByVal vData As Byte)
    Color = (Color And &HFFFF00FF) Or (vData * &H100&)
End Property

Public Property Let ColorB(ByRef Color As Long, ByVal vData As Byte)
    Color = (Color And &HFF00FFFF) Or (vData * &H10000)
End Property

Public Property Let ColorA(ByRef Color As Long, ByVal vData As Byte)
    Color = (Color And &HFFFFFF) Or ((vData And &H7F) * &H1000000) Or (((vData And &H80) <> 0) And &H80000000)
End Property

Public Function RGBA(ByVal Red As Byte, ByVal Green As Byte, ByVal Blue As Byte, ByVal Alpha As Byte) As Long
Attribute RGBA.VB_Description = "制造32位颜色"
    RGBA = Red Or Green * &H100& Or Blue * &H10000 Or ((Alpha And &H7F) * &H1000000 Or (((Alpha And &H80) <> 0) And &H80000000))
End Function

'------------------------------------------------

'将大端方式的Word转为小端方式
Public Property Get WordBig(ByRef BigData As Integer) As Long
Attribute WordBig.VB_Description = "将大端方式的Word转为小端方式"
    WordBig = ((BigData And &H7F) * &H100&) _
            Or (((BigData And &H80) <> 0) And &H8000&) _
            Or ((BigData And &H7F00) \ &H100&) _
            Or (((BigData And &H8000) <> 0) And &H80&)
End Property
Public Property Let WordBig(ByRef BigData As Integer, ByVal RHS As Long)
    BigData = ((RHS And &H7F&) * &H100) _
            Or (((RHS And &H80&) <> 0) And &H8000) _
            Or ((RHS And &H7F00&) \ &H100) _
            Or (((RHS And &H8000&) <> 0) And &H80)
End Property



'------------------------------------------------

Public Function Bin(ByVal Data As Long, Optional ByVal SIZE As Long = -1) As String
Attribute Bin.VB_Description = "二进制显示"
    Dim Sign As Boolean
    Dim TempStr As String
    
    Sign = Data < 0
    Data = Data And &H7FFFFFFF
    Do While Data
        TempStr = (Data And 1) & TempStr
        Data = Data \ 2
    Loop
    If Len(TempStr) = 0 Then TempStr = "0"
    If Sign Then
        TempStr = "1" & String$(32 - Len(TempStr) - 1, "0") & TempStr
    End If
    
    If SIZE > Len(TempStr) Then TempStr = String$(SIZE - Len(TempStr), "0") & TempStr
    'Debug.Print TempStr
    
    Bin = TempStr
    
End Function


'------------------------------------------------

'检查数字占多少位
Public Function ChkNumBits(ByVal Value As Long) As Long
Attribute ChkNumBits.VB_Description = "检查数字占多少位"
    If Value = &H80000000 Then ChkNumBits = 32: Exit Function
    If Value < 0 Then Value = Abs(Value)
    Dim I As Long
    For I = 0 To 31
        If Value <= BitsMask(I) Then Exit For
    Next I
    ChkNumBits = I
End Function

'检查数字占多少位，并根据正负翻转位（JPEG系数的规定）
Public Function ChkNumBitsAuto(ByRef Value As Long) As Long
Attribute ChkNumBitsAuto.VB_Description = "检查数字占多少位，并根据正负翻转位（JPEG系数的规定）"
    If Value = &H80000000 Then ChkNumBitsAuto = 32: Exit Function
    Dim Sign As Long '为了速度，Long比Boolean快
    Dim I As Long
    Sign = Value And &H80000000
    If Sign Then Value = Abs(Value)
    For I = 0 To 31
        If Value <= BitsMask(I) Then Exit For
    Next I
    If Sign Then Value = Value Xor BitsMask(I)
    ChkNumBitsAuto = I
End Function