Cropping a bitmap after a copy 1

[richrock316]

Hi,

I've been using some code previously written by Hypetia (thanks Hypetia) to capture the screen image and export it to a bitmap. It has been working great, but now my specs have changed. I need to crop the picture to include only part of the screen. Ive got it so that it eliminates the unnecessary part of the screen when I want to but it leaves a large blank space. Think of it as 2 images side by side, you erase te right one, but you then have half the space being wasted, which sucks when you are creating a BMP. How do I eliminate the unwanted portion?.

Here is the code

v
Function CaptureImage(hwnd As Long, which_save As String) As Picture
Dim hdc As Long, R1 As RECT, R2 As RECT
Contact.Picture1.AutoRedraw = True 'Added 07/25/05 otherwise gives incomplete picture
GetWindowRect hwnd, R1
R2 = R1
hdc = GetWindowDC(hwnd)
ScreenToClient hwnd, R2
If which_save = "whole_screen" Then
BitBlt Picture1.hdc, 0, 0, R1.Right - R1.Left, R1.Bottom - R1.Top, hdc, -R2.Left, -R2.Top, vbSrcCopy
Else
'Here is where the partial screen comes up
BitBlt Picture1.hdc, 0, 0, 570 / screen_res, 550 / screen_res, hdc, -R2.Left, -R2.Top, vbSrcCopy
End If
ReleaseDC hwnd, hdc
Set CaptureImage = Picture1.Image
End Function

thanks
Richard

 

[Hypetia]

I believe you took this code from thread222-617312 which is about three years old. After revisiting the thread I found that the code can be simplified further.

I am posting the modified version here which is much simpler and covers both cases discussed earlier, using the same function (i.e. capturing image with or without client area).

This code, like the previous versions, requires a picturebox (Picture1) with AutoRedraw=True, Visible=False and BorderStyle=0.
___
[tt]
Option Explicit
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function OffsetRect Lib "user32" (lpRect As RECT, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetDC 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 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
Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Sub Command1_Click()
SavePicture CaptureImage(hwnd, False), "C:\client-only.bmp"
SavePicture CaptureImage(hwnd, True), "C:\full-image.bmp"
End Sub
Function CaptureImage(hwnd As Long, Optional IncludeNC As Boolean) As Picture
Dim hDC As Long, rc As RECT
If IncludeNC Then 'incldue non-client area (title-bars, menus etc)
GetWindowRect hwnd, rc
OffsetRect rc, -rc.Left, -rc.Top
hDC = GetWindowDC(hwnd)
Else 'client area only
GetClientRect hwnd, rc
hDC = GetDC(hwnd)
End If
Picture1.Cls
MoveWindow Picture1.hwnd, 0, 0, rc.Right, rc.Bottom, 0
BitBlt Picture1.hDC, 0, 0, rc.Right, rc.Bottom, hDC, 0, 0, vbSrcCopy
ReleaseDC hwnd, hDC
Set CaptureImage = Picture1.Image
End Function[/tt]
___

Now coming to your question. As you are shrinking the bitmap to new (smaller) dimensions, you need to shrink the target picture box as well. In the above code and previous versions, you can see the picture box is resized to the size of the required bitmap before calling the BitBlt function. This is important because the captured bitmap has the same size as that of picture box client area.

So in order to do a BitBlt like this:
[tt]BitBlt Picture1.hdc, 0, 0, 570 / screen_res, 550 / screen_res, ...[/tt]

You need to size the picture box accordingly prior to BitBlt.
[tt]MoveWindow Picture1.hWnd, 0, 0, 570 / screen_res, 550 / screen_res, 0[/tt]

Sizing the picturebox to the size of required bitmap will not leave blank spaces in the captured bitmap.

Hope that helps.

 

[richrock316]

Thanks Hypetia

that was exactly what I needed. Couldn't see the forest for the trees.

 

[strongm]

If you are using XP or Windows 2003 there's an even simpler method. Just have a look at the PaintWindow API.

 

[dilettante]

Come on strongm, we all know that XP is just Win2k with a Service Pack. ;-)

 

[Hypetia]

strongm,
I think you wanted to say PrintWindow API. I remember we talked about this last year in thread222-1100736.

 

[strongm]

Yep, I did indeed mean PrintWindow - fingers going faster than my aging brain ...