vabeh dato che ho avuto MILLE risposte ho cercato e ho trovato, se a qualcuno serve qui c'e' il codice (pezzi):
codice:Public Sub DoCapture() Dim xPos As Long 'actual X-position Dim yPos As Long 'actual Y-position Dim Ret As Long 'returnvalue from API's Dim DeskHwnd As Long 'windowhanlde Dim DeskHdc As Long 'handle of devicecontext Dim DeskRect As RECT 'rect's of the desktop Dim dibHdc As Long 'i tested something Dim ByteArray() As Byte Dim sValue As String Const CRATE = 5 'accuracy Dim CS(CRATE * CRATE * CRATE) As Long 'if store all 'checksums of the last picture there 'so i know if the picture is different 'from the last and if i have to send it 'a second time or not Dim CS_Tmp As Long 'checksum(bad translation) Dim K As Long 'actual part of the desktop '### get desktophandle DeskHwnd = GetDesktopWindow() '### get devicecontext DeskHdc = GetDC(DeskHwnd) '### get windowrect's Ret = GetWindowRect(DeskHwnd, DeskRect) '### create 16 clolored DIB DIB.Colors = 16 RecDib.Colors = 16 Call DIB.Create(DeskRect.Right / CRATE, DeskRect.Bottom / CRATE) Call RecDib.Create(DeskRect.Right / CRATE, DeskRect.Bottom / CRATE) '### when ENDE is true then capturing shall end ENDE = False '### begin with first part of the desktop K = 0 '### set reponse to FALSE modCapture.C_Response = False modCapture.C_Set_Response = False Do Until ENDE For yPos = 0 To DeskRect.Bottom Step (DeskRect.Bottom / CRATE) For xPos = 0 To DeskRect.Right Step (DeskRect.Right / CRATE) '### blit actual part of the desktop into the dib Ret = BitBlt(DIB.hdc, 0, 0, DeskRect.Right /_ CRATE, DeskRect.Bottom / CRATE, DeskHdc, xPos, yPos, SRCCOPY) '### store the dib in an array Call DIB.ToByte(ByteArray) '### compress the array Call ZLib.CompressByte(ByteArray) '### save the checksum CS_Tmp = UBound(ByteArray) '### if the part is different to the last-> send the data If CS_Tmp <> CS(K) Then CS(K) = CS_Tmp On Error GoTo NoConn '### first send the actual position frmCapture.TCP_Set.SendData CStr(xPos) & ";" & CStr(yPos) '### wait for response Do Until C_Set_Response DoEvents Loop C_Set_Response = False '### send data frmCapture.TCP.SendData ByteArray '### wait for response Do Until C_Response DoEvents Loop C_Response = False On Error GoTo 0 End If '### next part of the desktop... K = K + 1 DoEvents Next xPos Next yPos '### begin at pos (0,0) xPos = 0 yPos = 0 K = 0 '### one frame made Q = Q + 1 Loop Exit Sub
il programma è preso da un sito, nn so se posos mettere il link quindi lo ometto, se serve a qualcuno mi mandi un msg pvt

Rispondi quotando