|
Public Type BITMAPINFO
Width As Long Height As Long End Type Public Function GetJPGInfo(ByVal FileName As String) As BITMAPINFO Dim bChar As Byte Dim a As Byte, b As Byte Dim c As Byte, D As Byte Dim E As Byte, f As Byte Dim i As Integer Dim DotPos As Integer Dim Header As String Dim blExit As Boolean Dim MarkerLen As Long 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) Get #fnum, , bChar Header = Hex$(bChar) Get #fnum, , bChar Header = Header & Hex$(bChar) If Header <> "FFD8" Then Exit Function While Not blExit Do Until Hex$(bChar) = "FF" Get #fnum, , bChar Loop Get #fnum, , bChar If Hex$(bChar) >= "C0" And _ Hex$(bChar) <= "C3" Then Get #fnum, , bChar Get #fnum, , bChar Get #fnum, , bChar Get #fnum, , bChar a = bChar Get #fnum, , bChar b = bChar Get #fnum, , bChar c = bChar Get #fnum, , bChar D = bChar ImgHeight = CInt(a * 256 + b) ImgWidth = CInt(c * 256 + D) blExit = True Else If Hex$(bChar) = "DA" Then blExit = True Else Get #fnum, , bChar E = bChar Get #fnum, , bChar f = bChar MarkerLen = (E * 256 + f) - 2 Dim marker As String marker = String(MarkerLen, vbNullChar) Get #fnum, , marker End If End If Wend Close #fnum With ImageInfo .Width = ImgWidth .Height = ImgHeight End With GetJPGInfo = ImageInfo End Function |