1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64
| Option Explicit
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
'pour obtenir l'image de l'écran
Private Declare Function GetDesktopWindow Lib "user32.dll" () As Long
'pour obtenir les coordonnées d'une fenetr ou d'un objet ayant la propriété HwnD
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
'pour obtenir le contexte de dispositif d'affichage (C.C)
Private Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long
'pour dessiner l'image capturée dans un picture
Private Declare Function BitBlt Lib "gdi32.dll" ( _
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
Const SRCCOPY As Long = &HCC0020
Private Sub Form_Load()
'les APIs ont besoins de données en pixels
Me.ScaleMode = vbPixels
Picture1.ScaleMode = vbPixels: Picture1.AutoRedraw = True
Picture2.ScaleMode = vbPixels: Picture2.AutoRedraw = True
Command1.Move 14, 6, 99, 21
Command1.Caption = "Visible/no Visible"
Command2.Move 150, 6, 99, 21
Command2.Caption = "GO"
Picture1.Move 6, 34
Shape1.BorderWidth = 3: Shape1.Shape = 3 'circle
Shape1.Move 2, 2, 40, 40
End Sub
Private Sub Command1_Click()
'bascule
Shape1.Visible = Not Shape1.Visible
End Sub
Private Sub Command2_Click()
Dim LaSource As RECT
'placement et dimensionnement de la picture ou serat dessiné l'image
Picture2.Move Picture1.Left + Picture1.Width + Picture1.Left, _
Picture1.Top, Picture1.Width, Picture1.Height
'Obtient les coordonnées de l'image devant être copier (depuis l'écran)
GetWindowRect Picture1.hwnd, LaSource
'Capture l'image de Picture1 et la dessinne dans le Picture2
'le + 2 pour ajouter la bordure 3D du PictureBox
'LaSource.Left étant pris depuis le bord de l'écran, non pas de la Form
'idem pour LaSource.Top
BitBlt Picture2.hDC, 0&, 0&, Picture1.ScaleWidth, Picture1.ScaleHeight, _
GetDC(GetDesktopWindow()), LaSource.Left + 2, LaSource.Top + 2, SRCCOPY
DoEvents
Picture2.Refresh
'Maintenant il suffit de sauvegarde avec SavePicture
SavePicture Picture2.Image, App.Path & "\Limage.BMP"
'Ou le mettre dans le ClipBoard (presse papier Window"
Clipboard.Clear
Clipboard.SetData Picture2.Image, vbCFDIB
End Sub |
Partager