Reads image dimensions, width, height, depth and image type.
Details returned inside passed parameters.
Expected to work for jpg, gif, bmp and png.
Function ImgDimensions(imgFileName, imgWidth, imgHeight, imgDepth, imgType)
' Returns image width, height, depth and type for a given image
' Passing full image path with extension, it will return all these details as they passed to function.
' Types found are, "GIF", "BMP", "PNG", "JPG", or unknown
'
' Needs ReadFileBytes, L_R256 and R_L256
Dim strPNG
Dim strGIF
Dim strBMP
Dim strType
strType = ""
imgType = "(unknown)"
ImgDimensions = False
strPNG = Chr(137) & Chr(80) & Chr(78)
strGIF = "GIF"
strBMP = Chr(66) & Chr(77)
strType = ReadFileBytes(imgFileName, 0, 3)
If strType = strGIF Then ' is GIF
imgType = "GIF"
imgWidth = L_R256(ReadFileBytes(imgFileName, 7, 2))
imgHeight = L_R256(ReadFileBytes(imgFileName, 9, 2))
imgDepth = 2 ^ ((Asc(ReadFileBytes(imgFileName, 11, 1)) And 7) + 1)
ImgDimensions = True
ElseIf left(strType, 2) = strBMP Then ' is BMP
imgType = "BMP"
imgWidth = L_R256(ReadFileBytes(imgFileName, 19, 2))
imgHeight = L_R256(ReadFileBytes(imgFileName, 23, 2))
imgDepth = 2 ^ (asc(ReadFileBytes(imgFileName, 29, 1)))
ImgDimensions = True
ElseIf strType = strPNG Then ' Is PNG
imgType = "PNG"
imgWidth = R_L256(ReadFileBytes(imgFileName, 19, 2))
imgHeight = R_L256(ReadFileBytes(imgFileName, 23, 2))
imgDepth = ReadFileBytes(imgFileName, 25, 2)
Select Case Asc(right(imgDepth,1))
Case 0
imgDepth = 2 ^ (Asc(Left(imgDepth, 1)))
ImgDimensions = True
Case 2
imgDepth = 2 ^ (Asc(Left(imgDepth, 1)) * 3)
ImgDimensions = True
Case 3
imgDepth = 2 ^ (asc(left(imgDepth, 1))) '8
ImgDimensions = True
Case 4
imgDepth = 2 ^ (asc(left(imgDepth, 1)) * 2)
ImgDimensions = True
Case 6
imgDepth = 2 ^ (asc(left(imgDepth, 1)) * 4)
ImgDimensions = True
Case Else
imgDepth = -1
End Select
Else
strBuff = ReadFileBytes(imgFileName, 0, -1) ' Get all bytes from file
lngSize = Len(strBuff)
flgFound = 0
strTarget = Chr(255) & Chr(216) & Chr(255)
flgFound = instr(strBuff, strTarget)
If flgFound = 0 Then
Exit function
End if
imgType = "JPG"
lngPos = flgFound + 2
ExitLoop = false
Do While ExitLoop = False And lngPos < lngSize
Do while Asc(mid(strBuff, lngPos, 1)) = 255 And lngPos < lngSize
lngPos = lngPos + 1
Loop
If Asc(Mid(strBuff, lngPos, 1)) < 192 Or Asc(Mid(strBuff, lngPos, 1)) > 195 Then
lngMarkerSize = R_L256(mid(strBuff, lngPos + 1, 2))
lngPos = lngPos + lngMarkerSize + 1
Else
ExitLoop = True
End If
Loop
'
If ExitLoop = False Then
imgWidth = -1
imgHeight = -1
imgDepth = -1
Else
imgHeight = R_L256(mid(strBuff, lngPos + 4, 2))
imgWidth = R_L256(mid(strBuff, lngPos + 6, 2))
imgDepth = 2 ^ (asc(mid(strBuff, lngPos + 8, 1)) * 8)
ImgDimensions = True
End If
End If
End Function
' Returns image width, height, depth and type for a given image
' Passing full image path with extension, it will return all these details as they passed to function.
' Types found are, "GIF", "BMP", "PNG", "JPG", or unknown
'
' Needs ReadFileBytes, L_R256 and R_L256
Dim strPNG
Dim strGIF
Dim strBMP
Dim strType
strType = ""
imgType = "(unknown)"
ImgDimensions = False
strPNG = Chr(137) & Chr(80) & Chr(78)
strGIF = "GIF"
strBMP = Chr(66) & Chr(77)
strType = ReadFileBytes(imgFileName, 0, 3)
If strType = strGIF Then ' is GIF
imgType = "GIF"
imgWidth = L_R256(ReadFileBytes(imgFileName, 7, 2))
imgHeight = L_R256(ReadFileBytes(imgFileName, 9, 2))
imgDepth = 2 ^ ((Asc(ReadFileBytes(imgFileName, 11, 1)) And 7) + 1)
ImgDimensions = True
ElseIf left(strType, 2) = strBMP Then ' is BMP
imgType = "BMP"
imgWidth = L_R256(ReadFileBytes(imgFileName, 19, 2))
imgHeight = L_R256(ReadFileBytes(imgFileName, 23, 2))
imgDepth = 2 ^ (asc(ReadFileBytes(imgFileName, 29, 1)))
ImgDimensions = True
ElseIf strType = strPNG Then ' Is PNG
imgType = "PNG"
imgWidth = R_L256(ReadFileBytes(imgFileName, 19, 2))
imgHeight = R_L256(ReadFileBytes(imgFileName, 23, 2))
imgDepth = ReadFileBytes(imgFileName, 25, 2)
Select Case Asc(right(imgDepth,1))
Case 0
imgDepth = 2 ^ (Asc(Left(imgDepth, 1)))
ImgDimensions = True
Case 2
imgDepth = 2 ^ (Asc(Left(imgDepth, 1)) * 3)
ImgDimensions = True
Case 3
imgDepth = 2 ^ (asc(left(imgDepth, 1))) '8
ImgDimensions = True
Case 4
imgDepth = 2 ^ (asc(left(imgDepth, 1)) * 2)
ImgDimensions = True
Case 6
imgDepth = 2 ^ (asc(left(imgDepth, 1)) * 4)
ImgDimensions = True
Case Else
imgDepth = -1
End Select
Else
strBuff = ReadFileBytes(imgFileName, 0, -1) ' Get all bytes from file
lngSize = Len(strBuff)
flgFound = 0
strTarget = Chr(255) & Chr(216) & Chr(255)
flgFound = instr(strBuff, strTarget)
If flgFound = 0 Then
Exit function
End if
imgType = "JPG"
lngPos = flgFound + 2
ExitLoop = false
Do While ExitLoop = False And lngPos < lngSize
Do while Asc(mid(strBuff, lngPos, 1)) = 255 And lngPos < lngSize
lngPos = lngPos + 1
Loop
If Asc(Mid(strBuff, lngPos, 1)) < 192 Or Asc(Mid(strBuff, lngPos, 1)) > 195 Then
lngMarkerSize = R_L256(mid(strBuff, lngPos + 1, 2))
lngPos = lngPos + lngMarkerSize + 1
Else
ExitLoop = True
End If
Loop
'
If ExitLoop = False Then
imgWidth = -1
imgHeight = -1
imgDepth = -1
Else
imgHeight = R_L256(mid(strBuff, lngPos + 4, 2))
imgWidth = R_L256(mid(strBuff, lngPos + 6, 2))
imgDepth = 2 ^ (asc(mid(strBuff, lngPos + 8, 1)) * 8)
ImgDimensions = True
End If
End If
End Function
imgFileName, imgWidth, imgHeight, imgDepth, imgType
Views 218
Downloads 60
CodeID
DB ID
ANmarAmdeen
610
Revisions
v1.0
Tuesday
January
16
2024