COMPGROUPS.NET | Search | Post Question | Groups | Stream | About | Register

Issue designing a class module that uses OleLoadPicture

  • Follow


Hi Everyone,

I am attempting to build an image handling class that I can re-use. It
is not yet finished. I am trying to create an image from an array of
bytes, and am having no luck. This is driving me nuts because what
appears to me to be the exact same code in another db works perfectly.
I am not sure why this fails on one particular line - everything else
seems to work fine up till this point.

There is a private sub that works on the byte array using the api
calls to produce (in theory) an stdOLE.IPicture object. This object is
an internal class variable called m_iPic. This chain of events is set
in motion when you set the byte array as a property. This all works
fine up to the point of creating the iPic - the very last call, and I
have no idea why. Would someone be so kind as to have a look and see
if there is something I am just overlooking?

Here is the API declarations I am using:
Declare Function OleLoadPicture1 Lib "oleaut32" Alias
"OleLoadPicture" ( _
    ByVal lpstream As stdole.IUnknown, _
    ByVal lSize As Long, _
    ByVal fRunmode As Long, _
    ByVal riid As Long, _
    lpIPicture As stdole.IPicture) As Long

Declare Function CreateStreamOnHGlobal Lib "ole32" ( _
    ByVal hGlobal As Long, _
    ByVal fDeleteOnRelease As Long, _
    lpIStream As stdole.IUnknown) As Long

Declare Function CLSIDFromString Lib "ole32" ( _
    ByVal lpsz As Long, _
    ByRef pclsid As IPicGUID) As Long

'____________________________________________________________________


Here are the structures that go with them:

Public Type IPicGUID                                           'ID
data for stdOLE IPictures
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(7) As Long
End Type

'______________________________________________________________________

And finally the class module itself (clsImage):

Option Compare Database

Private m_hAccess As Long
'Device context for Access
Private m_hGDI As Long
'Device context for GDI
Private m_xPixelFactor As Long                                  'DPI x
Private m_yPixelFactor As Long                                  'DPI y
Private m_FormWidth As Long                                     'width
of the form
Private m_FormHeight As Long
'height of the form
Private m_StretchMode As BltStretchMode
'Stretching option for the image data
Private m_iPic As stdole.IPicture                               'The
internal version of the picture
Private m_ImageByteArray() As Byte                              'The
raw bytes the image is made from

Private Const logPixelsX As Long = 88
'device values for x only
Private Const logPixelsY As Long = 90
'device values for y only
Private Const SIPICTURE As String = "{7BF80980-
BF32-101A-8BBB-00AA00300CAB}"    'image GUID identity

Private m_GUID As IPicGUID
'Internal variable for the GUID data

Public Event ErrorEvent(ByVal ErrorMessage As String, ErrorNumber As
Long)

Property Let StretchMode(ColorOrHalftone As BltStretchMode)     'Sets
the current image stretchmode
Call SetStretchBltMode(m_hGDI, ColorOrHalftone)
m_StretchMode = ColorOrHalftone                                 'and
matches the internal variable value
End Property

Property Get StretchMode() As BltStretchMode
'Returns the current image stretchmode
StretchMode = m_StretchMode
End Property

Property Let FormWidth(Width As Long)                           'Not
sure if I need this
m_FormWidth = Width
End Property

Property Let FormHeight(Height As Long)                         'Not
sure if I need this
m_FormHeight = Height
End Property

Property Let ImageByteArray(DataArray() As Byte)                'Load
the image byte array through here
Dim i As Long
If IsDimmed(DataArray) Then                                     'Check
that it is actually an array.
    For i = LBound(DataArray) To UBound(DataArray)              'Loop
through the array elements
        If VarType(DataArray(i)) <> vbByte Then                 'and
check they are all Byte datatype.
            RaiseEvent ErrorEvent("Not byte data in array", 64001)
'and raise an alert if they are not
            Exit Property                                       'and
disregard the data array
        End If
    Next i
    m_ImageByteArray() = DataArray()                            'Load
the new data array if its clean
    CreateImage                                                 'and
create the stdOLE image
Else
    RaiseEvent ErrorEvent("Not an Array()", 64000)              'Raise
an alert if not an array
End If
End Property

Private Sub Class_Initialize()
On Error GoTo ErrorInitialize
m_hAccess = GetDC(Application.hWndAccessApp)
'Obtain device context handle for access
m_xPixelFactor = GetDeviceCaps(m_hAccess, logPixelsX)           'get
the DPI for x axis
m_yPixelFactor = GetDeviceCaps(m_hAccess, logPixelsY)           'get
the DPI for y axis
m_hGDI = CreateCompatibleDC(m_hAccess)                          'get a
GDI device context handle
Call SetStretchBltMode(m_hGDI, COLORONCOLOR)                    'set a
default stretch mode for image handling
m_StretchMode = COLORONCOLOR                                    'and
match the internal variable too
With m_GUID
'establish the IPic GUID data elements
    .Data1 = &H7BF80980
    .Data2 = &HBF32
    .Data3 = &H101A
    .Data4(0) = &H8B
    .Data4(1) = &HBB
    .Data4(3) = &HAA
    .Data4(5) = &H30
    .Data4(6) = &HC
    .Data4(7) = &HAB
End With
Exit Sub                                                        'clean
initialisation

ErrorInitialize:
'report startup problems
    RaiseEvent ErrorEvent(Error, Err)                           'by
passing back the error message and event
End Sub

Private Sub Class_Terminate()
ReleaseDC Application.hWndAccessApp, m_hAccess
'release the device context handle
DeleteDC m_hGDI
'release the device context handle
Set m_iPic = Nothing
'release the IPic object from memory
If IsDimmed(m_ImageByteArray) Then
'release the byte array from memory
    Erase m_ImageByteArray
End If
End Sub

Private Sub CreateImage()                                       'This
creates the actual image from bytes
Dim ISTREAMPIC As stdole.IUnknown

On Error GoTo ErrorCreateImage                                  'set
the error handling

If IsDimmed(m_ImageByteArray) Then                              'If
the array is ready to go
    If Not
CreateStreamOnHGlobal(m_ImageByteArray(LBound(m_ImageByteArray)),
False, ISTREAMPIC) Then
        'CLSIDFromString StrPtr(SIPICTURE), m_GUID
        OleLoadPicture ISTREAMPIC, _
                       UBound(m_ImageByteArray) -
LBound(m_ImageByteArray) + 1, _
                       0, _
                       VarPtr(m_GUID), _
                       m_iPic                                   'the
api just made you an image :-)
    End If
End If

Set ISTREAMPIC = Nothing
'cleanup
Exit Sub                                                        'and
clean exit

ErrorCreateImage:
    RaiseEvent ErrorEvent(Error, Err)
    Set ISTREAMPIC = Nothing
End Sub

Private Function IsDimmed(ArrayName As Variant) As Boolean
On Error Resume Next
If IsNumeric(UBound(ArrayName)) Then
    IsDimmed = True
Else
    IsDimmed = False
End If
End Function

'________________________________________________________________________


I am using the following code to test the class as I build it:

Public Function LoadImage() As Variant
Dim fnum As Long
Dim tmp() As Byte                          'for binary byte data
'Dim tmp As String                           'for handling as string
data
Dim FileName As String

fnum = FreeFile
FileName = "D:\DATA\My Pictures\me.jpg"  'change this to suit
Open FileName For Binary As fnum
ReDim tmp(0 To LOF(fnum) - 1) As Byte      'this is binary byte data
'tmp = Space(LOF(fnum))                      'this is as a string
Get #fnum, , tmp
Close #fnum
LoadImage = tmp
End Function

Sub testload()
'This is not so far successful!!!!!

Dim pic As Variant
pic = LoadImage


Dim c As clsImage
Set c = New clsImage

'c.ImageByteArray = StrConv(pic, vbFromUnicode)     'If feeding a
string
c.ImageByteArray = pic                           'If feeding a byte
array

Set c = Nothing
End Sub
'____________________________________________________________________________


I am stumped. I am refactoring this and I am pretty sure I got it
right, but Access is proving me wrong. Any help would be greatly
appreciated.

Cheers

The Frog
0
Reply The 2/11/2011 4:03:00 PM 

Well there's a stack of declarations missing and the BltStretchMode 
enumeration.
I added those and Option Explicits (ALWAYS specify this in code modules).

You're calling OleLoadPicture having declared OleLoadPicture1

Having corrected that your code compiles OK and Sub testload appears to run 
without error (although your error handling won't show some API errors).

Difficult to know what your problem is as we don't appear to be doing 
anything with the image apart from setting a property with it (at least as 
far as I can see).

Maybe the above will help though.

Jon



"The Frog" <mr.frog.to.you@googlemail.com> wrote in message 
news:3a954ad4-ab6f-47a6-991b-86d01c18fb4f@n18g2000vbq.googlegroups.com...
> Hi Everyone,
>
> I am attempting to build an image handling class that I can re-use. It
> is not yet finished. I am trying to create an image from an array of
> bytes, and am having no luck. This is driving me nuts because what
> appears to me to be the exact same code in another db works perfectly.
> I am not sure why this fails on one particular line - everything else
> seems to work fine up till this point.
>
> There is a private sub that works on the byte array using the api
> calls to produce (in theory) an stdOLE.IPicture object. This object is
> an internal class variable called m_iPic. This chain of events is set
> in motion when you set the byte array as a property. This all works
> fine up to the point of creating the iPic - the very last call, and I
> have no idea why. Would someone be so kind as to have a look and see
> if there is something I am just overlooking?
>
> Here is the API declarations I am using:
> Declare Function OleLoadPicture1 Lib "oleaut32" Alias
> "OleLoadPicture" ( _
>    ByVal lpstream As stdole.IUnknown, _
>    ByVal lSize As Long, _
>    ByVal fRunmode As Long, _
>    ByVal riid As Long, _
>    lpIPicture As stdole.IPicture) As Long
>
> Declare Function CreateStreamOnHGlobal Lib "ole32" ( _
>    ByVal hGlobal As Long, _
>    ByVal fDeleteOnRelease As Long, _
>    lpIStream As stdole.IUnknown) As Long
>
> Declare Function CLSIDFromString Lib "ole32" ( _
>    ByVal lpsz As Long, _
>    ByRef pclsid As IPicGUID) As Long
>
> '____________________________________________________________________
>
>
> Here are the structures that go with them:
>
> Public Type IPicGUID                                           'ID
> data for stdOLE IPictures
>    Data1 As Long
>    Data2 As Integer
>    Data3 As Integer
>    Data4(7) As Long
> End Type
>
> '______________________________________________________________________
>
> And finally the class module itself (clsImage):
>
> Option Compare Database
>
> Private m_hAccess As Long
> 'Device context for Access
> Private m_hGDI As Long
> 'Device context for GDI
> Private m_xPixelFactor As Long                                  'DPI x
> Private m_yPixelFactor As Long                                  'DPI y
> Private m_FormWidth As Long                                     'width
> of the form
> Private m_FormHeight As Long
> 'height of the form
> Private m_StretchMode As BltStretchMode
> 'Stretching option for the image data
> Private m_iPic As stdole.IPicture                               'The
> internal version of the picture
> Private m_ImageByteArray() As Byte                              'The
> raw bytes the image is made from
>
> Private Const logPixelsX As Long = 88
> 'device values for x only
> Private Const logPixelsY As Long = 90
> 'device values for y only
> Private Const SIPICTURE As String = "{7BF80980-
> BF32-101A-8BBB-00AA00300CAB}"    'image GUID identity
>
> Private m_GUID As IPicGUID
> 'Internal variable for the GUID data
>
> Public Event ErrorEvent(ByVal ErrorMessage As String, ErrorNumber As
> Long)
>
> Property Let StretchMode(ColorOrHalftone As BltStretchMode)     'Sets
> the current image stretchmode
> Call SetStretchBltMode(m_hGDI, ColorOrHalftone)
> m_StretchMode = ColorOrHalftone                                 'and
> matches the internal variable value
> End Property
>
> Property Get StretchMode() As BltStretchMode
> 'Returns the current image stretchmode
> StretchMode = m_StretchMode
> End Property
>
> Property Let FormWidth(Width As Long)                           'Not
> sure if I need this
> m_FormWidth = Width
> End Property
>
> Property Let FormHeight(Height As Long)                         'Not
> sure if I need this
> m_FormHeight = Height
> End Property
>
> Property Let ImageByteArray(DataArray() As Byte)                'Load
> the image byte array through here
> Dim i As Long
> If IsDimmed(DataArray) Then                                     'Check
> that it is actually an array.
>    For i = LBound(DataArray) To UBound(DataArray)              'Loop
> through the array elements
>        If VarType(DataArray(i)) <> vbByte Then                 'and
> check they are all Byte datatype.
>            RaiseEvent ErrorEvent("Not byte data in array", 64001)
> 'and raise an alert if they are not
>            Exit Property                                       'and
> disregard the data array
>        End If
>    Next i
>    m_ImageByteArray() = DataArray()                            'Load
> the new data array if its clean
>    CreateImage                                                 'and
> create the stdOLE image
> Else
>    RaiseEvent ErrorEvent("Not an Array()", 64000)              'Raise
> an alert if not an array
> End If
> End Property
>
> Private Sub Class_Initialize()
> On Error GoTo ErrorInitialize
> m_hAccess = GetDC(Application.hWndAccessApp)
> 'Obtain device context handle for access
> m_xPixelFactor = GetDeviceCaps(m_hAccess, logPixelsX)           'get
> the DPI for x axis
> m_yPixelFactor = GetDeviceCaps(m_hAccess, logPixelsY)           'get
> the DPI for y axis
> m_hGDI = CreateCompatibleDC(m_hAccess)                          'get a
> GDI device context handle
> Call SetStretchBltMode(m_hGDI, COLORONCOLOR)                    'set a
> default stretch mode for image handling
> m_StretchMode = COLORONCOLOR                                    'and
> match the internal variable too
> With m_GUID
> 'establish the IPic GUID data elements
>    .Data1 = &H7BF80980
>    .Data2 = &HBF32
>    .Data3 = &H101A
>    .Data4(0) = &H8B
>    .Data4(1) = &HBB
>    .Data4(3) = &HAA
>    .Data4(5) = &H30
>    .Data4(6) = &HC
>    .Data4(7) = &HAB
> End With
> Exit Sub                                                        'clean
> initialisation
>
> ErrorInitialize:
> 'report startup problems
>    RaiseEvent ErrorEvent(Error, Err)                           'by
> passing back the error message and event
> End Sub
>
> Private Sub Class_Terminate()
> ReleaseDC Application.hWndAccessApp, m_hAccess
> 'release the device context handle
> DeleteDC m_hGDI
> 'release the device context handle
> Set m_iPic = Nothing
> 'release the IPic object from memory
> If IsDimmed(m_ImageByteArray) Then
> 'release the byte array from memory
>    Erase m_ImageByteArray
> End If
> End Sub
>
> Private Sub CreateImage()                                       'This
> creates the actual image from bytes
> Dim ISTREAMPIC As stdole.IUnknown
>
> On Error GoTo ErrorCreateImage                                  'set
> the error handling
>
> If IsDimmed(m_ImageByteArray) Then                              'If
> the array is ready to go
>    If Not
> CreateStreamOnHGlobal(m_ImageByteArray(LBound(m_ImageByteArray)),
> False, ISTREAMPIC) Then
>        'CLSIDFromString StrPtr(SIPICTURE), m_GUID
>        OleLoadPicture ISTREAMPIC, _
>                       UBound(m_ImageByteArray) -
> LBound(m_ImageByteArray) + 1, _
>                       0, _
>                       VarPtr(m_GUID), _
>                       m_iPic                                   'the
> api just made you an image :-)
>    End If
> End If
>
> Set ISTREAMPIC = Nothing
> 'cleanup
> Exit Sub                                                        'and
> clean exit
>
> ErrorCreateImage:
>    RaiseEvent ErrorEvent(Error, Err)
>    Set ISTREAMPIC = Nothing
> End Sub
>
> Private Function IsDimmed(ArrayName As Variant) As Boolean
> On Error Resume Next
> If IsNumeric(UBound(ArrayName)) Then
>    IsDimmed = True
> Else
>    IsDimmed = False
> End If
> End Function
>
> '________________________________________________________________________
>
>
> I am using the following code to test the class as I build it:
>
> Public Function LoadImage() As Variant
> Dim fnum As Long
> Dim tmp() As Byte                          'for binary byte data
> 'Dim tmp As String                           'for handling as string
> data
> Dim FileName As String
>
> fnum = FreeFile
> FileName = "D:\DATA\My Pictures\me.jpg"  'change this to suit
> Open FileName For Binary As fnum
> ReDim tmp(0 To LOF(fnum) - 1) As Byte      'this is binary byte data
> 'tmp = Space(LOF(fnum))                      'this is as a string
> Get #fnum, , tmp
> Close #fnum
> LoadImage = tmp
> End Function
>
> Sub testload()
> 'This is not so far successful!!!!!
>
> Dim pic As Variant
> pic = LoadImage
>
>
> Dim c As clsImage
> Set c = New clsImage
>
> 'c.ImageByteArray = StrConv(pic, vbFromUnicode)     'If feeding a
> string
> c.ImageByteArray = pic                           'If feeding a byte
> array
>
> Set c = Nothing
> End Sub
> '____________________________________________________________________________
>
>
> I am stumped. I am refactoring this and I am pretty sure I got it
> right, but Access is proving me wrong. Any help would be greatly
> appreciated.
>
> Cheers
>
> The Frog
0
Reply Jon 2/11/2011 7:46:14 PM 


Hi Jon,

Thanks for having a crack at this. I apologise for the sloppy looking
code. I wrote this just before running out the door last thing on
Friday! I obviously didnt do a good job of posting my code or the
problem. The oleLoadPicture1 vs OleLoadPicture was simply me mucking
about with different versions of the declaration that I have seen. The
version I posted I had forgotten to 'clean' before posting. Similarly
the enumerations and declarations (the GDI ones for example) are
actually all there, but in a separate module. I will drop them in
below this post, but I think they are complete (at least as far as I
can tell). Please accept my apologies for the sloppiness.

What is happening is this: When the class is initialised everything
seems to go through its setup just fine. When I set the byte array
property ImageByteArray a byte array is expected and my test code
passes one in after reading it directly from a .jpg file. The property
let statement calls a private sub CreateImage, which is the part I am
building at the moment and having the trouble with. This is the
specific code for it:
Private Sub CreateImage()                                       'This
creates the actual image from bytes
Dim ISTREAMPIC As stdole.IUnknown

On Error GoTo ErrorCreateImage                                  'set
the error handling

If IsDimmed(m_ImageByteArray) Then                              'If
the array is ready to go
    If Not
CreateStreamOnHGlobal(m_ImageByteArray(LBound(m_ImageByteArray)),
False, ISTREAMPIC) Then
        'CLSIDFromString StrPtr(SIPICTURE), m_GUID
        OleLoadPicture ISTREAMPIC, _
                       UBound(m_ImageByteArray) -
LBound(m_ImageByteArray) + 1, _
                       0, _
                       VarPtr(m_GUID), _
                       m_iPic                                   'the
api just made you an image :-)
    End If
End If

Set ISTREAMPIC = Nothing
'cleanup
Exit Sub                                                        'and
clean exit

ErrorCreateImage:
    RaiseEvent ErrorEvent(Error, Err)
    Set ISTREAMPIC = Nothing
End Sub

The CreateStreamOnhGlobal seems to work ok, and an IStream object is
returned (seemingly). When the call to OleLoadPicture is made normally
you would expect an IPicture object returned, but none is - it remains
as nothing. In the example database kindly provided by a poster here
in this group the series of steps are based in a forms class module
for a bound form and this works perfectly. I can drop my .jpg reading
code in with an extra line to convert to string (StrConv(variable,
vbUnicode)) and push any image I wish into the Image control on the
form. I am trying to recreate this functionality in a non-bound way as
a re-usable class module (and am only part way through building the
basics of it). The OleLoadPicture part just doesnt seem to make any
sense. The result code (when I set up the process to respond that way)
is S_OK (ie / 0). The object m_iPic is however still 'Nothing'.

So, in short I am getting a successful result code but no IPicture as
a result! This really makes no sense to me at all. I cannot move to
the next stage of building the class (creating BMP's and EMF's) until
I have this part taken care of. It is very frustrating indeed :-)
Here is my 'cleaned' code:

Class module:

Option Compare Database
Option Explicit

Private m_hAccess As Long
'Device context for Access
Private m_hGDI As Long
'Device context for GDI
Private m_xPixelFactor As Long                                  'DPI x
Private m_yPixelFactor As Long                                  'DPI y
Private m_FormWidth As Long                                     'width
of the form
Private m_FormHeight As Long
'height of the form
Private m_StretchMode As BltStretchMode
'Stretching option for the image data
Private m_iPic As stdole.IPicture                               'The
internal version of the picture
Private m_ImageByteArray() As Byte                              'The
raw bytes the image is made from

Private Const logPixelsX As Long = 88
'device values for x only
Private Const logPixelsY As Long = 90
'device values for y only
Private Const SIPICTURE As String = "{7BF80980-
BF32-101A-8BBB-00AA00300CAB}"    'image GUID identity

Private m_GUID As IPicGUID
'Internal variable for the GUID data

Public Event ErrorEvent(ByVal ErrorMessage As String, ErrorNumber As
Long)

Property Let StretchMode(ColorOrHalftone As BltStretchMode)     'Sets
the current image stretchmode
Call SetStretchBltMode(m_hGDI, ColorOrHalftone)
m_StretchMode = ColorOrHalftone                                 'and
matches the internal variable value
End Property

Property Get StretchMode() As BltStretchMode
'Returns the current image stretchmode
StretchMode = m_StretchMode
End Property

Property Let FormWidth(Width As Long)                           'Not
sure if I need this
m_FormWidth = Width
End Property

Property Let FormHeight(Height As Long)                         'Not
sure if I need this
m_FormHeight = Height
End Property

Property Let ImageByteArray(DataArray() As Byte)                'Load
the image byte array through here
Dim i As Long
If IsDimmed(DataArray) Then                                     'Check
that it is actually an array.
    For i = LBound(DataArray) To UBound(DataArray)              'Loop
through the array elements
        If VarType(DataArray(i)) <> vbByte Then                 'and
check they are all Byte datatype.
            RaiseEvent ErrorEvent("Not byte data in array", 64001)
'and raise an alert if they are not
            Exit Property                                       'and
disregard the data array
        End If
    Next i
    m_ImageByteArray() = DataArray()                            'Load
the new data array if its clean
    CreateImage                                                 'and
create the stdOLE image
Else
    RaiseEvent ErrorEvent("Not an Array()", 64000)              'Raise
an alert if not an array
End If
End Property

Private Sub Class_Initialize()
On Error GoTo ErrorInitialize
m_hAccess = GetDC(Application.hWndAccessApp)
'Obtain device context handle for access
m_xPixelFactor = GetDeviceCaps(m_hAccess, logPixelsX)           'get
the DPI for x axis
m_yPixelFactor = GetDeviceCaps(m_hAccess, logPixelsY)           'get
the DPI for y axis
m_hGDI = CreateCompatibleDC(m_hAccess)                          'get a
GDI device context handle
Call SetStretchBltMode(m_hGDI, COLORONCOLOR)                    'set a
default stretch mode for image handling
m_StretchMode = COLORONCOLOR                                    'and
match the internal variable too
With m_GUID
'establish the IPic GUID data elements
    .Data1 = &H7BF80980
    .Data2 = &HBF32
    .Data3 = &H101A
    .Data4(0) = &H8B
    .Data4(1) = &HBB
    .Data4(3) = &HAA
    .Data4(5) = &H30
    .Data4(6) = &HC
    .Data4(7) = &HAB
End With
Exit Sub                                                        'clean
initialisation

ErrorInitialize:
'report startup problems
    RaiseEvent ErrorEvent(Error, Err)                           'by
passing back the error message and event
End Sub

Private Sub Class_Terminate()
ReleaseDC Application.hWndAccessApp, m_hAccess
'release the device context handle
DeleteDC m_hGDI
'release the device context handle
Set m_iPic = Nothing
'release the IPic object from memory
If IsDimmed(m_ImageByteArray) Then
'release the byte array from memory
    Erase m_ImageByteArray
End If
End Sub

Private Sub CreateImage()                                       'This
creates the actual image from bytes
Dim ISTREAMPIC As stdole.IUnknown
'Temporarily used ISTREAM object
Dim hResult As Long
'result codes from API calls go here

On Error GoTo ErrorCreateImage                                  'set
the error handling

If IsDimmed(m_ImageByteArray) Then                              'If
the array is ready to go
    hResult = CreateStreamOnHGlobal(VarPtr(m_ImageByteArray(0)),
False, ISTREAMPIC)
    Stop
    If hResult = S_OK Then
        hResult = OleLoadPicture(ISTREAMPIC, _
                                UBound(m_ImageByteArray) -
LBound(m_ImageByteArray) + 1, _
                                0, _
                                VarPtr(m_GUID), _
                                m_iPic)
    End If
End If

Set ISTREAMPIC = Nothing
'cleanup
Exit Sub                                                        'and
clean exit

ErrorCreateImage:                                               'TODO:
implement result code handling
    RaiseEvent ErrorEvent(Error, Err)
    Set ISTREAMPIC = Nothing
End Sub

Private Function IsDimmed(ArrayName As Variant) As Boolean
On Error Resume Next
If IsNumeric(UBound(ArrayName)) Then
    IsDimmed = True
Else
    IsDimmed = False
End If
End Function

'_________________________________________________________________________________________
API Declarations:

'_______________________________________________________________________________________________________
'__________________________________________
NETWORKING__________________________________________________
'_______________________________________________________________________________________________________
Declare Function WSAStartup Lib "ws2_32" ( _
    ByVal intVersionRequested As Integer, _
    lpWSAData As WSADATA) As Long

Declare Function ws2_WSACleanup Lib "ws2_32.dll" _
    Alias "WSACleanup" () As Long

Declare Function ws2_WSAGetLastError Lib "ws2_32.dll" _
    Alias "WSAGetLastError" () As Long

Declare Function ws2_socket Lib "ws2_32.dll" Alias "socket" ( _
    ByVal lngAf As Long, _
    ByVal lngType As Long, _
    ByVal lngProtocol As Long) As Long

Declare Function ws2_shutdown Lib "ws2_32.dll" Alias "shutdown" ( _
    ByVal socket As Long, _
    ByVal how As Long) As Long

Declare Function ws2_closesocket Lib "ws2_32.dll" _
    Alias "closesocket" ( _
    ByVal SocketHandle As Long) As Long

Declare Function ws2_bind Lib "ws2_32.dll" Alias "bind" ( _
    ByVal socket As Long, _
    Name As sockaddr, _
    ByVal namelen As Long) As Long

Declare Function ws2_connect Lib "ws2_32.dll" Alias "connect" ( _
    ByVal socket As Long, _
    Name As sockaddr, _
    ByVal namelen As Long) As Long

Declare Function ws2_send Lib "ws2_32.dll" Alias "send" ( _
    ByVal socket As Long, _
    buf As Byte, _
    ByVal Length As Long, _
    ByVal flags As Long) As Long

Declare Function ws2_recv Lib "ws2_32.dll" Alias "recv" ( _
    ByVal socket As Long, _
    buf As Byte, _
    ByVal Length As Long, _
    ByVal flags As Long) As Long

Declare Function ws2_select Lib "ws2_32.dll" Alias "select" ( _
    ByVal nfds As Long, _
    readfds As fd_set, _
    writefds As fd_set, _
    exceptfds As fd_set, _
    timeout As timeval) As Long

'_______________________________________________________________________________________________________
'_____________________________________________GDI_______________________________________________________
'_______________________________________________________________________________________________________
Declare Function GetDeviceCaps Lib "gdi32" ( _
    ByVal hdc As Long, _
    ByVal nIndex As Long) As Long

Declare Function SetStretchBltMode Lib "gdi32" ( _
    ByVal hdc As Long, _
    ByVal nStretchMode As BltStretchMode) As Long
'hdc = Identifies the device context
'nStretchMode = Identifies the stretching mode

Declare Function StretchBlt Lib "gdi32" ( _
    ByVal hDestDC As Long, _
    ByVal x As Long, _
    ByVal y As Long, _
    ByVal nWidth As Long, _
    ByVal nHeight As Long, _
    ByVal hSrcDC As Long, _
    ByVal xSrc As Long, _
    ByVal ySrc As Long, _
    ByVal nSrcWidth As Long, _
    ByVal nSrcHeight As Long, _
    ByVal dwRop As Long) As Long
'hDestDC = Device context of the destination image
'x = The logical x (horizontal) coordinate of the destination images
upper left corner
'y = The logical y (vertical) coordinate of the destination images
upper left corner
'nWidth = The width of the destination image (in pixels)
'nHeight = The height of the destination image (in pixels)
'hSrcDC = Device context of the source image
'xSrc = The logical x (horizontal) coordinate of the source image
'ySrc = The logical y (vertical) coordinate of the source image
'nSrcWidth = The width of the source image
'nSrcHeight = The height of the source image
'dwRop = The raster operation to be used during the memory transfer
(select from global constants)
'***If the function succeeds the return value is non zero, or else
zero if it fails
'***Errors are available through GetLastError() function

Declare Function CreateCompatibleDC Lib "gdi32" ( _
    ByVal hdc As Long) As Long

Declare Function DeleteDC Lib "gdi32" ( _
    ByVal hdc As Long) As Long

Declare Function SelectObject Lib "gdi32" ( _
    ByVal hdc As Long, _
    ByVal hObject As Long) As Long

Declare Function DeleteObject Lib "gdi32" ( _
    ByVal hObject As Long) As Long

Public Declare Function CreateDIBSection Lib "gdi32" ( _
    ByVal hdc As Long, _
    ByRef pBitmapInfo As BITMAPINFO, _
    ByVal un As Long, _
    ByVal lplpVoid As Long, _
    ByVal handle As Long, _
    ByVal dw As Long) As Long

Declare Function BitBlt Lib "gdi32" ( _
    ByVal hDestDC As Long, _
    ByVal x As Long, _
    ByVal y As Long, _
    ByVal nWidth As Long, _
    ByVal nHeight As Long, _
    ByVal hSrcDC As Long, _
    ByVal xSrc As Long, _
    ByVal ySrc As Long, _
    ByVal dwRop As Long) As Long
'hDestDC = Device context of the destination image
'x = The logical x (horizontal) coordinate of the destination images
upper left corner
'y = The logical y (vertical) coordinate of the destination images
upper left corner
'nWidth = The width of the destination image (in pixels)
'nHeight = The height of the destination image (in pixels)
'hSrcDC = Device context of the source image
'xSrc = The logical x (horizontal) coordinate of the source image
'ySrc = The logical y (vertical) coordinate of the source image
'dwRop = The raster operation to be used during the memory transfer
(select from global constants)
'***If the function succeeds the return value is non zero, or else
zero if it fails
'***Errors are available through GetLastError() function

'_______________________________________________________________________________________________________
'_______________________________________________OLE_____________________________________________________
'_______________________________________________________________________________________________________
Declare Function OleLoadPicture Lib "oleaut32" ( _
    ByVal lpstream As stdole.IUnknown, _
    ByVal lSize As Long, _
    ByVal fRunmode As Long, _
    ByVal riid As Long, _
    lpIPicture As stdole.IPicture) As Long

Declare Function CreateStreamOnHGlobal Lib "ole32" ( _
    ByVal hGlobal As Long, _
    ByVal fDeleteOnRelease As Long, _
    lpIStream As stdole.IUnknown) As Long

Declare Function CLSIDFromString Lib "ole32" ( _
    ByVal lpsz As Long, _
    ByRef pclsid As IPicGUID) As Long

'_______________________________________________________________________________________________________
'___________________________________________Common
Dialog_______________________________________________
'_______________________________________________________________________________________________________
Declare Function GetOpenFileName Lib "comdlg32" Alias
"GetOpenFileNameA" ( _
    lpofn As OPENFILENAME) As Long

Declare Function GetSaveFileName Lib "comdlg32" Alias
"GetSaveFileNameA" ( _
    lpofn As OPENFILENAME) As Long

Declare Function CHOOSECOLOR Lib "comdlg32" Alias "ChooseColorA" ( _
    lpcc As CHOOSECOLOR) As Long

Declare Function CHOOSEFONT Lib "comdlg32" Alias "ChooseFontA" ( _
    lpcf As CHOOSEFONT) As Long

Declare Function CommDlgExtendedError Lib "comdlg32" ( _
    ) As Long

'_______________________________________________________________________________________________________
'_____________________________________________Kernel32__________________________________________________
'_______________________________________________________________________________________________________
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
    Ddestination As Any, _
    Source As Any, _
    ByVal Length As Long)

'_______________________________________________________________________________________________________
'______________________________________________User32___________________________________________________
'_______________________________________________________________________________________________________
Declare Function GetDC Lib "user32" ( _
    ByVal hwnd As Long) As Long

Declare Function ReleaseDC Lib "user32" ( _
    ByVal hwnd As Long, ByVal hdc As Long) As Long


'________________________________________________________________________________________

API Constants:

Option Compare Database

'_______________________________________________________________________________________________________
'__________________________________________
NETWORKING__________________________________________________
'_______________________________________________________________________________________________________
Public Const AF_INET = 2
Public Const INVALID_SOCKET = -1
Public Const SOCKET_ERROR = -1
Public Const FD_READ = &H1&
Public Const FD_WRITE = &H2&
Public Const FD_CONNECT = &H10&
Public Const FD_CLOSE = &H20&
Public Const FD_SETSIZE = 64
Public Const PF_INET = 2
Public Const SOCK_STREAM = 1
Public Const IPPROTO_TCP = 6
Public Const GWL_WNDPROC = (-4)
Public Const WINSOCKMSG = 1025
Public Const WSA_DESCRIPTIONLEN = 256
Public Const WSA_DescriptionSize = WSA_DESCRIPTIONLEN + 1
Public Const WSA_SYS_STATUS_LEN = 128
Public Const WSA_SysStatusSize = WSA_SYS_STATUS_LEN + 1
Public Const INADDR_NONE = &HFFFF
Public Const SOL_SOCKET = &HFFFF&
Public Const SO_LINGER = &H80&
Public Const hostent_size = 16
Public Const sockaddr_size = 16

'_______________________________________________________________________________________________________
'_____________________________________________GDI_______________________________________________________
'_______________________________________________________________________________________________________

'Constants for BitBlt and StretchBlt for dwRop raster operations
during memory transfer
Global Const SRCCOPY As Long = &HCC0020             'Destination =
Source
Global Const SRCPAINT As Long = &HEE0086            'Destination =
Source OR Destination
Global Const SRCAND As Long = &H8800C6              'Destination =
Source AND Destination
Global Const SRCINVERT As Long = &H660046           'Destination =
Source XOR Destination
Global Const SRCERASE As Long = &H440328            'Destination =
Source AND (NOT Destination)
Global Const NOTSRCCOPY As Long = &H330008          'Destination = NOT
Source
Global Const NOTSRCERASE As Long = &H1100A6         'Destination =
(NOT Source) AND (NOT Destination)
Global Const MERGECOPY As Long = &HC000CA           'Destination =
Source AND Pattern
Global Const MERGEPAINT As Long = &HBB0226          'Destination =
(NOT Source) OR Destination
Global Const PATCOPY As Long = &HF00021             'Destination =
Pattern
Global Const PATINVERT As Long = &H5A0049           'Destination =
Pattern XOR Destination
Global Const PATPAINT As Long = &HFB0A09            'Destination =
(NOT Source) OR Pattern OR Destination
Global Const DSTINVERT As Long = &H550009           'Destination = NOT
Destination
Global Const BLACKNESS As Long = &H42               'Destination = 0
Global Const WHITENESS As Long = &HFF0062           'Destination = All
bits set to 1

Enum BltStretchMode
    COLORONCOLOR = 3
    HALFTONE = 4
End Enum

'_______________________________________________________________________________________________________
'_______________________________________________OLE_____________________________________________________
'_______________________________________________________________________________________________________
Global Const E_POINTER As Long = &H80004003
Global Const E_NOINTERFACE As Long = &H80004002
Global Const E_INVALIDARG As Long = &H80070057
Global Const E_OUTOFMEMORY As Long = &H8007000E
Global Const S_OK As Long = &H0
'_______________________________________________________________________________________________________
'___________________________________________Common
Dialog_______________________________________________
'_______________________________________________________________________________________________________


'_______________________________________________________________________________________________________
'_____________________________________________Kernel32__________________________________________________
'_______________________________________________________________________________________________________


'______________________________________________________________________________________________

API Data Structures:

Option Compare Database

'_______________________________________________________________________________________________________
'__________________________________________
NETWORKING__________________________________________________
'_______________________________________________________________________________________________________
Public Type WSADATA
    wVersion As Integer
    wHighVersion As Integer
    szDescription As String * WSA_DescriptionSize
    szSystemStatus As String * WSA_SysStatusSize
    iMaxSockets As Integer
    iMaxUdpDg As Integer
    lpVendorInfo As Long
End Type

Type HostEnt
    h_name As Long
    h_aliases As Long
    h_addrtype As Integer
    h_length As Integer
    h_addr_list As Long
End Type

Type sockaddr
    sin_family As Integer
    sin_port As Integer
    sin_addr As Long
    sin_zero As String * 8
End Type

Type LingerType
    l_onoff As Integer
    l_linger As Integer
End Type

Public Type fd_set
    fd_count As Long
    fd_array(FD_SETSIZE) As Long
End Type

Public Type timeval
    tv_sec As Long
    tv_usec As Long
End Type

'_______________________________________________________________________________________________________
'_____________________________________________GDI_______________________________________________________
'_______________________________________________________________________________________________________
Public Type BITMAPINFOHEADER
    biSize As Long
    biWidth As Long
    biHeight As Long
    biPlanes As Integer
    biBitCount As Integer
    biCompression As Long
    biSizeImage As Long
    biXPelsPerMeter As Long
    biYPelsPerMeter As Long
    biClrUsed As Long
    biClrImportant As Long
End Type

Public Type RGBQUAD
    rgbBlue As Byte
    rgbGreen As Byte
    rgbRed As Byte
    rgbReserved As Byte
End Type

Public Type BITMAPINFO
    bmiHeader As BITMAPINFOHEADER
    bmiColors As RGBQUAD
End Type

'_______________________________________________________________________________________________________
'_______________________________________________OLE_____________________________________________________
'_______________________________________________________________________________________________________
Public Type IPicGUID                                           'ID
data for stdOLE IPictures
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(7) As Long
End Type

'_______________________________________________________________________________________________________
'___________________________________________Common
Dialog_______________________________________________
'_______________________________________________________________________________________________________
Public Type OPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type

Public Type CHOOSECOLOR
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    rgbResult As Long
    lpCustColors As Long
    flags As Long
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type

Public Type LOGFONT
    lfHeight As Long
    lfWidth As Long
    lfEscapement As Long
    lfOrientation As Long
    lfWeight As Long
    lfItalic As Byte
    lfUnderline As Byte
    lfStrikeOut As Byte
    lfCharSet As Byte
    lfOutPrecision As Byte
    lfClipPrecision As Byte
    lfQuality As Byte
    lfPitchAndFamily As Byte
    lfFaceName(1 To LF_FACESIZE) As Byte
End Type

Public Type CHOOSEFONT
    lStructSize As Long
    hwndOwner As Long ' caller's window handle
    hdc As Long ' printer DC/IC or NULL
    lpLogFont As LOGFONT ' ptr. to a LOGFONT struct
    iPointSize As Long ' 10 size points of selected font
    flags As Long ' enum. type flags
    rgbColors As Long ' returned text color
    lCustData As Long ' data passed to hook fn.
    lpfnHook As Long ' ptr. to hook function
    lpTemplateName As String ' custom template name
    hInstance As Long ' stance handle of.EXE that
    ' contains cust. dlg. template
    lpszStyle As String ' return the style field here
    ' must be LF_FACESIZE or bigger
    nFontType As Integer ' same value reported to the EnumFonts
    ' call back with the extra FONTTYPE_
    ' bits added
    MISSING_ALIGNMENT As Integer
    nSizeMin As Long ' minimum pt size allowed &
    nSizeMax As Long ' max pt size allowed if
    ' CF_LIMITSIZE is used
End Type

'_______________________________________________________________________________________________________
'_____________________________________________Kernel32__________________________________________________
'_______________________________________________________________________________________________________


And last but not least the code I am using to instantiate and test the
class:

Public Function LoadImage() As Variant
Dim fnum As Long
'Dim tmp() As Byte                          'for binary byte data
Dim tmp As String                           'for handling as string
data
Dim FileName As String

fnum = FreeFile
FileName = "D:\DATA\My Pictures\me.jpg"
Open FileName For Binary As fnum
'ReDim tmp(0 To LOF(fnum) - 1) As Byte      'this is binary byte data
tmp = Space(LOF(fnum))                      'this is as a string
Get #fnum, , tmp
Close #fnum
LoadImage = tmp
End Function

Sub testload()
'This is successful

Dim pic As Variant
pic = LoadImage


Dim c As clsImage
Set c = New clsImage

c.ImageByteArray = StrConv(pic, vbFromUnicode)

Set c = Nothing
End Sub

You can successfully bring an image (I am using a jpg as a test case)
to a byte array, pass the array in, and get positive result codes all
the way through including the OleLoadImage api call, but there is
simply no image returned. I dont know why. Everything appears to
follow the same pattern and calls, declarations etc as the example
database but it just doesnt do the same thing. The example database is
able to be found via Googling for bmp33a_05.mdb or .zip or .rar. Its
an older A97 database but seems to work quite nicely. I dropped my
file reading stuff into the code on the form to produce the byte array
I wanted from a file rather than using the stored image thinking that
perhaps I had somehow mishandled that part, but when I converted it to
a unicode string with StrConv and fed the files data into the process
the image from the file was displayed on the form - so I guess thats
not it. I have absolutely no idea why this fails (although
successfully apparently) in the class module.

Any ideas?

The Frog
0
Reply mr.frog.to.you (502) 2/13/2011 9:20:31 PM 

Hi everyone,

Been away for a bit, and had a play with this when the weather was
rubbish. I re-typed this into a new module, and imported the api
declarations, constants and structures from the original mdb file and
for some reason the damn thing works! Wont work in the old, wil work
in the new. Bloody wierd. No idea why. Done all the repair / compact
stuff but no difference. Now I am rebuilding the app in a new
mdb......

Just thought I'd share.

The Frog
0
Reply The 2/21/2011 8:30:56 AM 

freelance writer
0
Reply Hopkins32Debra 2/26/2011 10:52:37 PM 

Is that an accidental cross-post?

The Frog
0
Reply The 2/28/2011 8:32:29 AM
comp.databases.ms-access 42108 articles. 8 followers.

6 Replies
146 Views

(page loaded in 0.328 seconds)

Similiar Articles:

NURBS Capabilities for Matlab - comp.soft-sys.matlab
I'm helping develop a 400 level class for digital design, and I was asked to find out what ... functionality, and it looks at first glance to be identical to the release ...

NIOS: Run program from SDRAM - comp.arch.fpga
... with APEX FPGA.It has a SODIMM socket for SDRAM module. I use ... based on Micron datasheet and I put it into class ... I've had similar problems, and found them pretty quickly ...

Misuses of RTTI - comp.lang.c++.moderated
... around proper, more robust design. Only use RTTI ... names would cause performance problems for introspection - then long class ... is shipped when a dependent module is ...

Please Reproduce: PHP 5.2 -> 5.3 Windows Apache2.2 crash - comp ...
What are the problems you're having with this "proper ... Although the class uses dated OOP, everything seemed to ... This is generally bad design, since it leaks ...

writing robust software? - comp.lang.c++.moderated
I seem to remember a "class initialized<T ... the standard library containers use. The most glaring issue is ... leaks, dangling pointers etc. Use correct design then ...

no ntp synchronisation: 2s to 6s time shift ! - comp.protocols ...
I would say 2s/day is in the upper class ... > > The hpet module uses the High Precision Event ... than on Unix machines as Windows uses threads so there's no issue with ...

Ada in Boeing 787 - comp.lang.ada
... Systems who claims that the Boeing 787 does not use Ada ... think the reason why tools won is that the language design ... systems were offered only in first and business class ...

[comp.publish.cdrom] CD-Recordable FAQ, Part 1/4 - comp.publish ...
Archive-name: cdrom/cd-recordable/part1 Posting-Frequency: monthly Last-modified: 2008/10/09 Version: 2.71 Send corrections and updates to And...

improve strlen - comp.lang.asm.x86
... on stack either with objects with "auto" storage class ... variables could be dropped out without aliasing problems ... I also keep rendering module not too integrated with ...

Re: PDE toolbox initial condi - comp.soft-sys.matlab
Re: PDE toolbox initial condi Follow

Issue designing a class module that uses OleLoadPicture
Relevant Pages. Re: Issue designing a class module that uses OleLoadPicture... There is a private sub that works on the byte array using the api ... Declare Function ...

Using Classes in VBA | Expert Zone
Software Release History; Authors ... from outside the class – generally considered bad Object Oriented Design – use ... you will select Insert / Class Module ...

7/17/2012 7:18:23 AM


Reply:



Privacy Policy | All Times Are GMT(UTC) | powered by