Obtener imagen

No tenia esta rutina pero la adapte para obtener una parte del desktop que yo elija mediante las coordenadas POR, Y, el ancho y alto de la imagen.
El código de donde me basé se encuentra en
http://vbaccelerator.com/tips/vba0003.htm
y para obtener una parte de la ventana lo encontre en
http://www.geocities.com/SiliconValley/Park/6981/vbworkshop.htm
Y como ya estaba picado me puse a estudiar más sobre el tema en
http://www.vbexplorer.com/library/bitbltprimer.htm
este es el código resultante:
************ INTRODUCE ESTO EN UN MODULO************
Option Explicit
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, _
lpRect As RECT) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function CreateDCAsNull Lib "gdi32" Alias "CreateDCA" _
(ByVal lpDriverName As String, lpDeviceName As Any, _
lpOutput As Any, lpInitData As Any) 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 Const SRCCOPY = &HCC0020 ' (DWORD) dest = source
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Public Sub CopyDesktop(ByRef objTo As Object, X As Integer, Y As Integer, iAncho As Integer, iAlto As Integer)
Dim hWnd As Long
Dim tR As RECT
Dim hDC As Long
' Note: objTo must have hDC, Picture, Width and Height
' properties and should have AutoRedraw = True
' Get the size of the desktop window:
hWnd = GetDesktopWindow()
GetWindowRect hWnd, tR
' Set the object to the relevant size:
'objTo.Width = (tR.Right - tR.Left) * Screen.TwipsPerPixelX
'objTo.Height = (tR.Bottom - tR.Top) * Screen.TwipsPerPixelY
iAncho = iAncho * Screen.TwipsPerPixelX
iAlto = iAlto * Screen.TwipsPerPixelY
objTo.Width = iAncho
objTo.Height = iAlto
' Now get the desktop DC:
hDC = CreateDCAsNull("DISPLAY", ByVal 0&, ByVal 0&, ByVal 0&)
' Copy the contents of the desktop to the object:
BitBlt objTo. HDC, 0, 0, iAncho, iAlto, _
HDC, POR, Y, SRCCOPY
' Ensure we clear up DC GDI has given us:
DeleteDC hDC
End Sub
**************************
Asi lo ejecuto desde una Form
Private Sub Command1_Click()
Me.WindowState = vbMinimized
DoEvents
Picture1. Cls
CopyDesktop Picture1, 100, 100, 100, 150
Picture1. Refresh
End Sub
Donde Picture1 es un picturebox donde vas a atrapar la parte de la ventana deseada.
Espero esto te ayude, Saludos.
Fernando Beltran
[email protected]