elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.

 

 


Tema destacado: Trabajando con las ramas de git (tercera parte)


+  Foro de elhacker.net
|-+  Programación
| |-+  Programación General
| | |-+  .NET (C#, VB.NET, ASP)
| | | |-+  Programación Visual Basic (Moderadores: LeandroA, seba123neo)
| | | | |-+  Copiar pantalla segun coordenadas
0 Usuarios y 1 Visitante están viendo este tema.
Páginas: [1] Ir Abajo Respuesta Imprimir
Autor Tema: Copiar pantalla segun coordenadas  (Leído 1,449 veces)
SheKeL_C$


Desconectado Desconectado

Mensajes: 549


_-=[Sh3K3L_C$]=-_


Ver Perfil
Copiar pantalla segun coordenadas
« en: 8 Febrero 2009, 15:36 pm »

El titulo lo dice practicamente todo...

Es posible copiar parte de la pantalla segun las coordenadas (X e Y) y luego su anchura/altura??

Ya se que lo que se puede hacer es copiar la pantalla, meterla en un picture y a partir de ahi, recortarla; pero esto me demora mucho lo que quiero hacer es directamente copiarlo

Sino es posible hacerlo en este lenguaje.. me podrias decir con cual otro se puede hacer???


En línea

yovaninu


Desconectado Desconectado

Mensajes: 349



Ver Perfil
Re: Copiar pantalla segun coordenadas
« Respuesta #1 en: 8 Febrero 2009, 17:46 pm »

Vengo trabajando hace un tiempo con esto de capturar una parte de la pantalla, funciona bien en mi troyano y te lo dejo a ver si es lo que quieres:

en un modulo:
Código
  1. Option Explicit
  2.  
  3. Declare Function GetActiveWindow _
  4.        Lib "user32.dll" () As Long
  5. Declare Function FlashWindow Lib "user32.dll" _
  6.       (ByVal hwnd As Long, _
  7.        ByVal bInvert As Long) As Long
  8. Declare Sub Sleep Lib "kernel32.dll" _
  9.       (ByVal dwMilliseconds As Long)
  10.  
  11.  
  12. Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
  13. ' ----==== GDIPlus Const ====----
  14. Public Const GdiPlusVersion As Long = 1
  15. Private Const mimeJPG As String = "image/jpeg"
  16.  
  17. Private Const EncoderParameterValueTypeLong As Long = 4
  18. Private Const EncoderQuality As String = "{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"
  19. Private Const EncoderCompression As String = "{E09D739D-CCD4-44EE-8EBA-3FBF8BE4FC58}"
  20. ' ----==== Sonstige Types ====----
  21. Private Type PICTDESC
  22.    cbSizeOfStruct As Long
  23.    picType As Long
  24.    hgdiObj As Long
  25.    hPalOrXYExt As Long
  26. End Type
  27.  
  28. Private Type IID
  29.    Data1 As Long
  30.    Data2 As Integer
  31.    Data3 As Integer
  32.    Data4(0 To 7)  As Byte
  33. End Type
  34.  
  35. Private Type GUID
  36.    Data1 As Long
  37.    Data2 As Integer
  38.    Data3 As Integer
  39.    Data4(0 To 7) As Byte
  40. End Type
  41.  
  42. ' ----==== GDIPlus Types ====----
  43. Private Type GDIPlusStartupInput
  44.    GdiPlusVersion As Long
  45.    DebugEventCallback As Long
  46.    SuppressBackgroundThread As Long
  47.    SuppressExternalCodecs As Long
  48. End Type
  49.  
  50. Private Type GdiplusStartupOutput
  51.    NotificationHook As Long
  52.    NotificationUnhook As Long
  53. End Type
  54.  
  55. Private Type EncoderParameter
  56.    GUID As GUID
  57.    NumberOfValues As Long
  58.    type As Long
  59.    Value As Long
  60. End Type
  61.  
  62. Private Type EncoderParameters
  63.    Count As Long
  64.    Parameter(15) As EncoderParameter
  65. End Type
  66.  
  67. Private Type ImageCodecInfo
  68.    Clsid As GUID
  69.    FormatID As GUID
  70.    CodecNamePtr As Long
  71.    DllNamePtr As Long
  72.    FormatDescriptionPtr As Long
  73.    FilenameExtensionPtr As Long
  74.    MimeTypePtr As Long
  75.    Flags As Long
  76.    Version As Long
  77.    SigCount As Long
  78.    SigSize As Long
  79.    SigPatternPtr As Long
  80.    SigMaskPtr As Long
  81. End Type
  82.  
  83. ' ----==== GDI+ 5.xx und 6.xx Enumerationen ====----
  84. Private Type ARGB
  85.    Blue As Byte
  86.    Green As Byte
  87.    Red As Byte
  88.    Alpha As Byte
  89. End Type
  90.  
  91. Private Type ColorPalette
  92.    Flags As PaletteFlags
  93.    Count As Long
  94.    Entries As ARGB
  95. End Type
  96.  
  97. Public Enum EncoderValueConstants
  98.    EncoderValueColorTypeCMYK = 0
  99.    EncoderValueColorTypeYCCK = 1
  100.    EncoderValueCompressionLZW = 2
  101.    EncoderValueCompressionCCITT3 = 3
  102.    EncoderValueCompressionCCITT4 = 4
  103.    EncoderValueCompressionRle = 5
  104.    EncoderValueCompressionNone = 6
  105.    EncoderValueScanMethodInterlaced = 7
  106.    EncoderValueScanMethodNonInterlaced = 8
  107.    EncoderValueVersionGif87 = 9
  108.    EncoderValueVersionGif89 = 10
  109.    EncoderValueRenderProgressive = 11
  110.    EncoderValueRenderNonProgressive = 12
  111.    EncoderValueTransformRotate90 = 13
  112.    EncoderValueTransformRotate180 = 14
  113.    EncoderValueTransformRotate270 = 15
  114.    EncoderValueTransformFlipHorizontal = 16
  115.    EncoderValueTransformFlipVertical = 17
  116.    EncoderValueMultiFrame = 18
  117.    EncoderValueLastFrame = 19
  118.    EncoderValueFlush = 20
  119.    EncoderValueFrameDimensionTime = 21
  120.    EncoderValueFrameDimensionResolution = 22
  121.    EncoderValueFrameDimensionPage = 23
  122. End Enum
  123.  
  124. Private Enum PaletteFlags
  125.    PaletteFlagsHasAlpha = &H1
  126.    PaletteFlagsGrayScale = &H2
  127.    PaletteFlagsHalftone = &H4
  128. End Enum
  129.  
  130. Private Enum PixelFormats
  131.    PixelFormatUndefined = &H0&
  132.    PixelFormatDontCare = PixelFormatUndefined
  133.    PixelFormatMax = &HF&
  134.    PixelFormat1_8 = &H100&
  135.    PixelFormat4_8 = &H400&
  136.    PixelFormat8_8 = &H800&
  137.    PixelFormat16_8 = &H1000&
  138.    PixelFormat24_8 = &H1800&
  139.    PixelFormat32_8 = &H2000&
  140.    PixelFormat48_8 = &H3000&
  141.    PixelFormat64_8 = &H4000&
  142.    PixelFormat16bppRGB555 = &H21005
  143.    PixelFormat16bppRGB565 = &H21006
  144.    PixelFormat16bppGrayScale = &H101004
  145.    PixelFormat16bppARGB1555 = &H61007
  146.    PixelFormat24bppRGB = &H21808
  147.    PixelFormat32bppRGB = &H22009
  148.    PixelFormat32bppARGB = &H26200A
  149.    PixelFormat32bppPARGB = &HD200B
  150.    PixelFormat48bppRGB = &H10300C
  151.    PixelFormat64bppARGB = &H34400D
  152.    PixelFormat64bppPARGB = &H1C400E
  153.    PixelFormatGDI = &H20000
  154.    PixelFormat1bppIndexed = &H30101
  155.    PixelFormat4bppIndexed = &H30402
  156.    PixelFormat8bppIndexed = &H30803
  157.    PixelFormatAlpha = &H40000
  158.    PixelFormatIndexed = &H10000
  159.    PixelFormatPAlpha = &H80000
  160.    PixelFormatExtended = &H100000
  161.    PixelFormatCanonical = &H200000
  162. End Enum
  163.  
  164. ' ----==== Sonstige Enumerationen ====----
  165. 'Public Enum TifCompressionType
  166. '    ' EncoderValueConstants.EncoderValueCompressionLZW
  167. '    TiffCompressionLZW = 2
  168. '    'EncoderValueConstants.EncoderValueCompressionCCITT3
  169. '    TiffCompressionCCITT3 = 3
  170. '    'EncoderValueConstants.EncoderValueCompressionCCITT4
  171. '    TiffCompressionCCITT4 = 4
  172. '    'EncoderValueConstants.EncoderValueCompressionRle
  173. '    TiffCompressionRle = 5
  174. '    'EncoderValueConstants.EncoderValueCompressionNone
  175. '    TiffCompressionNone = 6
  176. 'End Enum
  177. ' ----==== GDIPlus Enums ====----
  178. Public Enum Status 'GDI+ Status
  179.    OK = 0
  180.    GenericError = 1
  181.    InvalidParameter = 2
  182.    OutOfMemory = 3
  183.    ObjectBusy = 4
  184.    InsufficientBuffer = 5
  185.    NotImplemented = 6
  186.    Win32Error = 7
  187.    WrongState = 8
  188.    Aborted = 9
  189.    FileNotFound = 10
  190.    ValueOverflow = 11
  191.    AccessDenied = 12
  192.    UnknownImageFormat = 13
  193.    FontFamilyNotFound = 14
  194.    FontStyleNotFound = 15
  195.    NotTrueTypeFont = 16
  196.    UnsupportedGdiplusVersion = 17
  197.    GdiplusNotInitialized = 18
  198.    PropertyNotFound = 19
  199.    PropertyNotSupported = 20
  200.    ProfileNotFound = 21
  201. End Enum
  202. ' ----==== GDI+ 6.xx Enumerationen ====----
  203. Private Enum DitherType
  204.    DitherTypeNone = 0
  205.    DitherTypeSolid = 1
  206.    DitherTypeOrdered4x4 = 2
  207.    DitherTypeOrdered8x8 = 3
  208.    DitherTypeOrdered16x16 = 4
  209.    DitherTypeOrdered91x91 = 5
  210.    DitherTypeSpiral4x4 = 6
  211.    DitherTypeSpiral8x8 = 7
  212.    DitherTypeDualSpiral4x4 = 8
  213.    DitherTypeDualSpiral8x8 = 9
  214.    DitherTypeErrorDiffusion = 10
  215. End Enum
  216.  
  217. Private Enum PaletteType
  218.    PaletteTypeCustom = 0
  219.    PaletteTypeOptimal = 1
  220.    PaletteTypeFixedBW = 2
  221.    PaletteTypeFixedHalftone8 = 3
  222.    PaletteTypeFixedHalftone27 = 4
  223.    PaletteTypeFixedHalftone64 = 5
  224.    PaletteTypeFixedHalftone125 = 6
  225.    PaletteTypeFixedHalftone216 = 7
  226.    PaletteTypeFixedHalftone252 = 8
  227.    PaletteTypeFixedHalftone256 = 9
  228. End Enum
  229. ' ----==== GDI+ 5.xx und 6.xx API Deklarationen ====----
  230. Private Declare Function GdipCloneBitmapArea Lib "gdiplus" _
  231.    (ByVal x As Single, ByVal y As Single, ByVal Width As Single, _
  232.    ByVal Height As Single, ByVal format As PixelFormats, _
  233.    ByVal srcBitmap As Long, ByRef dstBitmap As Long) As Status
  234.  
  235. Private Declare Function GdipCreateBitmapFromFile Lib "gdiplus" _
  236.    (ByVal FileName As Long, ByRef BITMAP As Long) As Status
  237.  
  238. Private Declare Function GdipCreateBitmapFromHBITMAP Lib "gdiplus" _
  239.    (ByVal hbm As Long, ByVal hpal As Long, _
  240.    ByRef BITMAP As Long) As Status
  241.  
  242. Private Declare Function GdipCreateHBITMAPFromBitmap Lib "gdiplus" _
  243.    (ByVal BITMAP As Long, ByRef hbmReturn As Long, _
  244.    ByVal background As Long) As Status
  245.  
  246. Private Declare Function GdipDisposeImage Lib "gdiplus" _
  247.    (ByVal image As Long) As Status
  248.  
  249. Private Declare Function GdipGetImageEncoders Lib "gdiplus" _
  250.    (ByVal numEncoders As Long, ByVal Size As Long, _
  251.    ByRef Encoders As Any) As Status
  252.  
  253. Private Declare Function GdipGetImageEncodersSize Lib "gdiplus" _
  254.    (ByRef numEncoders As Long, ByRef Size As Long) As Status
  255.  
  256. Private Declare Function GdipGetImagePixelFormat Lib "gdiplus" _
  257. (ByVal image As Long, ByRef PixelFormat As PixelFormats) As Status
  258.  
  259. Private Declare Function GdipGetImageDimension Lib "gdiplus" _
  260.    (ByVal image As Long, ByRef sngWidth As Single, _
  261.    ByRef sngHeight As Single) As Status
  262.  
  263. Private Declare Function GdiplusShutdown Lib "gdiplus" _
  264.    (ByVal token As Long) As Status
  265.  
  266. Private Declare Function GdiplusStartup Lib "gdiplus" _
  267.    (ByRef token As Long, ByRef lpInput As GDIPlusStartupInput, _
  268.    Optional ByRef lpOutput As Any) As Status
  269.  
  270. Private Declare Function GdipSaveImageToFile Lib "gdiplus" _
  271.    (ByVal image As Long, ByVal FileName As Long, _
  272.    ByRef clsidEncoder As GUID, _
  273.    ByRef encoderParams As Any) As Status
  274.  
  275. ' ----==== GDI+ 6.xx API Deklarationen ====----
  276. Private Declare Function GdipBitmapConvertFormat Lib "gdiplus" _
  277.    (ByVal pInputBitmap As Long, _
  278.    ByVal PixelFormat As PixelFormats, _
  279.    ByVal DitherType As DitherType, _
  280.    ByVal PaletteType As PaletteType, _
  281.    ByVal palette As Any, _
  282.    ByVal alphaThresholdPercent As Single) As Status
  283.  
  284. Private Declare Function GdipInitializePalette Lib "gdiplus" _
  285.    (ByVal palette As Any, _
  286.    ByVal PaletteType As PaletteType, _
  287.    ByVal optimalColors As Long, _
  288.    ByVal useTransparentColor As Long, _
  289.    ByVal BITMAP As Long) As Status
  290.  
  291. ' ----==== OLE API Declarations ====----
  292. Private Declare Function CLSIDFromString Lib "ole32" _
  293.    (ByVal str As Long, id As GUID) As Long
  294.  
  295. Private Declare Sub OleCreatePictureIndirect Lib "oleaut32.dll" _
  296.    (lpPictDesc As PICTDESC, riid As IID, ByVal fOwn As Boolean, _
  297.    lplpvObj As Object)
  298.  
  299. ' ----==== Kernel API Declarations ====----
  300. Private Declare Function lstrlenW Lib "kernel32" _
  301.    (lpString As Any) As Long
  302.  
  303. Private Declare Function lstrcpyW Lib "kernel32" _
  304.    (lpString1 As Any, lpString2 As Any) As Long
  305. Private Declare Function GetModuleHandle Lib "kernel32" _
  306. Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
  307.  
  308. Private Declare Function LoadLibrary Lib "kernel32" _
  309. Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
  310.  
  311. Private Declare Function GetProcAddress Lib "kernel32" _
  312. (ByVal hModule As Long, ByVal lpProcName As String) As Long
  313.  
  314. Private Declare Function FreeLibrary Lib "kernel32" _
  315. (ByVal hLibModule As Long) As Long
  316. ' ----==== Variablen ====----
  317. Private GdipToken As Long
  318. Private GdipInitialized As Boolean
  319. Public UseGDI6 As Boolean
  320.  
  321.  
  322. Public Function StartUpGDIPlus(ByVal GdipVersion As Long) As Status
  323.    ' Initialisieren der GDI+ Instanz
  324.    Dim GdipStartupInput As GDIPlusStartupInput
  325.    GdipStartupInput.GdiPlusVersion = GdipVersion
  326.    StartUpGDIPlus = GdiplusStartup(GdipToken, GdipStartupInput, ByVal 0)
  327. End Function
  328. Public Function ShutdownGDIPlus() As Status
  329.    ' Beendet GDI+ Instanz
  330.    ShutdownGDIPlus = GdiplusShutdown(GdipToken)
  331. End Function
  332. Public Function Execute(ByVal lReturn As Status) As Status
  333.    Dim lCurErr As Status
  334.    If lReturn = Status.OK Then
  335.        lCurErr = Status.OK
  336.    Else
  337.        lCurErr = lReturn
  338.        MsgBox GdiErrorString(lReturn) & " GDI+ Error:" & lReturn, _
  339.               vbOKOnly, "GDI Error"
  340.    End If
  341.    Execute = lCurErr
  342. End Function
  343.  
  344. Private Function GdiErrorString(ByVal lError As Status) As String
  345.    Dim s As String
  346.  
  347. Select Case lError
  348.  
  349. Case GenericError:                  s = "Generic Error."
  350. Case InvalidParameter: s = "Invalid Parameter."
  351. Case OutOfMemory:                   s = "Out Of Memory."
  352. Case ObjectBusy:                    s = "Object Busy."
  353. Case InsufficientBuffer: s = "Insufficient Buffer."
  354. Case NotImplemented:                s = "Not Implemented."
  355. Case Win32Error:                    s = "Win32 Error."
  356. Case WrongState:                    s = "Wrong State."
  357. Case Aborted:                       s = "Aborted."
  358. Case FileNotFound:                  s = "File Not Found."
  359. Case ValueOverflow:                 s = "Value Overflow."
  360. Case AccessDenied:                  s = "Access Denied."
  361. Case UnknownImageFormat: s = "Unknown Image Format."
  362. Case FontFamilyNotFound: s = "FontFamily Not Found."
  363. Case FontStyleNotFound:            s = "FontStyle Not Found."
  364. Case NotTrueTypeFont:   s = "Not TrueType Font."
  365. Case UnsupportedGdiplusVersion: s = "Unsupported Gdiplus Version."
  366. Case GdiplusNotInitialized:     s = "Gdiplus Not Initialized."
  367. Case PropertyNotFound: s = "Property Not Found."
  368. Case PropertyNotSupported:      s = "Property Not Supported."
  369. Case Else:                             s = "Unknown GDI+ Error."
  370.  
  371. End Select
  372.  
  373.    GdiErrorString = s
  374. End Function
  375. Public Function LoadPicturePlus(ByVal FileName As String) As StdPicture
  376.    Dim retStatus As Status
  377.    Dim lBitmap As Long
  378.    Dim hBitmap As Long
  379.  
  380.    ' Öffnet die Bilddatei in lBitmap
  381. retStatus = Execute(GdipCreateBitmapFromFile(StrPtr(FileName), lBitmap))
  382.  
  383. If retStatus = OK Then
  384.  
  385. ' Erzeugen einer GDI Bitmap lBitmap -> hBitmap
  386. retStatus = Execute(GdipCreateHBITMAPFromBitmap(lBitmap, hBitmap, 0))
  387.  
  388. If retStatus = OK Then
  389.               ' Erzeugen des StdPicture Objekts von hBitmap
  390. Set LoadPicturePlus = HandleToPicture(hBitmap, vbPicTypeBitmap)
  391. End If
  392.  
  393. ' Lösche lBitmap
  394. Call Execute(GdipDisposeImage(lBitmap))
  395.  
  396.    End If
  397. End Function
  398. Private Function HandleToPicture(ByVal hGDIHandle As Long, _
  399.    ByVal ObjectType As PictureTypeConstants, _
  400.    Optional ByVal hpal As Long = 0) As StdPicture
  401.  
  402.    Dim tPictDesc As PICTDESC
  403.    Dim IID_IPicture As IID
  404.    Dim oPicture As IPicture
  405.  
  406.    ' Initialisiert die PICTDESC Structur
  407.    With tPictDesc
  408.        .cbSizeOfStruct = Len(tPictDesc)
  409.        .picType = ObjectType
  410.        .hgdiObj = hGDIHandle
  411.        .hPalOrXYExt = hpal
  412.    End With
  413.  
  414.    ' Initialisiert das IPicture Interface ID
  415.    With IID_IPicture
  416.        .Data1 = &H7BF80981
  417.        .Data2 = &HBF32
  418.        .Data3 = &H101A
  419.        .Data4(0) = &H8B
  420.        .Data4(1) = &HBB
  421.        .Data4(3) = &HAA
  422.        .Data4(5) = &H30
  423.        .Data4(6) = &HC
  424.        .Data4(7) = &HAB
  425.    End With
  426.  
  427.    ' Erzeugen des Objekts
  428.    OleCreatePictureIndirect tPictDesc, IID_IPicture, True, oPicture
  429.  
  430.    ' Rückgabe des Pictureobjekts
  431.    Set HandleToPicture = oPicture
  432.  
  433. End Function
  434. Private Function GetEncoderClsid(mimeType As String, pClsid As GUID) _
  435.    As Boolean
  436.  
  437.    Dim num As Long
  438.    Dim Size As Long
  439.    Dim pImageCodecInfo() As ImageCodecInfo
  440.    Dim j As Long
  441.    Dim buffer As String
  442.  
  443.    Call GdipGetImageEncodersSize(num, Size)
  444.    If (Size = 0) Then
  445.        GetEncoderClsid = False  '// fehlgeschlagen
  446.        Exit Function
  447.    End If
  448.  
  449.    ReDim pImageCodecInfo(0 To Size \ Len(pImageCodecInfo(0)) - 1)
  450.    Call GdipGetImageEncoders(num, Size, pImageCodecInfo(0))
  451.  
  452.    For j = 0 To num - 1
  453.        buffer = Space$(lstrlenW(ByVal pImageCodecInfo(j).MimeTypePtr))
  454.  
  455.        Call lstrcpyW(ByVal StrPtr(buffer), ByVal _
  456.               pImageCodecInfo(j).MimeTypePtr)
  457.  
  458.        If (StrComp(buffer, mimeType, vbTextCompare) = 0) Then
  459.               pClsid = pImageCodecInfo(j).Clsid
  460.               Erase pImageCodecInfo
  461.               GetEncoderClsid = True  '// erfolgreich
  462.               Exit Function
  463.        End If
  464.    Next j
  465.  
  466.    Erase pImageCodecInfo
  467.    GetEncoderClsid = False  '// fehlgeschlagen
  468. End Function
  469. Public Function UseGDI_v_6xx() As Boolean
  470.  
  471.    Dim hMod As Long
  472.    Dim Loaded As Boolean
  473.    Dim sFunction As String
  474.    Dim sModule As String
  475.  
  476.    ' GDIPLUS.DLL
  477.    sModule = "GDIPLUS"
  478.  
  479.    ' eine Funktion die erst ab der
  480.    ' GDI+ 6.xx vorhanden ist
  481.    sFunction = "GdipDrawImageFX"
  482.  
  483.    'Handle der DLL erhalten
  484.    hMod = GetModuleHandle(sModule)
  485.  
  486.    ' Falls DLL nicht registriert ...
  487.    If hMod = 0 Then
  488.        ' DLL in den Speicher laden.
  489.        hMod = LoadLibrary(sModule)
  490.        If hMod Then Loaded = True
  491.    End If
  492.  
  493.    If hMod Then
  494.        If GetProcAddress(hMod, sFunction) Then UseGDI_v_6xx = True
  495.    End If
  496.  
  497.    If Loaded Then Call FreeLibrary(hMod)
  498.  
  499. End Function
  500. Public Function SavePictureAsJPG(ByVal Pic As StdPicture, _
  501.    ByVal FileName As String, Optional ByVal Quality As Long = 85) _
  502.    As Boolean
  503.  
  504.    Dim retStatus As Status
  505.    Dim retval As Boolean
  506.    Dim lBitmap As Long
  507.  
  508.    ' Erzeugt eine GDI+ Bitmap vom StdPicture Handle -> lBitmap
  509.    retStatus = Execute(GdipCreateBitmapFromHBITMAP(Pic.Handle, 0, _
  510.        lBitmap))
  511.  
  512.    If retStatus = OK Then
  513.  
  514.        Dim PicEncoder As GUID
  515.        Dim tParams As EncoderParameters
  516.  
  517.        '// Ermitteln der CLSID vom mimeType Encoder
  518.        retval = GetEncoderClsid(mimeJPG, PicEncoder)
  519.        If retval = True Then
  520.  
  521.               If Quality > 100 Then Quality = 100
  522.               If Quality < 0 Then Quality = 0
  523.  
  524.               ' Initialisieren der Encoderparameter
  525.               tParams.Count = 1
  526.               With tParams.Parameter(0) ' Quality
  527.                   ' Setzen der Quality GUID
  528.                   CLSIDFromString StrPtr(EncoderQuality), .GUID
  529.                   .NumberOfValues = 1
  530.                   .type = EncoderParameterValueTypeLong
  531.                   .Value = VarPtr(Quality)
  532.               End With
  533.  
  534.               ' Speichert lBitmap als JPG
  535.               retStatus = Execute(GdipSaveImageToFile(lBitmap, _
  536.                   StrPtr(FileName), PicEncoder, tParams))
  537.  
  538.               If retStatus = OK Then
  539.                   SavePictureAsJPG = True
  540.               Else
  541.                   SavePictureAsJPG = False
  542.               End If
  543.        Else
  544.               SavePictureAsJPG = False
  545.               MsgBox "Konnte keinen passenden Encoder ermitteln.", _
  546.               vbOKOnly, "Encoder Error"
  547.        End If
  548.  
  549.        ' Lösche lBitmap
  550.        Call Execute(GdipDisposeImage(lBitmap))
  551.  
  552.    End If
  553. End Function
  554.  

En el load inicias dos variables: cx y cy (coordenadas)
Código:
Private Sub Form_Load()
    cx = 0
    cy = 0
End Sub

Luego en el form pones un Picture llamado "PIC1" y un command llamado "CmdCapture_PART", en el boton va esto:
Código
  1.    Dim retStatus As Status
  2.    retStatus = Execute(StartUpGDIPlus(GdiPlusVersion))
  3.  
  4.  
  5.    Me.AutoRedraw = True
  6.    Me.ScaleMode = 1
  7.    aimg = GetDesktopWindow()
  8.    simg = GetDC(aimg)
  9.  
  10.    BitBlt Pic1.hDC, 0, 0, Pic1.Width, Pic1.Height, simg, cx, cy, vbSrcCopy
  11.    SavePictureAsJPG Pic1.image, "c:\parte.jpg", 10
  12.  
  13.  
  14.    retStatus = Execute(ShutdownGDIPlus)
  15.  

Lo que hace es guardar una parte de la pantalla en un archivo JPG a un grado de compresion elegido por ti que puede ser de 1 a 100, el ejempplo esta con 10 de compresion.

La parte capturada viene dada por la linea
Código:
BitBlt Pic1.hDC, 0, 0, Pic1.Width, Pic1.Height, simg, cx, cy, vbSrcCopy

Te va a tocar hacer pruebas para entenderlo por completo, lo saque del servidor de mi troyanin asi que pueda que falte algo.

Un saludo.



En línea

Karcrack


Desconectado Desconectado

Mensajes: 2.419


Se siente observado ¬¬'


Ver Perfil
Re: Copiar pantalla segun coordenadas
« Respuesta #2 en: 8 Febrero 2009, 18:43 pm »

Buen code, lastima que no seas Aleman :rolleyes:

Saludos ;)
En línea

seba123neo
Moderador
***
Desconectado Desconectado

Mensajes: 3.621


"No quiero creer, quiero saber" - Carl Sagan


Ver Perfil WWW
Re: Copiar pantalla segun coordenadas
« Respuesta #3 en: 8 Febrero 2009, 22:23 pm »

Hola, proba:

Código
  1. Private Declare Function GetDesktopWindow Lib "user32" () As Long
  2. Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
  3. 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
  4.  
  5. Private Sub Command1_Click()
  6.    Dim DesktopDC As Long
  7.    DesktopDC = GetWindowDC(GetDesktopWindow())
  8.    BitBlt Me.hDC, 0, 0, 100, 100, DesktopDC, 10, 10, vbSrcCopy
  9. End Sub

ahi le digo que capture una longitud de 100 pixeles en tanto en X como en Y y le digo que empieze desde el pixel 10 en X/Y

saludos.
En línea

La característica extraordinaria de las leyes de la física es que se aplican en todos lados, sea que tú elijas o no creer en ellas. Lo bueno de las ciencias es que siempre tienen la verdad, quieras creerla o no.

Neil deGrasse Tyson
Páginas: [1] Ir Arriba Respuesta Imprimir 

Ir a:  

WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines