Nanni
Dec 15th, 2009, 03:53 AM
Hi to all
I have a problem with an activex dll.
I see, in the idl, a statement like
HRESULT GetBytes([out] void **buffer);
and in VB6 Object Browser I see
Sub GetBytes(buffer As Any).
Calling this function I get this error
"...the function uses an Automation type not supported in Visual Basic"
How I can call this Function from VB6?
or
How I can Modify the declaration in the Idl and get a TLB to be used in VB6??
Thanks fo any Help
Nanni
Nanni
Jan 13th, 2010, 08:15 AM
Hi to all.
I'm sorry to bother with my question.
I need some help to translate this code in vb6.
This is a working sample from original C Code:
void GdiDraw (Frame* theFrame)
{
// This function create a GDI bitmap, draws basic shapes
// in it, and copies its content to the buffer of the
//frame given in argument.
BITMAPINFOHEADER bmi;
// setup the bitmap info header members
ZeroMemory(&bmi, sizeof(bmi));
bmi.biSize = sizeof(bmi);
bmi.biWidth = theFrame->GetWidth();
bmi.biHeight = theFrame->GetHeight();
bmi.biPlanes = 1;
bmi.biBitCount = 32;
bmi.biCompression = BI_RGB;
bmi.biSizeImage = (bmi.biWidth * bmi.biHeight * 4);
// create a device context
HDC hdc = CreateCompatibleDC(NULL);
// create background and foreground rectangles
RECT fillRect = {0, 0, bmi.biWidth, bmi.biHeight};
RECT fillRect2 = {50, 50, 100, 100};
RECT fillRect3 = {100, 100, 150, 150};
RECT fillRect4 = {150, 150, 200, 200};
// pointer to the bitmap buffer
BYTE* pbData = NULL;
// create the bitmap and attach it to our device context
HBITMAP hbm = CreateDIBSection(hdc, (BITMAPINFO*)&bmi, DIB_RGB_COLORS, (void**)&pbData, NULL, 0);
SelectObject(hdc, hbm);
// create a brush to draw objects with
HBRUSH backBrush = (HBRUSH)GetStockObject(DC_BRUSH);
SetDCBrushColor(hdc, RGB(50, 50, 110));
// draw background rectangle
FillRect(hdc, &fillRect, backBrush);
// draw string in centre of screen
TextOut(hdc, bmi.biWidth/2, bmi.biHeight/2, _T("Hello, world!"), 13);
// draw red, green and blue foreground rectangles
SetDCBrushColor(hdc, RGB(222, 20, 0));
FillRect(hdc, &fillRect2, backBrush);
SetDCBrushColor(hdc, RGB(0, 222, 0));
FillRect(hdc, &fillRect3, backBrush);
SetDCBrushColor(hdc, RGB(0, 0, 222));
FillRect(hdc, &fillRect4, backBrush);
// draw ellipse
Ellipse(hdc, 200, 200,300,300);
//This is my problem
//--------------------------------------
// get a pointer to our frame buffer
BYTE* pbDestData = NULL;
theFrame->GetBytes((void**)&pbDestData);
// copy the bitmap buffer content
memcpy(pbDestData, pbData, bmi.biSizeImage);
//-----------------------------------------
// delete attached GDI object and free bitmap memory
DeleteObject(SelectObject(hdc, hbm));
}
I have translated this in vb Code (not All):
' modify lplpVoid to be Byref so we get the pointer back:
Private Declare Function CreateDIBSection Lib "gdi32" _
(ByVal hDC As Long, pBitmapInfo As BITMAPINFO, _
ByVal un As Long, ByRef lplpVoid As Long, _
ByVal handle As Long, ByVal dw As Long) As Long
' // create a device context
mHDC = CreateCompatibleDC(0)
With mHBITMAP.bmiHeader
.biSize = Len(mHBITMAP.bmiHeader)
.biWidth = theFrame.GetWidth
.biHeight = theFrame.GetHeight
.biPlanes = 1
.biBitCount = 32
.biCompression = BI_RGB
.biSizeImage = .biWidth * .biHeight *4
End With
hDib = CreateDIBSection(mHDC, mHBITMAP, DIB_RGB_COLORS, m_lPtr, 0, 0)
hOldBmp = SelectObject(mHDC, hDib)
backBrush = GetStockObject(DC_BRUSH)
SetDCBrushColor mHDC, RGB(50, 100, 50)
'Some Graphics
RetVal = SetRect(mRect, 100, 0, 300, 175)
RetVal = FillRect(mHDC, mRect, backBrush)
Call TextOut(mHDC, 100, 200, "Hello, world!", 13)
'I don't can Call This
dim destData as long
theFrame.GetBytes destData
memcpy '?? how copy dib to the other frame Buffer?
Call DeleteObject(backBrush)
Call SelectObject(mHDC, hOldBmp)
Call DeleteDC(mHDC)
Call DeleteObject(hDib)
Please, how I can get this Pointer in VB6
and copy the dib to the other Frame Buffer?
Thanks for Help
Nanni
LaVolpe
Jan 13th, 2010, 09:09 AM
HRESULT GetBytes([out] void **buffer);
^^ I believe that means either provide a NULL or a pointer to a pointer. In this case, it means provide 0& or the first element of an array, i.e.,
Ex1: GetBytes 0& ' not sure why one would pass null here though
Ex2: ReDim myArray(0 to whatever)
GetBytes myArray(0)
Here is an excellent tutorial (http://edais.mvps.org/Tutorials/index.html), one of my all-time favorites, regarding your topic. Jump to bottom where it discusses DIBs. I had some problems getting there this AM, try later if needed.
Edited: You don't need to use that function, an API already exists: GetDIBits. It is discussed in the tutorials.
whatsup
Apr 18th, 2010, 09:26 AM
this is usually pointer to array of pointers
in vb it can look like: a() as string
string is a pointer (unless it is fixed size: string * 128)
so a() as string is array of strings (pointers)
the problem can be when you want to pass a null pointer = Zero value
in that case i don't know how to do that, (i think vb doesn't support that)
but here is atleast one very easy / simple solution
every time you need to pass a null pointer you can have a second decleration
of the API:
declare Sub ... MySub1(ByRef MyPointer() As String)
declare Sub ... MySub2(ByVal MyPointer As Long)
every time you want to use a none-null pointer, you call the first sub
every time you want to use a null pointer, you call the second sub:
Call MySub2(0)
LaVolpe
Apr 18th, 2010, 11:40 AM
Passing a null pointer or non-null pointer to an API is simple without having 2 API declarations.
1. You can do it the way you described and many do, nothing wrong with that.
2. Another way is to declare the API parameter ByRef As Any. This allows you to literally pass anything the API can use, including ByVal 0& which is a null pointer for strings. Downside. You need to know what you are passing, passing the wrong vartype or not using ByRef/ByVal when required can result in a crash.
An example of #2 is the commonly-used SendMessage API where the final parameter (lParam) is delcared ByRef As Any.
:: Passing a string.... SendMessage(hWnd, uMsg, wParam, ByVal myString)
:: Passing a null pointer... SendMessage(hWnd, uMsg, wParam, ByVal 0&)
:: Passing a numeric value... SendMessage(hWnd, uMsg, wParam, myLong)
:: Passing a UDT (user-defined type)... SendMessage(hWnd, uMsg, wParam, ByVal VarPtr(myUDT))