It's ready to be compiled into components, and PNG is supported.
' I have released this source code into the public domain. Use it
' With no strings attached.
' Just call getimagesize with a string containing the filename, and
' It'll return a user defined type ' imagesize ' ("below")
' Return values of 0 indicate an error of some sort. The error handling
' In this module is limited. There is *no* error handling on the test
' Form. This routine are limited to X or Y sizes of 32767 pixels, but
' should not to be a problem.
' Check back at HTTP://WWW.QTM.NET/~DAVIDC
' I may add support for the more file types.
' Supported in ' version:
' JPEG
' GIF
' PNG
' This routine does is not require any royalty fees for Unisys as it
' Does nothing with the compressed part of GIF files. It simply Reads
' 4 bytes to determine image size.
Option Explicit
Public WiMG as Long
Public himg as Long
Public Type ImageSize
Width as Long
Height as Long
End Type
Public Sub getimagesize (sfilename as String)
On the Error Resume Next ' ll want to the change this
Dim IFN as Integer
Dim Btemp (3) as Byte
Dim Lflen as Long
Dim Lpos as Long
Dim BHMSB as Byte
Dim BHLSB as Byte
Dim BWMSB as Byte
Dim BWLSB as Byte
Dim Bbuf (7) as Byte
Dim Bdone as Byte
Dim Icount as Integer
Lflen = FileLen (sfilename)
IFN = FreeFile
Open sfilename for Binary as IFN
Get #iFN, 1, btemp ()
' PNG file
If btemp (0) = &h89 and btemp (1) = &h50 and btemp (2) = &h4e _
and Btemp (3) = &h47 Then
Get #iFN, BWMSB
Get #iFN, BWLSB
Get #iFN, BHMSB
Get #iFN, BHLSB
' Getimagesize.width = Combinebytes (BWLSB, BWMSB)
' Getimagesize.height = Combinebytes (BHLSB, BHMSB)
WiMG = Combinebytes (BWLSB, BWMSB)
himg = Combinebytes (BHLSB, BHMSB)
End If
' GIF file
If btemp (0) = &h47 and btemp (1) = &h49 and btemp (2) = &h46 _
and Btemp (3) = &h38 Then
Get #iFN, 7, BWLSB
Get #iFN, 8, BWMSB
Get #iFN, 9, BHLSB
Get #iFN, BHMSB
' Getimagesize.width = Combinebytes (BWLSB, BWMSB)
' Getimagesize.height = Combinebytes (BHLSB, BHMSB)
WiMG = Combinebytes (BWLSB, BWMSB)
himg = Combinebytes (BHLSB, BHMSB)
End If
' JPEG file
If btemp (0) = &hff and btemp (1) = &hd8 and btemp (2) = &hff Then
Debug.Print "JPEG"
Lpos = 3
Todo
Todo
Get #iFN, Lpos, Bbuf (1)
Get #iFN, Lpos + 1, bbuf (2)
Lpos = lpos + 1
Loop Until (bbuf (1) = &hff and Bbuf (2) <> &hff) Or lpos > Lflen
For icount = 0 to 7
Get #iFN, Lpos + icount, Bbuf (icount)
Next icount
If bbuf (0) >= &hc0 and bbuf (0) <= &hc3
BHMSB = Bbuf (4)
BHLSB = Bbuf (5)
BWMSB = Bbuf (6)
BWLSB = Bbuf (7)
Bdone = 1
Else
Lpos = Lpos + (Combinebytes (Bbuf (2), BBUF (1)) + 1
End If
Loop while Lpos < Lflen and Bdone = 0
' Getimagesize.width = Combinebytes (BWLSB, BWMSB)
' Getimagesize.height = Combinebytes (BHLSB, BHMSB)
WiMG = Combinebytes (BWLSB, BWMSB)
himg = Combinebytes (BHLSB, BHMSB)
End If
Close IFN
End Sub
Private Function combinebytes (lsb as Byte, MSB as Byte) as Long
Combinebytes = CLng (LSB + (MSB * 256))
End Function
The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion;
products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the
content of the page makes you feel confusing, please write us an email, we will handle the problem
within 5 days after receiving your email.
If you find any instances of plagiarism from the community, please send an email to:
info-contact@alibabacloud.com
and provide relevant evidence. A staff member will contact you within 5 working days.