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_Im ageByteArray)),
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

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 (AT) googlemail (DOT) com> wrote

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_Im ageByteArray)),
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

'_________________________________________________ __________________________________________________ ____
'_______________________________________________OL E_________________________________________________ ____
'_________________________________________________ __________________________________________________ ____
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

'_________________________________________________ __________________________________________________ ____
'_____________________________________________Kern el32______________________________________________ ____
'_________________________________________________ __________________________________________________ ____
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
Ddestination As Any, _
Source As Any, _
ByVal Length As Long)

'_________________________________________________ __________________________________________________ ____
'______________________________________________Use r32_______________________________________________ ____
'_________________________________________________ __________________________________________________ ____
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

'_________________________________________________ __________________________________________________ ____
'_______________________________________________OL E_________________________________________________ ____
'_________________________________________________ __________________________________________________ ____
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____________________________________________ ___
'_________________________________________________ __________________________________________________ ____


'_________________________________________________ __________________________________________________ ____
'_____________________________________________Kern el32______________________________________________ ____
'_________________________________________________ __________________________________________________ ____


'_________________________________________________ _____________________________________________

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

'_________________________________________________ __________________________________________________ ____
'_______________________________________________OL E_________________________________________________ ____
'_________________________________________________ __________________________________________________ ____
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

'_________________________________________________ __________________________________________________ ____
'_____________________________________________Kern el32______________________________________________ ____
'_________________________________________________ __________________________________________________ ____


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

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

Is that an accidental cross-post?

The Frog