Stumped: Using Compatible DC to save picturebox

Marce22
02-04-2005, 05:40 PM
I found this great code provided by a fellow Xtreme VB member, greg85374 (http://visualbasicforum.com/showthread.php?t=207390&highlight=compatible):


Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Private Type PICTDESC
cbSize As Long
pictType As Long
hIcon As Long
hPal As Long
End Type

Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" _
(lpPictDesc As PICTDESC, riid As Any, ByVal fOwn As Long, _
ipic As IPicture) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As _
Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As Long, _
ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, _
ByVal hObject As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDCDest As Long, _
ByVal XDest As Long, ByVal YDest As Long, ByVal nWidth As Long, _
ByVal nHeight As Long, ByVal lScreenDC As Long, ByVal XSrc As Long, _
ByVal YSrc As Long, ByVal dwRop As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, _
ByVal hDC As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, _
lpRect As RECT) As Long

' Capture the contents of a window or the entire screen

Function GetScreenSnapshot(Optional ByVal hWnd As Long) As IPictureDisp
Dim targetDC As Long
Dim hDC As Long
Dim tempPict As Long
Dim oldPict As Long
Dim wndWidth As Long
Dim wndHeight As Long
Dim Pic As PICTDESC
Dim rcWindow As RECT
Dim guid(3) As Long

' provide the right handle for the desktop window
If hWnd = 0 Then hWnd = GetDesktopWindow

' get window's size
GetWindowRect hWnd, rcWindow
wndWidth = rcWindow.Right - rcWindow.Left
wndHeight = rcWindow.Bottom - rcWindow.Top
' get window's device context
targetDC = GetWindowDC(hWnd)

' create a compatible DC
hDC = CreateCompatibleDC(targetDC)

' create a memory bitmap in the DC just created
' the has the size of the window we're capturing
tempPict = CreateCompatibleBitmap(targetDC, wndWidth, wndHeight)
oldPict = SelectObject(hDC, tempPict)

' copy the screen image into the DC
BitBlt hDC, 0, 0, wndWidth, wndHeight, targetDC, 0, 0, vbSrcCopy

' set the old DC image and release the DC
tempPict = SelectObject(hDC, oldPict)
DeleteDC hDC
ReleaseDC GetDesktopWindow, targetDC

' fill the ScreenPic structure
With Pic
.cbSize = Len(Pic)
.pictType = 1 ' means picture
.hIcon = tempPict
.hPal = 0 ' (you can omit this of course)
End With

' convert the image to a IpictureDisp object
' this is the IPicture GUID {7BF80980-BF32-101A-8BBB-00AA00300CAB}
' we use an array of Long to initialize it faster
guid(0) = &H7BF80980
guid(1) = &H101ABF32
guid(2) = &HAA00BB8B
guid(3) = &HAB0C3000
' create the picture,
' return an object reference right into the function result
OleCreatePictureIndirect Pic, guid(0), True, GetScreenSnapshot

End Function

Private Sub Command1_Click()
Picture2.Picture = GetScreenSnapshot(Picture1.hWnd)
end Sub


HOWEVER, if Picture1 is not completely visible (like if it is partially off the my monitor's screen) or if the form is minimized, it will not properly save the picture box's picture (there will be a big black space). I tried enabling "auto-redraw" but this doesn't solve anything.. Any ideas????

RayOK
02-04-2005, 06:50 PM
Just guessing.. but how about AutoSize = True?

Marce22
02-04-2005, 08:01 PM
Just guessing.. but how about AutoSize = True?

no, doesn't work, sorry.

RayOK
02-04-2005, 11:17 PM
Hmm, not exactly sure. But here is an alternative screen capture method you could work off of. Just click on the DIB example on this page: GetDIBits API.. If you copy and paste that code an run it it captures the screen. :)

Also, check out this example: http://www.cgi-interactive-uk.com/screen_capture_VB6_thumbnail_creation.html
It seems like a simple example to capture the screen to the clipboard. And after that it shows how to save it to a file using the FreeImage.dll :)

passel
02-05-2005, 08:21 PM
If it's a Picturebox you're trying to capture, set its AutoRedraw property to True and
use its hdc (i.e. Picture1.hDC) instead of TargetDC.

The code above is meant to capture the screen image of a window.

Of course, if your picturebox has controls it it, those will not be captured by using
Picture1.hDC with AutoRedraw set True.


Another possible option is to send a message to the picturebox you want to
capture and tell it to draw itself and have it ask its children to print themselves
to your destination DC (picturebox).

You can capture the "off screen area" and controls within the picturebox
because they are drawn in your picturebox the way they would be drawn on
the screen.

Quick example. Put a picturebox (Picture1) on the form and display a picture
in the background, and add some shape controls, labels, button(s) and textbox(s) to it.
You can have it partially outside the form if you want, and AutoRedraw does
not have to be set to True for that picturebox.

Add another picturebox (Picture2) and make it big enough to hold a copy of
Picture1.

Then try this code (modify the Command2 name to whatever name the
command button has that you will put this code in. The command button (in my case)
was on the form, not in either of the pictureboxes.

Private Declare Function SendMessage Lib "user32" Alias _
"SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long

Private Const WM_PAINT = &HF
Private Const WM_PRINT = &H317
Private Const PRF_CLIENT = &H4& ' Draw the window's client area
Private Const PRF_CHILDREN = &H10& ' Draw all visible child
Private Const PRF_OWNED = &H20& ' Draw all owned windows


Private Sub Command2_Click()
Dim L As Long
Picture2.AutoRedraw = True
L = SendMessage(Picture1.hwnd, WM_PAINT, Picture2.hDC, 0)
L = SendMessage(Picture1.hwnd, WM_PRINT, Picture2.hDC, PRF_CHILDREN + PRF_CLIENT + PRF_OWNED)
Picture2.Refresh
End Sub


I did have a problem with the RichTextBox control not printing it's client area,
for some reason, but normal textboxes work. You can work around that by
sending a message directly to the RichTextBox and capture it's print in another DC.
You could then bitblt it into the proper place in your Capture box.

EZ Archive Ads Plugin for vBulletin Copyright 2006 Computer Help Forum