PicGIF.cls

   1 ' PicInfo GIF file information class
   2 ' 2006 Aivosto Oy (www.aivosto.com)
   3 '
   4 ' This file is part of a sample project for Project Analyzer.
   5 ' Distribution of this file is only allowed along with Project Analyzer
   6 ' according to the Project Analyzer license terms.
   7 
   8 Option Explicit
   9 
  10 Implements IPicInfo
  11 
  12 Private StoredFilename As String ' Filename used in the previous call to ReadFile
  13 
  14 ' FileOK is a flag indicating whether a valid GIF file has been read
  15 ' True - The variables below contain valid data
  16 ' False - The variables below contain undefined data and should not be used
  17 Private FileOK As Boolean
  18 
  19 ' Brief introduction to GIF file structure
  20 '
  21 ' Every GIF file starts with the following bytes:
  22 ' 6 bytes for Signature (either GIF87a or GIF89a in ASCII)
  23 ' 7 bytes for LogicalScreenDescriptor
  24 
  25 Private Signature As String * 6  ' GIF87a, GIF89a
  26 
  27 Private Type TLogicalScreenDescriptor
  28     Width As Integer             ' uint - Width, in pixels
  29     Height As Integer            ' uint - Height, in pixels
  30     Packed As Byte               ' Byte packed with color information

   ! Type field written, not read: TLogicalScreenDescriptor.BackgroundColorIndex - 0 reads, 1 write
  31     BackgroundColorIndex As Byte ' Background Color index to Global Color Table

   ! Type field written, not read: TLogicalScreenDescriptor.PixelAspectRatio - 0 reads, 1 write
  32     PixelAspectRatio As Byte     ' Approximation of aspect ratio of pixel in the original image
  33 End Type
  34 Private LogicalScreenDescriptor As TLogicalScreenDescriptor ' Storage for LogicalScreenDescriptor
  35 Private MaxColors As Long        ' Maximum number of colors in .gif
  36 
  37 Private Function UInt(ByVal i As Integer) As Long
  38 ' Convert integer to unsigned integer
  39 ' [i] Signed integer to convert to an unsigned value
  40 ' Return value:
  41 ' Unsigned integer (fits in the Long datatype)
  42 
  43 If i < 0 Then
  44     UInt = 65536 + i
  45 Else
  46     UInt = i
  47 End If
  48 
  49 End Function
  50 
  51 
  52 
  53 Private Function ReadGIF(ByVal GIFFilename As String) As Boolean
  54 ' Reads a GIF file and retrieves image information
  55 ' [GIFFilename] Name of file to read
  56 ' Return value:
  57 ' True - GIF file was read and information retrieved
  58 ' False - Error or invalid file
  59 
  60 Dim ColorResolution As Integer   ' Number of color bits in the file (1..8)
  61 Dim FileNr As Integer            ' Number of open data file
  62 
  63 StoredFilename = GIFFilename ' Store Filename for later retrieval
  64 FileOK = False               ' Clear the FileOK flag until we have successfully read a valid .gif file
  65 
  66 ' Open the .gif file for binary read access
  67 FileNr = FreeFile
  68 Open GIFFilename For Binary Access Read Lock Write As #FileNr
  69 
  70 If LOF(FileNr) > Len(Signature) + Len(LogicalScreenDescriptor) Then
  71     ' The file size is "enough"
  72     
  73     ' Read 6 GIF signature bytes, which must be either GIF87a or GIF89a in ASCII
  74     Get #FileNr, 1, Signature
  75     If Signature = "GIF87a" Or Signature = "GIF89a" Then
  76         ' Signature bytes OK
  77         
  78         ' Read logical screen descriptor, which contains picture size and color info
  79         Get #FileNr, , LogicalScreenDescriptor
  80         
  81         ' Determine max number of colors
  82         ColorResolution = (LogicalScreenDescriptor.Packed And (64 + 32 + 16)) \ 16 + 1
  83         MaxColors = 2 ^ ColorResolution
  84         
  85         FileOK = True
  86         ReadGIF = True
  87     End If
  88 End If
  89 Close FileNr

    Assigned value not used: FileNr - Integer
  90 FileNr = 0
  91 
  92 End Function
  93 
  94 
  95 

   ! Dead procedure
  96 Friend Property Get Version() As String
  97 ' Returns GIF format version (either "GIF87a" or "GIF89a")
  98 
  99 ' This procedure is not used by the sample project
 100 ' Project Analyzer reports it as a dead procedure
 101 
 102 If FileOK Then
 103     Version = Signature
 104 End If
 105 
 106 End Property
 107 
 108 
 109 Private Property Get IPicInfo_Filename() As String
 110 ' Returns the filename used in the previous call to ReadFile
 111 
 112 IPicInfo_Filename = StoredFilename
 113 
 114 End Property
 115 
 116 Private Property Get IPicInfo_MaxColors() As Variant
 117 ' Returns the maximum number of colors possible to represent in picture
 118 
 119 If FileOK Then
 120     ' We have the color information available
 121     IPicInfo_MaxColors = MaxColors
 122 End If
 123 
 124 End Property
 125 
 126 Private Function IPicInfo_ReadFile(ByVal Filename As String) As Boolean
 127 ' Read a picture file to retrieve picture information
 128 ' [Filename] File to read
 129 ' Return value:
 130 ' True - Picture information retrieved
 131 ' False - Error, information not retrieved
 132 
 133 IPicInfo_ReadFile = ReadGIF(Filename)
 134 
 135 End Function
 136 
 137 
 138 Private Property Get IPicInfo_Size() As TPicSize
 139 ' Returns picture width and height in pixels
 140 
 141 If FileOK Then
 142     ' We have retrieved the picture size
 143     
 144     ' As the width and height are unsigned integers but VB6 supports no unsigned integer datatype,
 145     ' we need to convert the values with UInt() before returning to caller.
 146     IPicInfo_Size.Width = UInt(LogicalScreenDescriptor.Width)
 147     IPicInfo_Size.Height = UInt(LogicalScreenDescriptor.Height)
 148 End If
 149 
 150 End Property
 151 
 152 
 153