Contrôle activex screenshoots

Télécharger le projet
Commenter

Description

Contrôle ActiveX ScreenShoot pour effectuer des capture d'écran ou de zone d'écran fonctionnant comme la méthode PaintPicture pour faire, par exemple, des fenêtres transparentes (fenêtre rondes, fenêtres image) et pour ne plus se prendre la tête avec des API le tout avec une seule méthode.

Toutes les explications sont dans le fichier "Aide.txt" du ZIP

Merci à Int19h pour la base.

Source / Exemple : 


'????????????????????????????????????????????????????????????????
'????????????????????????????????????????????????????????????????
'???????????????  Contrôle ActiveX ScreenShoots  ?????????????????
'????????????????????????????????????????????????????????????????
'????????????????????????????????????????????????????????????????
'?  Par A-Cube {Apatride, Asocial, Anarchiste}                  ?
'?   Remerciment à "Int19h" de VBFRANCE.COM pour l'utilisation  ?
'?    de ces API en saluant la simplicité et la clareté de son  ?
'?     code et de ses explications.                             ?
'?                                          ( FREEWARE - 2004 ) ?
'????????????????????????????????????????????????????????????????
'????????????????????????????????????????????????????????????????
'????????????????????????????????????????????????????????????????

'Déclarations des API
Private Declare Function GetDC Lib "user32" (ByVal hwnd 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 UserControl_Resize()
 'Empêche le redimensionnement du control
 ' en adaptant sa taille à celle de l'image de fond.
 ' Image de fond = 30 x 18  pixels converti en Twips
 UserControl.Width = 30 * 15
 UserControl.Height = 18 * 15
End Sub
'????????????????????????????????????????????????????????????????
Public Sub AffiAproposDe()
 'Affiche la fenêtre "A propos de..."
 frmAPD.Show vbModal
 Unload frmAPD
 Set frmAPD = Nothing
End Sub
'????????????????????????????????????????????????????????????????
'????????????????????????  MÉTHODE  ?????????????????????????????
'????????????????????????????????????????????????????????????????
Public Function ShootScreen(Optional ByVal ScreenX As Integer, Optional ByVal ScreenY As Integer, Optional ByVal ScreenW As Integer, Optional ByVal ScreenH As Integer, Optional ByVal PictureW As Integer, Optional ByVal PictureH As Integer) As Object
 '??? Test les arguments passés à la Méthode. ???
 'S'ils sont abscent ils prennent les valeurs par défaut
 'S'ils sont hors limite, ils prennent les valeurs par défaut corrigées
  'Screen X et Y => 0 {Coin haut gauche de l'écran}
   If IsMissing(ScreenX) = True Or ScreenX < 0 Or ScreenX > (ScreenWidth - 1) Then ScreenX = 0
   If IsMissing(ScreenY) = True Or ScreenY < 0 Or ScreenY > (ScreenHeight - 1) Then ScreenY = 0
  'Screen Width et Height => Taille de l'objet Screen (l'écran) en pixels
   If IsMissing(ScreenW) = True Then ScreenW = ScreenWidth  'en pixels
   If IsMissing(ScreenH) = True Then ScreenH = ScreenHeight 'en pixels
   'Hors Limite
   If ScreenW < 1 Or ScreenW > (ScreenWidth - ScreenX) Then ScreenW = ScreenWidth - ScreenX
   If ScreenH < 1 Or ScreenH > (ScreenHeight - ScreenY) Then ScreenH = ScreenHeight - ScreenY
  'Picture Width et Height => Taille de l'objet Screen (l'écran) en pixels
   If IsMissing(PictureW) = True Or PictureW < 1 Or PictureW > 32767 Then PictureW = ScreenW
   If IsMissing(PictureH) = True Or PictureH < 1 Or PictureH > 32767 Then PictureH = ScreenH
 
 'Redimensionne le PictureBox à la taille voulue.
 ' Car la propriété Image des PictureBox renvoie ce qui est visible...
 picBox.Width = PictureW
 picBox.Height = PictureH
 
 'Copie l'écran dans la PictureBox :
 'Fonctionne quasiment comme la méthode PaintPicture des PictureBox
 ' mais les arguments ne sont pas facultatifs.
 'NOTE :  GetDC(0) récupère le hDC de l'écran qui est la
 '         référence numérique dynamique de l'image de l'ecran
 StretchBlt picBox.hdc, 0, 0, PictureW, PictureH, GetDC(0), ScreenX, ScreenY, ScreenW, ScreenH, vbSrcCopy
 
 Set GetScreenShoot = picBox.Image
End Function

'????????????????????????????????????????????????????????????????
'??????????????????????  LES PROPRIÉTÉS  ????????????????????????
'????????????????????????????????????????????????????????????????
'En "Lecture Seule" car il n'y a pas de "PropertyLet" ou de "Property Set".
'????????????????????????????????????????????????????????????????
' PICTURE
'????????????????????????????????????????????????????????????????
Property Get PictureImage() As Object
 Set PictureImage = picBox.Image
End Property
'????????????????????????????????????????????????????????????????
Property Get PictureWidth() As Integer
 PictureWidth = picBox.Width
End Property
'????????????????????????????????????????????????????????????????
Property Get PictureHeight() As Integer
 PictureHeight = picBox.Height
End Property

'????????????????????????????????????????????????????????????????
' SCREEN
'????????????????????????????????????????????????????????????????
Property Get ScreenWidth() As Integer
 ScreenWidth = Screen.Width \ Screen.TwipsPerPixelX
End Property
'????????????????????????????????????????????????????????????????
Property Get ScreenHeight() As Integer
 ScreenHeight = Screen.Height \ Screen.TwipsPerPixelY
End Property

'????????????????????????????????????????????????????????????????
'????????????????????????????????????????????????????????????????
'????????????????????????????????????????????????????????????????
'????????????????????????????????????????????????????????????????
'????????????????????????????????????????????????????????????????
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (ScSami)