Private priECT() As Byte 'Bit64编码表 Private priDCT() As Byte 'Bit64解码表 Private Const pubECT_Text As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" Private Sub Command1_Click() Dim tSurBytes() As Byte Dim tEnCodeBytes() As Byte Dim tDeCodeBytes() As Byte ReDim tSurBytes(1151) WordsPrintScan Form1,tSurBytes() Msg<a href="/tag/Box/" target="_blank" class="keywords">Box</a> tSurBytes(1) tEnCodeBytes() = BytesEnCode(tSurBytes(),priECT()) tDeCodeBytes() = BytesDeCode(tEnCodeBytes(),priDCT()) Msg<a href="/tag/Box/" target="_blank" class="keywords">Box</a> tSurBytes(1) Debug.Print StrConv(tEnCodeBytes(),vbUnicode) Msg<a href="/tag/Box/" target="_blank" class="keywords">Box</a> tDeCodeBytes(0) WordsDraw Form1,tSurBytes() End Sub Private Sub Form_Load() With Form1 .AutoRedraw = True .Show .ForeColor = &HFFFFFF .BackColor = &H0 .ScaleMode = 3 End With priECT() = StrConv(pubECT_Text,vbFromUnicode) '建立编码表 priDCT() = DeCodeTableCreate(priECT()) '建立解码表 End Sub Sub WordsDraw(ByRef pForm As Form,ByRef pBytes() As Byte) Dim tANSICode As Byte Dim tANSICodeIndex As Long Dim tStartX As Long,tStartY As Long,tX As Long,tY As Long,tBitIndex As Long For tANSICodeIndex = 0 To 95 tStartX = (tANSICodeIndex Mod 16) * 6 tStartY = (tANSICodeIndex / 16) * 12 pBitStart = tANSICodeIndex * 72 For tYIndex = 0 To 11 For tXIndex = 0 To 5 tX = tXIndex + tStartX tY = tYIndex + tStartY tBitIndex = tYIndex * 6 + tXIndex + pBitStart tBitValue = BitGetByBytes(pBytes(),tBitIndex) pForm.PSet (tX,tY),CBool(tBitValue) And &HFF0000 Next Next Next End Sub Sub WordsPrintScan(ByRef pForm As Form,ByRef pBytes() As Byte) Dim tANSICode As Byte Dim tANSICodeIndex As Long Dim tX As Long,tBitIndex As Long For tANSICodeIndex = 0 To 95 tX = tANSICodeIndex Mod 16 tY = tANSICodeIndex / 16 tANSICode = tANSICodeIndex + 32 With pForm .CurrentX = tX * 6 .CurrentY = tY * 12 End With pForm.Print Chr(tANSICode) tBitIndex = tANSICodeIndex * 72 FontWordScan pForm,pBytes(),tX * 6,tY * 12,tBitIndex Next End Sub Sub FontWordScan(ByRef pForm As Form,ByRef pBytes() As Byte,ByVal pX,ByVal pY,ByVal pBitStart As Long) Dim tXIndex As Long,tX As Long Dim tYIndex As Long,tY As Long Dim tBitIndex As Long,tBitValue As Byte Dim tColor As Long For tYIndex = 0 To 11 For tXIndex = 0 To 5 tBitIndex = tYIndex * 6 + tXIndex + pBitStart tX = tXIndex + pX tY = tYIndex + pY tColor = pForm.Point(tX,tY) tBitValue = CBool(tColor) And 1 BitSetToBytes pBytes(),tBitIndex,tBitValue Next Next End Sub Function DeCodeTableCreate(ByRef pECT() As Byte) As Byte() Dim tOutBytes() As Byte Dim tECTIndex As Long,tECTLength As Long tECTLength = UBound(pECT()) ReDim tOutBytes(255) For tECTIndex = 0 To tECTLength tOutBytes(pECT(tECTIndex)) = tECTIndex Next DeCodeTableCreate = tOutBytes() End Function Function BytesDeCode(ByRef pBytes() As Byte,ByRef pDCT() As Byte) As Byte() Dim tOutBytes() As Byte Dim tBytesLength As Long,tBytesIndex As Long tBytesLength = UBound(pBytes()) ReDim tOutBytes(tBytesLength) For tBytesIndex = 0 To tBytesLength tOutBytes(tBytesIndex) = pDCT(pBytes(tBytesIndex)) Next BytesDeCode = tOutBytes() End Function Function BytesEnCode(ByRef pBytes() As Byte,ByRef pECT() As Byte) As Byte() Dim tOutBytes() As Byte Dim tBytesLength As Long,tBytesIndex As Long tBytesLength = UBound(pBytes()) ReDim tOutBytes(tBytesLength) For tBytesIndex = 0 To tBytesLength tOutBytes(tBytesIndex) = pECT(pBytes(tBytesIndex)) Next BytesEnCode = tOutBytes() End Function Sub BitSetToBytes(ByRef pBytes() As Byte,ByVal pBitIndex As Long,ByVal pBitValue As Byte) Dim tByteIndex As Long Dim tBitIndex As Long,tBitMask As Byte tByteIndex = pBitIndex / 6 tBitIndex = pBitIndex Mod 6 tBitMask = 2 ^ tBitIndex pBytes(tByteIndex) = (pBytes(tByteIndex) And (Not tBitMask)) + (tBitMask And CBool(pBitValue)) End Sub Function BitGetByBytes(ByRef pBytes() As Byte,ByVal pBitIndex As Long) As Byte Dim tByteIndex As Long Dim tBitIndex As Long,tBitMask As Byte tByteIndex = pBitIndex / 6 tBitIndex = pBitIndex Mod 6 tBitMask = 2 ^ tBitIndex BitGetByBytes = CBool(pBytes(tByteIndex) And tBitMask) And 1 End Function