Newsgroup: it.comp.lang.visual-basic
Titolo: catturare l'immagine nello schermo

vorre sapere se è possibile catturare con qualche api un immagine dallo
schermo passandogli le coordinate della regione.
grazie
-- 
---
cabov***

 grazie
Io ho tutto l'occorrente, ma non lo posso scrivere qui, dammi l'email e te 
lo spedisco.
scrivi a:
peppe26 chiocciola tele2 prunto it 

Peppe12 ha scritto:

Se non ti dispiace mi accodo anch'io alla richiesta!
Intanto ti mando una email, e ti ringrazio anticipatamente!
-- 
___________________________________________
Salutoni a tutti
Matteo .alias. Casamatta

 Intanto ti mando una email, e ti ringrazio anticipatamente!
<MODE SERIO ON>
Io lo manderei a quel paese, invece.
</MODE SERIO ON>
Il codice per catturare lo schermo e` talmente corto
che si puo` tranquillamente copincollare in un post
e farne beneficiare tutti invece di farsi particolarmente
belli con due o tre o, peggio, usare malamente
degli indirizzi di posta validi.
-- 
ciao, hal

 ha scritto nel messaggio 
news:wtR9e.1121$ms1...@tornado.fastwebnet.it...

Non ho capito nè il farsi bello nè l'indirizzo malamnte usato.
Dato che ho ricevuto già 3 richieste lo posto qui.
Il codice non è corto comunque lo posto qui sotto per tutti
'==========================================0
'module1.bas
Attribute VB_Name = "Module1"
'Attribute VB_Name = "modCaptureBMP"
Option Explicit
'declares to disable PC
Public Const SPI_SCREENSAVERRUNNING = 97
Declare Function SystemParametersInfo Lib "user32" Alias 
"SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByVal 
lpvParam As Boolean, ByVal fuWinIni As Long) As Long
'global variable for capture setting
Global Setting As Integer
Private Type PALETTEENTRY
   peRed As Byte
   peGreen As Byte
   peBlue As Byte
   peFlags As Byte
End Type
Private Type LOGPALETTE
   palVersion As Integer
   palNumEntries As Integer
   palPalEntry(255) As PALETTEENTRY  ' Enough for 256 colors
End Type
Private Type GUID
   Data1 As Long
   Data2 As Integer
   Data3 As Integer
   Data4(7) As Byte
End Type
   Private Const RASTERCAPS As Long = 38
   Private Const RC_PALETTE As Long = &H100
   Private Const SIZEPALETTE As Long = 104
   Private Type RECT
      Left As Long
      Top As Long
      Right As Long
      Bottom As Long
   End Type
   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 GetDeviceCaps Lib "GDI32" (ByVal hDC As Long, _
      ByVal iCapabilitiy As Long) As Long
   Private Declare Function GetSystemPaletteEntries Lib "GDI32" ( _
      ByVal hDC As Long, ByVal wStartIndex As Long, _
      ByVal wNumEntries As Long, lpPaletteEntries As PALETTEENTRY) As Long
   Private Declare Function CreatePalette Lib "GDI32" ( _
      lpLogPalette As LOGPALETTE) 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 hDCSrc 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 GetForegroundWindow Lib "user32" () As Long
   Private Declare Function SelectPalette Lib "GDI32" (ByVal hDC As Long, _
      ByVal hPalette As Long, ByVal bForceBackground As Long) As Long
   Private Declare Function RealizePalette Lib "GDI32" ( _
      ByVal hDC 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 GetWindowRect Lib "user32" ( _
      ByVal hWnd As Long, lpRect As RECT) As Long
   Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, _
      ByVal hDC As Long) As Long
   Private Declare Function GetDesktopWindow Lib "user32" () As Long
   Private Type PicBmp
      Size As Long
      Type As Long
      hBmp As Long
      hPal As Long
      Reserved As Long
   End Type
   Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" ( _
      PicDesc As PicBmp, RefIID As GUID, _
      ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
'form1.frm
Begin VB.Form Form1
   ClientHeight    =   780
   ClientLeft      =   60
   ClientTop       =   60
   ClientWidth     =   3285
   ClipControls    =   0   'False
   ControlBox      =   0   'False
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   780
   ScaleWidth      =   3285
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton Command1
      Caption         =   "Specchio"
      Height          =   330
      Index           =   2
      Left            =   2205
      TabIndex        =   6
      Top             =   405
      Width           =   1005
   End
   Begin VB.CommandButton Command1
      Caption         =   "Cattura"
      Height          =   330
      Index           =   1
      Left            =   45
      TabIndex        =   3
      Top             =   405
      Width           =   1005
   End
   Begin VB.PictureBox Picture2
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      Height          =   1815
      Left            =   -45
      ScaleHeight     =   1755
      ScaleWidth      =   2970
      TabIndex        =   2
      Top             =   1035
      Width           =   3030
      Begin VB.Label Label1
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "Schermo catturato"
         BeginProperty Font
            Name            =   "MS Sans Serif"
            Size            =   13.5
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   360
         Left            =   1035
         TabIndex        =   4
         Top             =   855
         Width           =   2550
      End
   End
   Begin VB.PictureBox Picture1
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      Height          =   2400
      Left            =   45
      ScaleHeight     =   2340
      ScaleWidth      =   4005
      TabIndex        =   0
      Top             =   945
      Width           =   4065
   End
   Begin VB.CommandButton Command1
      Caption         =   "Capovolgi"
      Height          =   330
      Index           =   0
      Left            =   1125
      TabIndex        =   1
      Top             =   405
      Width           =   1005
   End
   Begin VB.Label Label2
      AutoSize        =   -1  'True
      Caption         =   "Capovolge o cattura lo schermo"
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   195
      Left            =   270
      TabIndex        =   5
      Top             =   90
      Width           =   2715
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public Sub Command1_Click(index As Integer)
  Form1.Hide
  Command1(0).Visible = False
  Command1(1).Visible = False
  Form1.Top = -Form1.Height
  Form1.Refresh
  tame! = Timer + 0.2
  While tame > Timer
  Wend
  Picture1.Picture = CaptureScreen()
  Form1.Top = 0
  Picture1.Visible = False
  la = Picture1.Width
  ha = Picture1.Height
  Picture2.Width = la
  Picture2.Height = ha
  If index = 0 Then
    Picture2.PaintPicture Picture1.Picture, 0, ha, la, -ha
    Label1.Caption = "Schermo capovolto"
  ElseIf index = 1 Then
    Picture2.PaintPicture Picture1.Picture, 0, 0
    Label1.Caption = "Schermo catturato"
  Else
    Picture2.PaintPicture Picture1.Picture, la, 0, -la, ha
    Label1.Caption = "Schermo a specchio"
  End If
  Picture2.Top = 0
  Picture1.Left = 0
  Form1.Show
  Form1.WindowState = 2
  SavePicture Picture2.Image, "screen.jpg"
  Label1.Left = (Form1.Width - Label1.Width) / 2
  Label1.Top = (Form1.Height - Label1.Height) / 2
End Sub
Private Sub Form_Load()
 'Command1_Click
End Sub
Private Sub Picture2_Click()
  End
End Sub
'=============================
Questo è uno scherzetto che ho fatto per il tempo scaduto per mia nipote 
onde non rincoglionirsi ai video giochi.
Ma da questo cavate tutto quello che vi serve.
NON è mio originale l'ho scaricato da non mi ricordo più dove.
Fatemi sapere se va bene per le vs esigenze.
Ciao Peppe
www.naglieri.com

Mi dispiace molto ma postando il codice ho tralasciato tutte le sub del 
modulo bas.
L'avevo detto che non era corto per cui l'ho inviato personalmente zippato 
ai due richiedenti completo di programma di prova e cattura intera o 
parziale
Chi desidera ancora averlo mi invii in privato l'indirizzo.
peppe26  chiocciola  tele2 punto it
Scusate l'errore
Peppe 

 L'avevo detto che non era corto 
Scusa, ma l'OP non voleva semplicemente catturare lo schermo?
Metti questo codice in un form e prova: ti ridimensiona pure
l'immagine ;-)
<codice>
Option Explicit
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 StretchBlt Lib "gdi32" (ByVal hdc 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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) 
As Long
Private Sub Form_Paint()
     Dim mi_hDC As Long
     Dim mi_oldScaleMode As ScaleModeConstants
     Dim w As Long, h As Long
     mi_hDC = GetDC(0)
     If (mi_hDC) Then
         mi_oldScaleMode = Me.ScaleMode
         Me.ScaleMode = vbPixels
         w = Screen.Width / Screen.TwipsPerPixelX
         h = Screen.Height / Screen.TwipsPerPixelY
         Call StretchBlt(Me.hdc, Me.ScaleLeft, Me.ScaleTop, 
Me.ScaleWidth, Me.ScaleHeight, _
                         mi_hDC, 0, 0, w, h, vbSrcCopy)
         Call ReleaseDC(0, mi_hDC)
         Me.ScaleMode = mi_oldScaleMode
     End If
End Sub
Private Sub Form_Resize()
     Me.Refresh
End Sub
</codice>
-- 
ciao, hal