netgiftran.ctl

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

            .biYPelsPerMeter = 0
            .biClrUsed = 0
            .biClrImportant = 0
        End With
        hSrcDIB = CreateDIBSection(hDCDIB, SrcBI, DIB_RGB_COLORS, pSrcDIB, 0, 0)
        If hSrcDIB Then
            hOldMap = SelectObject(hDCDIB, hSrcDIB)
            
            Call BitBlt(hDCDIB, 0, 0, Width, Height, hDC, X, Y, vbSrcCopy)
            
            '// 进行色彩量化
            Dim pByteS() As Byte, pBytePtrS As SAFEARRAY1D
            Dim pByteD() As Byte, pBytePtrD As SAFEARRAY1D
            Dim ScanAddS As Long
            Dim ScanAddD As Long
            Dim I As Long, J As Long
            Dim CurDither As Long
            
            '初始化DIB
            With mBI.bmiHeader
                .biSize = Len(mBI.bmiHeader)
                .biWidth = Width
                .biHeight = Height
                .biBitCount = PicColorBits
                .biPlanes = 1
                .biCompression = BI_RGB
                mScanBytes = (.biWidth * 1 + 3) And &H7FFFFFFC
                .biSizeImage = mScanBytes * .biHeight
                .biXPelsPerMeter = 0
                .biYPelsPerMeter = 0
                .biClrUsed = 0
                .biClrImportant = 0
                
                If .biSizeImage > 0 Then
                    ReDim mMapData(0 To .biSizeImage - 1)
                Else
                    .biSizeImage = 0
                    mScanBytes = 0
                End If
                
            End With
            If mScanBytes > 0 Then
                CopyMemory mBI.bmiColors(0), palWeb216(0), &H100 * 4
                
                MakePoint VarPtrArray(pByteS), pBytePtrS, 1
                MakePoint VarPtrArray(pByteD), pBytePtrD, 1
                
                ScanAddS = ScanBytes - SrcBI.biWidth * 3
                ScanAddD = mScanBytes - mBI.bmiHeader.biWidth * 1
                Ptr(pBytePtrS) = pSrcDIB
                Ptr(pBytePtrD) = VarPtr(mMapData(0))
                
                For I = 0 To SrcBI.biHeight - 1
                    For J = 0 To SrcBI.biWidth - 1
                        CurDither = DitherTable((I And &HF) * &H10 + (J And &HF))
                        pByteD(0) = (pByteS(0) \ &H33 + ((Diff8Bto6(pByteS(0)) > CurDither) And 1)) * 36 _
                                  + (pByteS(1) \ &H33 + ((Diff8Bto6(pByteS(1)) > CurDither) And 1)) * 6 _
                                  + (pByteS(2) \ &H33 + ((Diff8Bto6(pByteS(2)) > CurDither) And 1)) * 1
                        
                        pBytePtrS.pvData = pBytePtrS.pvData + 3
                        pBytePtrD.pvData = pBytePtrD.pvData + 1
                        
                    Next J
                    
                    pBytePtrS.pvData = pBytePtrS.pvData + ScanAddS
                    pBytePtrD.pvData = pBytePtrD.pvData + ScanAddD
                    
                Next I
                
                FreePoint VarPtrArray(pByteS)
                FreePoint VarPtrArray(pByteD)
                
            End If
            '\\ 进行色彩量化
            
            Call SelectObject(hDCDIB, hOldMap)
            DeleteObject hSrcDIB
            
            Rc = True
            
        End If
        
        DeleteDC hDCDIB
        
    End If
    
    If Rc Then
        mIsChangeBitmap = True
    End If
    
    pSetBitmap = Rc
    
End Function

'图像编码
Private Sub pEncode()
    If mIsChangeBitmap = False Then Exit Sub
    'Debug.Assert False
    
    If mScanBytes > 0 Then
        'GIF-LZW编码
        Dim NextNode(0 To &H1000) As Integer '第一个下层节点的索引
        Dim SubNode(0 To &H1000) As Integer '下一个同层节点的索引
        Dim StrAdd(0 To &H1000) As Byte '新增加的那个字节（比上层节点多的那个字节）
        Dim TableSize As Long
        Dim TableMaxSize As Long
        Dim CurBits As Long
        Dim LZW_CLEAR As Integer
        Dim LZW_EOI As Integer
        Dim OldCode As Integer
        Dim CurByte As Byte
        Dim TempIdx As Integer
        Dim f As Boolean
        '模拟指针
        Dim pByteS() As Byte, pBytePtrS As SAFEARRAY1D
        Dim ScanPtr As Long
        '缓冲区
        Dim BitBuff As Long
        Dim BitUsed As Long
        Dim BufLZW() As Byte
        Dim BufLZWPos As Long
        '其他
        Dim X As Long, Y As Long
        
        '分配缓冲区
        ReDim BufLZW(0 To mBI.bmiHeader.biSizeImage * 2 - 1)
        BufLZWPos = 0
        BitBuff = 0
        BitUsed = 0
        
        '建立模拟指针
        MakePoint VarPtrArray(pByteS), pBytePtrS, 1
        
        '初始化LZW字符串表
        LZW_CLEAR = BitPosMask(LZW_MinCodeLen) '2 ^ LZW_MinCodeLen '1<<LZW_MinCodeLen
        LZW_EOI = LZW_CLEAR + 1
        CurBits = LZW_MinCodeLen + 1
        'GoSub InitStrTable
            OldCode = LZW_CLEAR
            'GoSub WriteCode
                BitBuff = BitBuff Or OldCode * BitPosMask(BitUsed)
                BitUsed = BitUsed + CurBits
                'GoSub ShiftBit
                    Do While BitUsed >= 8
                        BufLZW(BufLZWPos) = BitBuff And &HFF
                        BufLZWPos = BufLZWPos + 1
                        BitBuff = BitBuff \ &H100 'BitBuff>>8
                        BitUsed = BitUsed - 8
                    Loop
            CurBits = LZW_MinCodeLen + 1
            TableSize = LZW_EOI + 1
            TableMaxSize = BitPosMask(CurBits) '2 ^ CurBits '1<<CurBits
            Call ZeroMemory(NextNode(0), &H2000)
            Call ZeroMemory(SubNode(0), &H2000)
            Call ZeroMemory(StrAdd(0), &H1000)
        
        '初始化位图
        Y = 0
        X = 0
        ScanPtr = VarPtr(mMapData(0)) + (mBI.bmiHeader.biHeight - 1) * mScanBytes  'DIB是逆序存储
        pBytePtrS.pvData = ScanPtr
        
        '正式开始
        OldCode = pByteS(0)
        pBytePtrS.pvData = pBytePtrS.pvData + 1
        X = X + 1
        Do While Y < mBI.bmiHeader.biHeight
            '得到数据
            CurByte = pByteS(0)
            
            '看编码是否在字符串表中
            f = SubNode(OldCode) '没有下级节点，就必然不在
            If f Then '进一步判断
                TempIdx = SubNode(OldCode) '得到当前层节点的索引
                Do Until StrAdd(TempIdx) = CurByte '判断是否是已存在的节点
                    If NextNode(TempIdx) Then '存在下一节点
                        TempIdx = NextNode(TempIdx) '指向下一节点
                    Else '不存在下一节点
                        NextNode(TempIdx) = TableSize '设置同层下一节点索引指针
                        f = False
                        Exit Do
                    End If
                Loop
            Else
                SubNode(OldCode) = TableSize '设置下层节点索引指针
            End If
            
            If f Then '在
                OldCode = TempIdx
            Else '不在
                '添加编码
                'GoSub WriteCode
                    BitBuff = BitBuff Or OldCode * BitPosMask(BitUsed)
                    BitUsed = BitUsed + CurBits
                    'GoSub ShiftBit
                        Do While BitUsed >= 8
                            BufLZW(BufLZWPos) = BitBuff And &HFF
                            BufLZWPos = BufLZWPos + 1
                            BitBuff = BitBuff \ &H100 'BitBuff>>8
                            BitUsed = BitUsed - 8
                        Loop
                StrAdd(TableSize) = CurByte
                TableSize = TableSize + 1
                
                '判断字符串表大小
                If TableSize > TableMaxSize Then
                    If CurBits < LZW_MaxCodeBits Then
                        CurBits = CurBits + 1
                        TableMaxSize = TableMaxSize * 2 'tablemaxsize<<=1
                    Else
                        'GoSub InitStrTable
                            OldCode = LZW_CLEAR
                            'GoSub WriteCode
                                BitBuff = BitBuff Or OldCode * BitPosMask(BitUsed)
                                BitUsed = BitUsed + CurBits
                                'GoSub ShiftBit
                                    Do While BitUsed >= 8
                                        BufLZW(BufLZWPos) = BitBuff And &HFF
                                        BufLZWPos = BufLZWPos + 1
                                        BitBuff = BitBuff \ &H100 'BitBuff>>8
                                        BitUsed = BitUsed - 8
                                    Loop
                            CurBits = LZW_MinCodeLen + 1
                            TableSize = LZW_EOI + 1
                            TableMaxSize = BitPosMask(CurBits) '2 ^ CurBits '1<<CurBits
                            Call ZeroMemory(NextNode(0), &H2000)
                            Call ZeroMemory(SubNode(0), &H2000)
                            Call ZeroMemory(StrAdd(0), &H1000)
                    End If
                End If
                OldCode = CurByte
                
            End If
            
            '移动到下一像素
            X = X + 1
            pBytePtrS.pvData = pBytePtrS.pvData + 1
            
            '判断是否处理完一行
            If X >= mBI.bmiHeader.biWidth Then
                Y = Y + 1
                ScanPtr = ScanPtr - mScanBytes
                pBytePtrS.pvData = ScanPtr
                X = 0
            End If
            
        Loop
        
        '输出最后一个编码
        'GoSub WriteCode
            BitBuff = BitBuff Or OldCode * BitPosMask(BitUsed)
            BitUsed = BitUsed + CurBits
            'GoSub ShiftBit
                Do While BitUsed >= 8
                    BufLZW(BufLZWPos) = BitBuff And &HFF
                    BufLZWPos = BufLZWPos + 1
                    BitBuff = BitBuff \ &H100 'BitBuff>>8
                    BitUsed = BitUsed - 8
                Loop
        
        '输出LZW_EOI
        OldCode = LZW_EOI
        'GoSub WriteCode
            BitBuff = BitBuff Or OldCode * BitPosMask(BitUsed)
            BitUsed = BitUsed + CurBits
            'GoSub ShiftBit
                Do While BitUsed >= 8
                    BufLZW(BufLZWPos) = BitBuff And &HFF
                    BufLZWPos = BufLZWPos + 1
                    BitBuff = BitBuff \ &H100 'BitBuff>>8
                    BitUsed = BitUsed - 8
                Loop
        
        '结束位流
        If BitUsed Then
            BitUsed = 8
            'GoSub ShiftBit
                BufLZW(BufLZWPos) = BitBuff And &HFF
                BufLZWPos = BufLZWPos + 1
                BitBuff = BitBuff \ &H100 'BitBuff>>8
                BitUsed = BitUsed - 8
        End If
        
        '释放模拟指针
        FreePoint VarPtrArray(pByteS)
        
        '复制位流
        Call mLZWS.Clear
        Call mLZWS.AddData4Ptr(VarPtr(BufLZW(0)), BufLZWPos)
        
    End If
    
    mIsChangeBitmap = False
    
End Sub

'图像解码
Private Sub pDecode()
    'Debug.Assert False
    
    With mBI.bmiHeader
        .biWidth = mImgInfo.Width
        .biHeight = mImgInfo.Height
        mScanBytes = (.biWidth + 3) And &H7FFFFFFC
        .biSizeImage = mScanBytes * .biWidth
        
        If .biWidth > 0 And .biHeight > 0 Then
            ReDim mMapData(0 To .biSizeImage - 1)
        Else
            mScanBytes = 0
        End If
        
    End With
    
    If mScanBytes > 0 Then
        'GIF-LZW解码
        Dim StrAdd(0 To &H1000) As Byte '新增加的那个字节（比上层节点多的那个字节）
        Dim Parent(0 To &H1000) As Integer '父节点的索引指针
        Dim Level(0 To &H1000) As Integer '当前节点共有多少层（当前节点有多少字节数据）
        Dim TableSize As Long
        Dim TableMaxSize As Long
        Dim BufCode(0 To &H1000) As Byte '单个编码解压的缓冲区
        Dim cbBufCode As Long
        Dim CurBits As Long
        Dim LZW_CLEAR As Integer
        Dim LZW_EOI As Integer
        Dim CurCode As Long
        Dim OldCode As Integer
        'Dim CurByte As Byte
        Dim TempIdx As Integer
        Dim f As Boolean
        '模拟指针
        Dim CurPtr As Long
        Dim ScanPtr As Long
        '缓冲区
        Dim BitBuff As Long
        Dim BitUsed As Long
        Dim BufLZW() As Byte
        Dim BufLZWPos As Long
        Dim BufLZWSize As Long
        '其他
        Dim X As Long, Y As Long
        Dim I As Long
        
        '分配缓冲区
        BufLZWSize = mLZWS.PeekData(BufLZW)
        BufLZWPos = 0
        BitBuff = 0
        BitUsed = 0
        If BufLZWSize > 0 Then
            '初始化LZW字符串表
            LZW_CLEAR = BitPosMask(LZW_MinCodeLen) '2 ^ LZW_MinCodeLen '1<<LZW_MinCodeLen
            LZW_EOI = LZW_CLEAR + 1
            CurBits = LZW_MinCodeLen + 1
            'GoSub GetNextCode
                Do While BitUsed < CurBits
                    BitBuff = BitBuff Or (BufLZW(BufLZWPos) * BitPosMask(BitUsed)) 'TempCode |= BufLZW(BufLZWPos)<<BitBuff
                    BufLZWPos = BufLZWPos + 1
                    If BufLZWPos >= BufLZWSize Then GoTo DecodeEnd
                    BitUsed = BitUsed + 8
                Loop
                CurCode = BitBuff And BitsMask(CurBits)
                BitBuff = BitBuff \ BitPosMask(CurBits)
                BitUsed = BitUsed - CurBits
            
            OldCode = CurCode
            If OldCode = LZW_CLEAR Then '正确的编码
                'GoSub InitStrTable
                    CurBits = LZW_MinCodeLen + 1
                    TableSize = LZW_EOI + 1
                    TableMaxSize = 2 ^ CurBits
                    Call ZeroMemory(StrAdd(0), &H1000)
                    Call ZeroMemory(Parent(0), &H2000)
                    Call ZeroMemory(Level(0), &H2000)
                
                '初始化位图
                Y = 0
                X = 0
                ScanPtr = VarPtr(mMapData(0)) + (mBI.bmiHeader.biHeight - 1) * mScanBytes  'DIB是逆序存储
                CurPtr = ScanPtr
                
                '正式开始
                Do
                    If CurCode = LZW_CLEAR Then
                        'GoSub InitStrTable
                            CurBits = LZW_MinCodeLen + 1
                            TableSize = LZW_EOI + 1
                            TableMaxSize = 2 ^ CurBits
                            Call ZeroMemory(StrAdd(0), &H1000)
                            Call ZeroMemory(Parent(0), &H2000)
                            Call ZeroMemory(Level(0), &H2000)
                        Do