Draw an activeX control

[The Man]

Hello,

Can anyone tell me how to draw an activeX control. I 've a PictureBox which I want to fill with an image of ActiveX control. The image should have the same size as the current size of the picturebox.
I know that an ActiveX control can draw itself (IVIewobject::Draw), but i don't know how to get the image (of a specific size) of an activeX control in VB.

I tried to do it like this (with the OleDraw API function):


public Type RECT
Left as Long
Top as Long
Right as Long
Bottom as Long
End Type

public Declare Sub OleDraw Lib "ole32.dll" (byval pUnknown as Long, byval dwAspect as Long, byval hdcDraw as Long, byref lprcBounds as RECT)

public sub CopyControlImage(SourceControl as object, TargetConrol as PictureBox)
Dim udtRect as RECT

udtRect.Bottom = SourceControl .Height
udtRect.Left = 0
udtRect.Top = 0
udtRect.Right = SourceControl.Width

'Clear the picture
TargetConrol.Picture = LoadPicture()

'Load picture image into a PictureBox control
OleDraw SourceControl, 1, TargetConrol.hdc, udtRect

'Repaint
TargetConrol.refresh
end sub





Hope to hear from you soon, Thanx in advance!!!!

Raymond Koning

[Cakkie]

first of all, I like the subject ;)

Now, to get to the point, I don't have an all solving solution, but I do have a solution for controls that have a hWnd (handle to window), that is, most (not all) visible controls like textbox, picturebox, buttons, checkboxes, option buttons and some others stuff. It might work with other controls, but only if you manage to get it's hwnd one way or another.
When we have a hwnd, we can get the hDC (device context) which we can copy using BitBlt.

public Type RECT
Left as Long
Top as Long
Right as Long
Bottom as Long
End Type

Declare Function GetWindowDC Lib "user32" (byval hwnd 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

public Const SRCCOPY = &HCC0020 ' (DWORD) dest = source

public Sub CopyControlImage(SourceControl as Object, TargetConrol as PictureBox)

' get rect, comes in handy when BitBlt'ing, getting it in pixels
Dim udtRect as RECT
udtRect.Bottom = SourceControl.Height / Screen.twipsPerPixelY
udtRect.Left = 0
udtRect.Top = 0
udtRect.Right = SourceControl.Width / Screen.twipsPerPixelX

'Clear the picture
TargetConrol.Picture = LoadPicture()

' get the hDc from the hWnd
Dim hDC as Long
hDC = GetWindowDC(SourceControl.hwnd)

' copy the content to the target control
BitBlt TargetConrol.hDC, 0, 0, udtRect.Right / Screen.TwipsPerPixelX, udtRect.Bottom / Screen.TwipsPerPixelY, hDC, 0, 0, SRCCOPY

End Sub



As said before, doesn't work for all controls, but the most common will do.

Tom Cannaerts
slisse@planetinternet.be

Programming today is a race between software engineers striving to build bigger and better idot-proof programs, and the universe trying to produce bigger and better idiots. So far, the universe is winning -- Rich Cook

[Cakkie]

Ok, I made a little mistake here, I converted from twips to pixels twice, so you should remove them in one of two places, namely the assignment in to the rect, or when calling BitBlt.

Tom Cannaerts
slisse@planetinternet.be

Programming today is a race between software engineers striving to build bigger and better idot-proof programs, and the universe trying to produce bigger and better idiots. So far, the universe is winning -- Rich Cook

[The Man]

Thanx Cakkie,

I've implemented your solution and it works fine.
If I had any money I would send it to you ;)...


Regards,

Raymond

[Cakkie]

We accept all mayor credit cards ;)

Tom Cannaerts
slisse@planetinternet.be

Programming today is a race between software engineers striving to build bigger and better idot-proof programs, and the universe trying to produce bigger and better idiots. So far, the universe is winning -- Rich Cook

[The Man]

Cakkie,

Since you're the only one who replied on my messages. Do you have any idea how to get a hDc of an activeX control which doesn't have a hWnd property?

Any suggestions from other readers are offcourse also appriciated,

raymond

[Cakkie]

You could add to control to a container, like a picturebox, set the picturebox borderstyle to none, and appearance to flat, make it exactly as large as the control that's planeted in it, and use the CopyControlImage on the picturebox (or other container). I would advice to do it this way.

Another thing you can do is the following, it get's the hwnd of the parent control (which in many cases will be a form or container, and those always have a hwnd). then it cuts the picture of the control out of the DC onto the destination. I tested it and I was able to get a picture of a scrollbar, datacontrol etc... The only drawback to this method is that you will need to move the DC a bit, cause the left and top properties don't include the titlebar, and the DC does. (If you set the border propery of the form to none, it works without having to add the values)

public Sub CopyControlImage(SourceControl as Object, TargetConrol as PictureBox)

' get rect, comes in handy when BitBlt'ing, getting it in pixels
Dim udtRect as RECT

With udtRect
.Left = SourceControl.Left / Screen.TwipsPerPixelX
.Top = SourceControl.Top / Screen.TwipsPerPixelY
.Right = (SourceControl.Width / Screen.TwipsPerPixelX) + .Left
.Bottom = (SourceControl.Height / Screen.TwipsPerPixelY) + .Top
End With

'Clear the picture
TargetConrol.Picture = LoadPicture()

' get the hDc from the PARENT hWnd
' this only works if the control is on a form or any other container with hWnd
Dim hDC as Long
hDC = GetWindowDC(SourceControl.Parent.hwnd)

' copy the content to the target control
BitBlt TargetConrol.hDC, 0, 0, udtRect.Right - udtRect.Left, udtRect.Bottom - udtRect.Top, hDC, udtRect.Left, udtRect.Top, SRCCOPY

End Sub




Tom Cannaerts
slisse@planetinternet.be

Programming today is a race between software engineers striving to build bigger and better idot-proof programs, and the universe trying to produce bigger and better idiots. So far, the universe is winning -- Rich Cook