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