Zjištění informací o GIF obrázku
Do deklarační části formuláře zapište:
Private Type BITMAPINFO
Width As Long
Height As Long
End Type
Private Function GetGIFInfo(ByVal FileName As String) As BITMAPINFO
Dim bChar As Byte
Dim i As Integer
Dim DotPos As Integer
Dim Header As String
Dim blExit As Boolean
Dim a As String, b As String
Dim ImgWidth As Integer
Dim ImgHeight As Integer
Dim ImgSize As String
Dim fnum As Integer
Dim ImageInfo As BITMAPINFO
On Error Resume Next
fnum = FreeFile
Open FileName For Binary As #fnum
ImgSize = LOF(fnum) / 1024
DotPos = InStr(ImgSize, ",")
ImgSize = Left(ImgSize, DotPos - 1) '& "," _
& Left(Right(ImgSize,Len(ImgSize) - DotPos), 2)
For i = 0 To 5
Get #fnum, , bChar
Header = Header + Chr(bChar)
Next i
If Left(Header, 3) <> "GIF" Then
MsgBox FileName & ": není soubor GIF."
Close #fnum
Exit Function
End
End If
Get #fnum, , bChar
a = a + Chr(bChar)
Get #fnum, , bChar
a = a + Chr(bChar)
ImgWidth = CInt(Asc(Left(a, 1)) + 256 * Asc(Right(a, 1)))
Get #fnum, , bChar
b = b + Chr(bChar)
Get #fnum, , bChar
b = b + Chr(bChar)
ImgHeight = CInt(Asc(Left(b, 1)) + 256 * Asc(Right(b, 1)))
Close #fnum
With ImageInfo
.Width = ImgWidth
.Height = ImgHeight
End With
GetGIFInfo = ImageInfo
End Function
Na formulář přidejte
tlačítko a na jeho událost Click:
Private Sub Command1_Click()
Dim ABC As BITMAPINFO
ABC = GetGIFInfo("d:\transit\ponte.gif")
Debug.Print CStr(ABC.Height) + "x" + CStr(ABC.Width)
End Sub