Projet numéro 744:
pilotage de camera en VBA
(consulté 5032 fois)

Vous avez un projet similaire et cherchez le prestataire idéal pour le réaliser à un prix défiant toute concurrence ? Inscrivez-vous en 1 minute et déposez votre projet sur notre site, pour recevoir des devis.
Fri, 08 Feb 2013 16:40:47

Initiateur du projet : frankytactik
Titre du projet : pilotage de camera en VBA
Présentation du projet :

 Bonjour,

Je dois piloter la camera extérieure de ma tablette Dell latitude ST sous windows 7 et office 2010.

Le driver installé est integrated webcam 6.1.7601.17514

 J'ai besoin de voir en permanance la prévisualisation à l'écran et lorsque j'appuie sur un bouton je dois recopier l'image capturée dans l'onglet 'work' d'un fichier excel.

Je parvient prévisualiser et à copier l'image une fois. A la deuxième manipulation, je perds le contact du driver et il m'apparaît une fenêtre verte au lieu de l'image derrière la caméra.

 J'ai essayé de créer un deuxième bouton n'exécutant que le code suivant:

SendMessage hWnd, WM_CAP_GRAB_FRAME_NOSTOP, 0, 0
SendMessage hWnd, WM_CAP_EDIT_COPY, 640, 480
 

pour ne pas avoir à recréer une fenêtre de prévisualisation chaque fois. Chaque fois que j'Appuie sur le bonton la prévisualisation continue de rouler mais l'image copiée est toujours la première.

Précision: j'effectue mes tests avec l'application de webcam Dell ouvert en mode IM pour pouvoir me déconnecter et me reconnecter au driver.

voici mon code:

Option Explicit

Const WM_CAP As Long = &H400
Const WM_CAP_DRIVER_CONNECT As Long = WM_CAP + 10
Const WM_CAP_DRIVER_DISCONNECT As Long = WM_CAP + 11
Const WM_CAP_SAVEDIB = WM_CAP + 25
Const WM_CAP_EDIT_COPY As Long = WM_CAP + 30
Const WM_CAP_SET_PREVIEW As Long = WM_CAP + 50
Const WM_CAP_DLG_VIDEOFORMAT = WM_CAP + 41
Const WM_CAP_DLG_VIDEOSOURCE = WM_CAP + 42
Const WM_CAP_DLG_VIDEODISPLAY = WM_CAP + 43
Const WM_CAP_GET_VIDEOFORMAT = WM_CAP + 44
Const WM_CAP_SET_VIDEOFORMAT = WM_CAP + 45
Const WM_CAP_DLG_VIDEOCOMPRESSION = WM_CAP + 46
Const WM_CAP_SET_PREVIEWRATE = WM_CAP + 52
Const WM_CAP_SET_SCALE = WM_CAP + 53
Const WM_CAP_GRAB_FRAME = WM_CAP + 60
Const WM_CAP_GRAB_FRAME_NOSTOP = WM_CAP + 61
Const WM_CAP_STOP = WM_CAP + 68

Const WM_CLOSE = &H10
Const WM_DESTROY = &H2
Const WM_NCDESTROY = &H82
Const WM_QUIT = &H12

Const WS_CHILD As Long = &H40000000
Const WS_VISIBLE As Long = &H10000000
Const WS_POPUP As Long = &H80000000
Const HWND_BOTTOM As Long = 1
Const SWP_NOMOVE As Long = &H2
Public hWnd As Long

Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Declare Function DestroyWindow Lib "user32" (ByVal hndw As Long) As Boolean
Declare Function GetDesktopWindow Lib "user32" () As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
   (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
 
Declare Function capCreateCaptureWindowA Lib "avicap32.dll" _
  (ByVal lpszWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, _
  ByVal nHeight As Long, ByVal hWndParent As Long, ByVal nID As Long) As Long

Declare Function capGetDriverDescriptionA Lib "avicap32.dll" _
  (ByVal wDriver As Long, ByVal lpszName As String, _
  ByVal cbName As Long, ByVal lpszVer As String, ByVal cbVer As Long) As Boolean

 
Sub WebCamClip()

  hWnd = 0
 
   If hWnd = 0 Then
  hWnd = capCreateCaptureWindowA("enwèye dont", WS_VISIBLE, 0, 0, 200, 200, GetDesktopWindow(), 0)
  SendMessage hWnd, WM_CAP_DRIVER_CONNECT, 0, 0
  SendMessage hWnd, WM_CAP_SET_PREVIEWRATE, 30, 0
  SendMessage hWnd, WM_CAP_SET_SCALE, 1, 0
  SendMessage hWnd, WM_CAP_SET_PREVIEW, 1, 0
  SendMessage hWnd, WM_CAP_GRAB_FRAME_NOSTOP, 0, 0
  SendMessage hWnd, WM_CAP_EDIT_COPY, 640, 480
 
   End If
 
End Sub

Public Sub concentrateur(qual2 As String, row As Integer)
 
 'effectue la capture d'image
  Module1.WebCamClip
 
  Sheets("Work").Activate
  If Sheets("work").ChartObjects.Count = 0 Then
  With Sheets("work").ChartObjects.Add(0, 0, 480, 320).Chart
  .Paste
End With
Sheets("work").ChartObjects(1).Select
 Else
  Sheets("work").ChartObjects(1).Select
   With Sheets("work").ChartObjects(1).Chart
   .Paste
   End With
  End If

End Sub

En attente d'une réponse rapide svp. J'aurais besoin que ce programme soit fonctionnel semaine prochaine,

merci

Commentaire de l' administrateur :

• Le client est: le chargé de projet
• Le client affirme souhaiter concrétiser son projet: asap ++
• Objectif du projet: pilotage de camera en VBA
• Details du projet:
• Technologie utilisée ou conseillée: laissé à la latitude du prestataire
• Logiciel utilisé ou conseillé: laissé à la latitude du prestataire
• Estimation du budget par jour appliqué: 400 €
• Type de mission: régie, Télétravail
• Estimation du délai de réalisation: 1 jour

Les sujets suivants peuvent également vous intéresser

Les sujets suivants peuvent également vous intéresser, sur notre plateforme partenaire ProgOnline