Option Explicitpublic WIMG As Longpublic HIMG AS Longpublic Type ImageSizeWidth As LongHeight As Longend Type
Public Sub GetImageSize (sFileName As String) On Error Resume Next 'you'll want to change thisDim iFN As IntegerDim bTemp (3) As ByteDim lFlen As LongDim lPos As LongDim bHmsb As ByteDim bHlsb As ByteDim bWmsb As ByteDim bWlsb As ByteDim bBuf (7 ) AS BYTEDIM BDONE AS BYTEDIM ICOUNT AS INTEGER
Lflen = filelen (sfilename) IFN = freefileopen sfilename for binary as ifnget #ifn, 1, btemp ()
'Png fileif btemp (0) = & h89 and btemp (1) = & h50 and btemp (2) = & h4e _and btemp (3) = & h47 Thenget #1, 19, bwmsbget #ifn, 20, bwlsbget #1, 23, bhmsbget # iFN, 24, bHlsb'GetImageSize.Width = CombineBytes (bWlsb, bWmsb) 'GetImageSize.Height = CombineBytes (bHlsb, bHmsb) WImg = CombineBytes (bWlsb, bWmsb) HImg = CombineBytes (bHlsb, bHmsb) End If
'Gif fileif btemp (0) = & h47 and btemp (1) = & h49 and btemp (2) = & h46_and btemp (3) = & h38 Thenget # IFN, 7, BWMSBGET #1, 8, bwmsbget #1, 9, bhlsbget # iFN, 10, bHmsb'GetImageSize.Width = CombineBytes (bWlsb, bWmsb) 'GetImageSize.Height = CombineBytes (bHlsb, bHmsb) WImg = CombineBytes (bWlsb, bWmsb) HImg = CombineBytes (bHlsb, bHmsb) End If
'JPEG Fileif Btemp (0) = & HFF and Btemp (1) = & HD8 and Btemp (2) = & HFF Thendebug.print "JPEG" LPOS = 3Dodoget #1, LPOS, BBUF (1) Get # IFN, LPOS 1, BBUF (2) LPOS = LPOS 1LOOP Until (BBUF (1) = & HFF AND BBUF (2) <> & HFF) Or LPOS> LFLEN
For iCount = 0 to 7Get #1, LPOS ICOUNT, BBUF (ICOUNT) Next ICOUNTIF BBUF (0)> = & hc0 and bbuf (0) <= & hc3 damhmsb = bbuf (4) bhlsb = bbuf (5) bwmsb = bbuf ( 6) bwlsb = bbuf (7) bdone = 1ELSELPOS = LPOS (BBUF (2), BBUF (1))))) 1End ifloop While LPOS