Attribute VB_Name = "PicGIF" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = True Attribute VB_PredeclaredId = False Attribute VB_Exposed = True ' PicInfo GIF file information class ' ©2006 Aivosto Oy (www.aivosto.com) ' ' This file is part of a sample project for Project Analyzer. ' Distribution of this file is only allowed along with Project Analyzer ' according to the Project Analyzer license terms. Option Explicit Implements IPicInfo Private StoredFilename As String ' Filename used in the previous call to ReadFile ' FileOK is a flag indicating whether a valid GIF file has been read ' True - The variables below contain valid data ' False - The variables below contain undefined data and should not be used Private FileOK As Boolean ' Brief introduction to GIF file structure ' ' Every GIF file starts with the following bytes: ' 6 bytes for Signature (either GIF87a or GIF89a in ASCII) ' 7 bytes for LogicalScreenDescriptor Private Signature As String * 6 ' GIF87a, GIF89a Private Type TLogicalScreenDescriptor Width As Integer ' uint - Width, in pixels Height As Integer ' uint - Height, in pixels Packed As Byte ' Byte packed with color information BackgroundColorIndex As Byte ' Background Color index to Global Color Table PixelAspectRatio As Byte ' Approximation of aspect ratio of pixel in the original image End Type Private LogicalScreenDescriptor As TLogicalScreenDescriptor ' Storage for LogicalScreenDescriptor Private MaxColors As Long ' Maximum number of colors in .gif Private Function UInt(ByVal i As Integer) As Long ' Convert integer to unsigned integer ' [i] Signed integer to convert to an unsigned value ' Return value: ' Unsigned integer (fits in the Long datatype) If i < 0 Then UInt = 65536 + i Else UInt = i End If End Function Private Function ReadGIF(ByVal GIFFilename As String) As Boolean ' Reads a GIF file and retrieves image information ' [GIFFilename] Name of file to read ' Return value: ' True - GIF file was read and information retrieved ' False - Error or invalid file Dim ColorResolution As Integer ' Number of color bits in the file (1..8) Dim FileNr As Integer ' Number of open data file StoredFilename = GIFFilename ' Store Filename for later retrieval FileOK = False ' Clear the FileOK flag until we have successfully read a valid .gif file ' Open the .gif file for binary read access FileNr = FreeFile Open GIFFilename For Binary Access Read Lock Write As #FileNr If LOF(FileNr) > Len(Signature) + Len(LogicalScreenDescriptor) Then ' The file size is "enough" ' Read 6 GIF signature bytes, which must be either GIF87a or GIF89a in ASCII Get #FileNr, 1, Signature If Signature = "GIF87a" Or Signature = "GIF89a" Then ' Signature bytes OK ' Read logical screen descriptor, which contains picture size and color info Get #FileNr, , LogicalScreenDescriptor ' Determine max number of colors ColorResolution = (LogicalScreenDescriptor.Packed And (64 + 32 + 16)) \ 16 + 1 MaxColors = 2 ^ ColorResolution FileOK = True ReadGIF = True End If End If Close FileNr FileNr = 0 End Function Friend Property Get Version() As String ' Returns GIF format version (either "GIF87a" or "GIF89a") ' This procedure is not used by the sample project ' Project Analyzer reports it as a dead procedure If FileOK Then Version = Signature End If End Property Private Property Get IPicInfo_Filename() As String ' Returns the filename used in the previous call to ReadFile IPicInfo_Filename = StoredFilename End Property Private Property Get IPicInfo_MaxColors() As Variant ' Returns the maximum number of colors possible to represent in picture If FileOK Then ' We have the color information available IPicInfo_MaxColors = MaxColors End If End Property Private Function IPicInfo_ReadFile(ByVal Filename As String) As Boolean ' Read a picture file to retrieve picture information ' [Filename] File to read ' Return value: ' True - Picture information retrieved ' False - Error, information not retrieved IPicInfo_ReadFile = ReadGIF(Filename) End Function Private Property Get IPicInfo_Size() As TPicSize ' Returns picture width and height in pixels If FileOK Then ' We have retrieved the picture size ' As the width and height are unsigned integers but VB6 supports no unsigned integer datatype, ' we need to convert the values with UInt() before returning to caller. IPicInfo_Size.Width = UInt(LogicalScreenDescriptor.Width) IPicInfo_Size.Height = UInt(LogicalScreenDescriptor.Height) End If End Property
Hide code	Visustin flow chart for VB