Open JPG and determine pixel width in VB?

[Joe HM]

Hello -

I have the following problem: I want to be able to determine the width
of a JPG image from a VB6 script. The user specifies the JPG filename
in a cell and I want the script to somehow load that picture and
determine the width and height.

Is there any way this could be done with VB in Excel?

Thanks!
Joe

 

[Shawn O'Donnell]

I have the following problem: I want to be able to determine the width
of a JPG image from a VB6 script. The user specifies the JPG filename
in a cell and I want the script to somehow load that picture and
determine the width and height.

Could you could load the picture into an Image control on a hidden form,
then ask for the height and width of the Image control? Set the Image
control's AutoSize property to True and set its BorderStyle to
fmBorderStyleNone.

The Image control's dimensions are given in points, not pixels. You have to
do some work converting points to pixels, though, and I'm not sure how
accurate the results would be. Here's code based on an example in the new
book by Bullen, Bovey & Green, "Professional Excel Development." You have to
use a couple of Windows API calls to get your screen's resolution.

Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal
nIndex As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal
hDC As Long) As Long

Private Const POINTS_PER_INCH As Long = 72
Private Const LOGPIXELSX = 88 ' tell GetDeviceCaps to return horiz
pixels/inch

Public Function PixelsPerPoint() As Double
Dim deviceContextHandle As Long
Dim DotsPerInch As Long

deviceContextHandle = GetDC(0)
DotsPerInch = GetDeviceCaps(deviceContextHandle, LOGPIXELSX)
PixelsPerPoint = DotsPerInch / POINTS_PER_INCH
ReleaseDC 0, deviceContextHandle
End Function

Public Function GetGraphicswidth()
GetGraphicswidth = PixelsPerPoint * UserForm1.Image1.Width
End Function

Public Function GetGraphicsHeight()
GetGraphicsHeight = PixelsPerPoint * UserForm1.Image1.Height
End Function

 

[Joe HM]

Hello -

Thanks so much for the help! I added a Form and inserted an Image.
Now I just don't know how to hide that form and how to load the image?

Dim picPicture As IPictureDisp
Set picPicture = stdole.StdFunctions.LoadPicture("File.jpg")
Image1.Picture = picPicture

I guess there is something wrong with that?

Thanks!
Joe

 

[Shawn O'Donnell]

I added a Form and inserted an Image. Now I just don't
know how to hide that form and how to load the image?

I was thinking you could just add a form to the Excel VBAProject and put the
Image control on it. Then set the Image control's Picture property with
LoadPicture.

Sub ChangePicture(PicturePath as String)
UserForm1.Image1.Picture = LoadPicture(PicturePath)
End Sub

Just talking to UserForm1 like that should Load it, but not Show it. So
there should be no need to hide the form.

Then you can make a User-Defined Function like this that you can use in a
cell on the spreadsheet:

Public Function GetGraphicsWidth(filePath As String) As Double
ChangePicture (filePath)
GetGraphicsWidth = PixelsPerPoint * UserForm1.Image1.Width
End Function

 

[Harald Staff]

Hi Joe

I have unfortunately lost the name of the author:

Option Explicit

Type ImageSize
Width As Long
Height As Long
End Type

Sub test()
Dim vPic As Variant
Dim sPicFile As String
Dim uSize As ImageSize

vPic = Application.GetOpenFilename("Jpg images (*.jpg), *.jpg")
If vPic = False Then Exit Sub
sPicFile = CStr(vPic)
If Dir(sPicFile) <> "" Then
uSize = GetImageSize(sPicFile)
MsgBox uSize.Width & " * " & uSize.Height
End If
End Sub

Function GetImageSize(ByVal sFileName As String) As ImageSize
On Error Resume Next
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()

If bTemp(0) = &HFF And bTemp(1) = &HD8 And bTemp(2) = &HFF Then
'Debug.print "JPEG"
lPos = 3
Do
Do
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 Then
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)
End If
Close iFN
End Function

Private Function CombineBytes(lsb As Byte, msb As Byte) As Long
CombineBytes = CLng(lsb + (msb * 256))
End Function

HTH. Best wishes Harald

 

[Joe HM]

Wow!

Works great ... thanks so much!

Joe