Problem with Getobject in excel 2013, 64 bit version 3

[N1GHTEYES]

I'm trying to write some code which will allow me to do some simple image analysis, manipulation, and display in Excel. I think I have an issue with version compatibility though. Below is an example of some simple code which demonstrates the problem. It is currently set up (just for debug purposes) to allow the user to specify a file after right-clicking a userform. It loads the file to the form's picture property, then uses Getobject() to populate the bitmap header information associated with the picture. I would normally then go on to get the picture's bits, analyse it, make some changes etc. However, that is not included in the following, because the problem seems to be in the Getobject() implementation. Here is the code:

Private Type BITMAP
    bmType As Long
    bmWidth As Long
    bmHeight As Long
    bmWidthBytes As Long
    bmPlanes As Integer
    bmBitsPixel As Integer
    bmBits As Long
End Type
Dim ImDatLoaded As Boolean
#If VBA7 Then    ' VBA7
    Private Declare PtrSafe Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As LongPtr, ByVal dwCount As Long, lpBits As Any) As Long
    Private Declare PtrSafe Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As LongPtr, ByVal dwCount As Long, lpBits As Any) As Long
    Private Declare PtrSafe Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As LongPtr, ByVal nCount As Long, lpObject As Any) As Long
#Else
    Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
    Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
    Private Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
#End If

Dim PicBits() As Byte, PicInfo As BITMAP
Dim Cnt As Long, BytesPerLine As Long

Private Sub UserForm_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Dim rslt As Long
If Button = 2 Then
    On Error Resume Next
    Dim fname As String
    fname = Application.GetOpenFilename(, , "Select an image file", , False)
    If VarType(fname) = vbString Then
        If fname <> "" Then Ufrm_Canvas.Picture = LoadPicture(fname)
    End If
    If Err.Number = 0 Then
        'GetImData
        rslt = GetObject(Ufrm_Canvas.Picture, Len(PicInfo), PicInfo)
        
        'in here would be the getbitmapbits and the image analysis etc.
        '
    Else
        Err.Clear
    End If
End If
End Sub

If I put a breakpoint after the Getobject call, and use the Watch window to look at the PicInfo variable (a bitmap), it should be populated with the values from the loaded picture, i.e. height, width, bits per pixel etc. When I do this at work, that is exactly what happens - i.e. everything is behaving as I'd expect. When I run exactly the same code, in exactly the same workbook at home, the PicInfo variable has zero for all of the bitmap parameters, and the result of the Getobject call (the rslt variable) is also zero.

At work I'm using Office 2010 32 bit, running on Windows 7. At home I'm using Office 2013 64 bit, running on Windows 8. As far as I know, 2010 and 2013 both run VBA7, so I assume the difference is down to the 64 bit issue, but I'm not sure how the declaration needs to change. I've had a look at what the Microsoft website says about the topic, but it all seemed pretty general, and I was not clear what, if any, changes there needed to be the declaration. I'd really appreciate any suggestions. Thanks.

 

[combo]

You need additional Win64 conditional compilation constant to check if you run office 64 bit version, see

https://msdn.microsoft.com/en-us/library/office/ee691831(v=office.14).aspx

Direct code here:

https://msdn.microsoft.com/en-us/vb...64-bit-visual-basic-for-applications-overview

combo

 

[N1GHTEYES]

Thanks for the comment combo, but I think I've already addressed that issue as far as I understand it - though I find what those sites say is a little confusing. One minute they seem to say that VBA7 is the prime determinant of the declaration syntax, and the next they say it is the 32/64 bit issue.

However, in either case, if I am running in either 2010 or 2013 it should have VBA7, and therefore the declaration I made in that case for the Getobject function, should work in either 32 or 64 bit according to the websites you quoted. I could use the Win64 flag as well, but I can't see how that should alter the declaration syntax. I got the declaration I'm using from the list provided by Microsoft. Here it is:

#    Private Declare PtrSafe Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As LongPtr, ByVal nCount As Long, lpObject As Any) As Long

If that needs to change in some way for use with a 64 bit version, I can't find out how. But this code works at work and it does not at home, and the only differences (that I'm aware of) are 32 bit 2010 at work and 64 bit 2013 at home. I don't see how 2010 Vs 2013 would make any difference, so it must be the 32 Vs 64 bit which is causing the problem. As you can see, I'm using the PtrSafe keyword and defining the hObject handle as a LongPtr. As far as I can see, that is all it should take for the call to work correctly in 64 bit, but it does not do so. It does not throw any errors, but the bitmap structure returned is empty.

 

[combo]

All ms office 2010-2016 versions have VBA 7. VBA 7 can be 32 bit or 64 bit. VBA7 constant is used to split code between VBA 6.x and VBA 7 environments. Win64 constant detects 32 bit vs. 64 bit of VBA 7.
Following the second link from ny post:

#if Vba7 then 
'  Code is running in the new VBA7 editor 
     #if Win64 then 
     '  Code is running in 64-bit version of Microsoft Office 
     #else 
     '  Code is running in 32-bit version of Microsoft Office 
     #end if 
#else 
' Code is running in VBA version 6 or earlier 
#end if

Both your office versions have VBA 7, so alwats the first part of #if is executed, for 32 bit VBA 7. It is the case in office, but not at home.

combo

 

[N1GHTEYES]

OK, I agree with you, the first part of the conditional compilation should be running in both cases. So if the declaration I've written in the first case works equally well for 32 and 64 bit cases, then the code should run the same in both cases.
As far as I can see, that should be what ought to happen, because I think the declaration IS correct for the 64 bit case. If it isn't, can you suggest how the declaration ought to be different?

I do not think the issue is about trying to determine whether a different declaration is required, but exactly what that declaration's syntax should be. To clarify the issue, on my home version I have tried commenting out all versions of the declaration apart from what I believe to be the correct 64 bit version. Given that at home I am running 64 bit, that should be fine. So the entire declaration section now looks like:

Private Type BITMAP
        bmType As Long
        bmWidth As Long
        bmHeight As Long
        bmWidthBytes As Long
        bmPlanes As Integer
        bmBitsPixel As Integer
        bmBits As LongPtr
End Type
Private Declare PtrSafe Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As LongPtr, ByVal nCount As Long, lpObject As Any) As Long
Private Declare PtrSafe Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As LongPtr, ByVal dwCount As Long, lpBits As Any) As Long
Private Declare PtrSafe Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As LongPtr, ByVal dwCount As Long, lpBits As Any) As Long

...and it still does not work. But is should do, because, according to MS, the above ought to be a perfectly valid declaration for the VBA7 case, for both 32 and 64 bit. In both cases it needs the PtrSafe keyword, and the hObject parameter needs to be defined as a LongPtr, which is read as a 4-byte value in 32 bit office and an 8-byte value in 64 bit. The bmBits parameter of the Bitmap type is also declared as a LogPtr, so that should also work for both 32 and 64. I have done all of the above but still no joy.

So it seems as though the above declaration must be wrong, but I've copied the above direct from Microsoft's own documentation and I really don't know what to try next. This is driving me crazy.

 

[combo]

According to MS (

https://www.microsoft.com/en-us/download/details.aspx?id=9970)

this should worh in VBA 64 bit (actually it's your initial code with modifications of declarations as above):

Private Type BITMAP
        bmType As Long
        bmWidth As Long
        bmHeight As Long
        bmWidthBytes As Long
        bmPlanes As Integer
        bmBitsPixel As Integer
        bmBits As LongPtr
End Type
Private Declare PtrSafe Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As LongPtr, ByVal nCount As Long, lpObject As Any) As Long
Private Declare PtrSafe Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As LongPtr, ByVal dwCount As Long, lpBits As Any) As Long
Private Declare PtrSafe Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As LongPtr, ByVal dwCount As Long, lpBits As Any) As Long

Dim PicBits() As Byte, PicInfo As BITMAP
Dim Cnt As Long, BytesPerLine As Long

Private Sub UserForm_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Dim rslt As Long
If Button = 2 Then
    On Error Resume Next
    Dim fname As String
    fname = Application.GetOpenFilename(, , "Select an image file", , False)
    If VarType(fname) = vbString Then
        If fname <> "" Then Ufrm_Canvas.Picture = LoadPicture(fname)
    End If
    If Err.Number = 0 Then
        'GetImData
        rslt = GetObject(Ufrm_Canvas.Picture, Len(PicInfo), PicInfo)
        
        'in here would be the getbitmapbits and the image analysis etc.
        '
    Else
        Err.Clear
    End If
End If
End Sub

If not, you could try to change Long declaration to LongPtr, at least for GetObject type (I have 32 bit vba, no way to test this).

combo

 

[N1GHTEYES]

Thanks for that Combo, but it still does not want to work.

I have stripped everything down to basics.

[li]I have a user form with no controls. Its entire code is copied exactly from what you posted. [/li]
[li]There is also a standard module with a single sub which shows the user form. [/li]
[li]That sub is called by a button on the worksheet. [/li]
That is it.

As you say, according to MS it should work, but it doesn't.
To run it I click the button on the sheet.
That shows the form.
I right-click the form which gives me a dialogue box.
I select an image file.
It loads the file using loadpicture.
It should then use Getobject to populate the bitmap.
I have a breakpoint at the end of the UserForm_MouseUp sub.
When it gets to the breakpoint, I use watch to see the values of rslt and picinfo.
rslt is 0.
picinfo is a bitmap all of whose members are 0.

I have also tried it with the Getobject function returning a LongPtr instead of a Long (and modded the dim for rslt accordingly). This gives the same result.

As far as I can see, what I've written should work - and in a 32 bit, Office 2010 windows 7 case, it does.

Is there anyone out there running Office 2013, 64 bit, on windows 8? Or any combination of the above. I'd really appreciate hearing if you can run the above code successfully.


I'm contemplating the prospect of going off into the corner and gibbering quietly.

 

[strongm]

I' d imagine that the built in GetObject method and the API GetObject function are getting confused, and that this is being hidden by your On Error Resume Next

Try declaring with a different alias, eg

[blue]Private Declare PtrSafe Function [b]apiGetObject[/b] Lib "gdi32" Alias "GetObjectA" (ByVal hObject As LongPtr, ByVal nCount As Long, lpObject As Any) As Long[/blue]

 

[N1GHTEYES]

Thanks strongm. I hadn't realised the was a Getobject inbuilt function nowadays. Good suggestion.

Not the problem though. It still does not work.

I have slimmed down the code as much as possible. Apart from a simple sub in a standard module to respond to a button press and show the form, the following is the entire code. It goes into a user form.

Private Type BITMAP
        bmType As Long
        bmWidth As Long
        bmHeight As Long
        bmWidthBytes As Long
        bmPlanes As Integer
        bmBitsPixel As Integer
        bmBits As LongPtr
End Type
Private Declare PtrSafe Function apiGetObject Lib "C:\Windows\System32\gdi32.dll" Alias "GetObjectA" (ByVal hObject As LongPtr, ByVal nCount As Long, lpObject As Any) As Long
Dim PicInfo As BITMAP

Private Sub UserForm_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Dim rslt As Long
ufrm_Canvas.Picture = LoadPicture("D:\Test.bmp")
rslt = apiGetObject(ufrm_Canvas.Picture, Len(PicInfo), PicInfo)
End Sub 'put break point here

As you can see, I have renamed the declaration as suggested and I've removed the on error resume next. I ran it with "break on all errors" set.

It ran fine to the end with no errors. But again, rslt and the contents of the picinfo structure were all zero.

I also tried it with rslt and the getobject return value dimmed as longptr. That does not help either.

gibber, gibber.

 

[strongm]

> inbuilt function nowadays

It was introduced at least 20 years ago ...

Anyway ... in which case the issue is actually likely to be byte alignment in the BITMAP structure when running in 64bit, which leads to the size being 32 bytes rather than 24 byte (which is what Len returns)

You can check how many bytes the function wants to return by passing a null pointer as the last parameter, eg

rslt = apiGetObject(ufrm_Canvas.Picture, 0, ByVal 0&)
debug.? rslt

 

[TonyJollans]

The problem is, indeed, byte alignment.

Somewhere along the way you (correctly) changed [tt][blue]bmBits[/blue][/tt] from [tt][blue]Long[/blue][/tt] to [tt][blue]LongPtr[/blue][/tt].

On 32-bit systems this becomes a [tt][blue]Long[/blue][/tt] - a 4-byte value aligned on a 4-byte boundary.
On 62-bit systems this becomes a [tt][blue]LongLong[/blue][/tt] - an 8-byte value aligned on an 8-byte boundary.

You can, as strongm says, issue a call to check the length before you issue one to get the picture but you don't need to do that here. You have the structure correct - you are just using the wrong length value.

[tt][blue]Len(PicInfo)[/blue][/tt] adds the lengths of all the components giving you 24 on a 32-bit system, which happens to be correct, and 28 on a 64-bit system, which is wrong. [tt][blue]Len[red]B[/red](PicInfo)[/blue][/tt] returns the length of the structure taking account of alignment, still giving you 24 on a 32-bit system, but giving you 32 on a 64-bit system, which is also correct:

[blue]rslt = apiGetObject(ufrm_Canvas.Picture, LenB(PicInfo), PicInfo)[/blue]

Enjoy,
Tony

------------------------------------------------------------------------------------
We want to help you; help us to do it by reading this: Before you ask a question.

I'm working (slowly) on my own website

 

[N1GHTEYES]

Whoop-di-do!

Now all I've got to do is get the rest of it working.

Thanks so much to both of you. I don't think I would have ever got that.

>It was introduced at least 20 years ago ...
I never claimed to move with the times. I struggle to move with Ex-Lax nowadays...