?? cgifparser.cls
字號:
If Not (g87aStart = 0 Or gColorsUsed = 0) Then ' we have a valid gif frame
' rebuild the GIF file to include only the 1st frame read
aPointer = gHeaderLen
If g89aStart > 0 Then ' gif is 89a format
' resize array, copy header info & gif89a info
ReDim c_GIFbytes(0 To gHeaderLen + (g87aStop - g87aStart + 1) + 8)
CopyMemory c_GIFbytes(0), c_GIFdata(0), gHeaderLen
CopyMemory c_GIFbytes(gHeaderLen), c_GIFdata(g89aStart), 8
aPointer = aPointer + 8 ' adjust pointer for gif87a info
Else
' resize array and copy header info only
ReDim c_GIFbytes(0 To gHeaderLen + (g87aStop - g87aStart + 1))
CopyMemory c_GIFbytes(0), c_GIFdata(0), gHeaderLen
End If
' now copy the gif 87a info
CopyMemory c_GIFbytes(aPointer), c_GIFdata(g87aStart), g87aStop - g87aStart + 1
c_GIFbytes(UBound(c_GIFbytes)) = 59 ' trailer/end of file
' fix up the left/top & width/height of overall frame
CopyMemory c_GIFbytes(aPointer + 1), 0&, &H4 ' make frame left/top zero
CopyMemory c_GIFbytes(6), c_GIFbytes(aPointer + 5), &H4 ' make window & frame size same
If transUsed = 1 Then
' Fix up the color table/indexes for images with transparency
' Why? Instead of parsing/decompressing the GIF, we will allow an API to do it for us.
' But that API can re-index the GIF which means we may lose track of the transparency
' color/index. This happens whenever any color in the GIF's palette is duplicated.
' To prevent this from occuring, we simply replace the GIF's palette with another
' palette of non-duplicated entries. Then use the original palette after the API is done
If aLocalTbl = 1 Then ' local color table else global
' local color table starts 10 bytes after the gif87a block
aPointer = gHeaderLen + 10 ' location of table within single frame array
aLocalTbl = g87aStart + 10 ' location of table within souce array
' offset single frame array when gif89a structure is used
If Not g89aStart = 0 Then aPointer = aPointer + 8
Else
aPointer = 13 ' global table location
aLocalTbl = 13 ' same in both arrays
End If
For p = 1 To gColorsUsed - 1
gLong = p * 3&
uniquePalette(gLong) = p
uniquePalette(gLong + 1) = p
uniquePalette(gLong + 2) = p
Next
' replace the old palette with the new one
CopyMemory c_GIFbytes(aPointer), uniquePalette(0), gColorsUsed * 3&
Erase uniquePalette()
Else
TransIndex = -1
End If
' all done parsing the GIF file, send it to routine to convert it to a 32bpp
ParseGIF = ConvertGIFto32bpp(TransIndex, aLocalTbl, cHost)
End If
ExitReadRoutine:
Erase c_GIFbytes() ' bytes no longer needed
If Err Then
Err.Clear ' this is a GIF format, but the format is invalid
cHost.DestroyDIB ' something is wrong; don't allow it to continue
ParseGIF = True ' to other parsers
End If
End Function
Private Sub SkipGifBlock(ByRef Ptr As Long)
' Routine skips a block of data within the GIF file
Dim curByte As Byte
curByte = c_GIFdata(Ptr)
Do While curByte > 0
Ptr = Ptr + curByte + 1
curByte = c_GIFdata(Ptr)
Loop
Ptr = Ptr + 1
End Sub
Private Function ConvertGIFto32bpp(TransIndex As Long, tblOffset As Long, cHost As c32bppDIB) As Boolean
Dim tPic As StdPicture, tBMP As BITMAP
' used for parsing a transparent gif
Dim X As Long, Y As Long, m As Long, dX As Long, Index As Long
Dim gSA As SafeArray, dSA As SafeArray
Dim Pow2(0 To 8) As Long, dibBytes() As Byte, gifBytes() As Byte
Dim maskShift As Long, maskAND As Long
Dim hostDC As Long
' first: have API create a stdPicture for us
Set tPic = iparseArrayToPicture(c_GIFbytes, 0, UBound(c_GIFbytes) + 1)
If Not tPic Is Nothing Then
' a VB stdPicture is a DIB, therefore it has a handle to the DIB bits; get it
GetGDIObject tPic.Handle, Len(tBMP), tBMP
If Not tBMP.bmBits = 0 Then
' have host create application's 32bpp DIB
cHost.InitializeDIB tBMP.bmWidth, tBMP.bmHeight
' we only need to parse the palette & indexes if transparency is used
If TransIndex = -1 Then
hostDC = cHost.LoadDIBinDC(True)
tPic.Render hostDC + 0&, 0&, 0&, tBMP.bmWidth + 0&, tBMP.bmHeight + 0&, _
0&, tPic.Height, tPic.Width, -tPic.Height, ByVal 0&
cHost.LoadDIBinDC False
With dSA
.cbElements = 1
.cDims = 2
.pvData = cHost.BitsPointer
.rgSABound(0).cElements = cHost.Height
.rgSABound(1).cElements = cHost.scanWidth
End With
CopyMemory ByVal VarPtrArray(dibBytes), VarPtr(dSA), 4&
For Y = 0 To tBMP.bmHeight - 1
For X = 3 To cHost.scanWidth - 1 Step 4
dibBytes(X, Y) = 255
Next
Next
CopyMemory ByVal VarPtrArray(dibBytes), 0&, 4&
Else
' next: getting ready to parse the paletted stdPic
Pow2(0) = 1
For X = 1 To tBMP.bmBitsPixel ' power of 2 array
Pow2(X) = Pow2(X - 1) * 2
Next
maskAND = Pow2(tBMP.bmBitsPixel) - 1 ' AND mask for stdPic indexes
' we need to overlay arrays onto the stdPic and the host's DIB pointers
With gSA
.cbElements = 1
.cDims = 2
.pvData = tBMP.bmBits
.rgSABound(0).cElements = tBMP.bmHeight
.rgSABound(1).cElements = iparseByteAlignOnWord(tBMP.bmBitsPixel, tBMP.bmWidth)
End With
With dSA
.cbElements = 1
.cDims = 2
.pvData = cHost.BitsPointer
.rgSABound(0).cElements = cHost.Height
.rgSABound(1).cElements = cHost.scanWidth
End With
CopyMemory ByVal VarPtrArray(gifBytes), VarPtr(gSA), 4&
CopyMemory ByVal VarPtrArray(dibBytes), VarPtr(dSA), 4&
' last: start parsing stdPic's paletted DIB
For Y = 0 To tBMP.bmHeight - 1
dX = 0: m = 0 ' reset dX=host DIB's X & M=stdPic DIB's X
maskShift = 8 - tBMP.bmBitsPixel ' 1st bit to process
' note: do not loop thru using gif ScanWidth. If the GIF
' width is not DWORD ligned , you will overflow the target
' DIB width and eventually write to uninitialized memory
For X = 1 To tBMP.bmWidth
' get the palette index by shifting bits
Index = ((gifBytes(m, Y) \ Pow2(maskShift)) And maskAND)
If Not Index = TransIndex Then ' 100% opaque else 100% transparent
Index = Index * 3 + tblOffset
dibBytes(dX, Y) = c_GIFdata(Index + 2) ' make BGR vs RGB
dibBytes(dX + 1, Y) = c_GIFdata(Index + 1)
dibBytes(dX + 2, Y) = c_GIFdata(Index)
dibBytes(dX + 3, Y) = 255
End If
' adjust for parsing/shifting the next index
If maskShift = 0 Then
maskShift = 8 - tBMP.bmBitsPixel ' start new byte
m = m + 1 ' next stdPic byte
Else
maskShift = maskShift - tBMP.bmBitsPixel ' adjust
End If
dX = dX + 4 ' next Host pixel
Next
Next
' done, remove overlays
CopyMemory ByVal VarPtrArray(gifBytes), 0&, 4&
CopyMemory ByVal VarPtrArray(dibBytes), 0&, 4&
cHost.Alpha = True
End If
cHost.ImageType = imgGIF
ConvertGIFto32bpp = True
End If
End If
End Function
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -