'***************************************************************************************
' WebCam Preview and Button for capture in Userform *
'Version : 4.0 *
'Date version : 29/07/2018 *
'Autor: patricktoulon alias chamalin2@hotmail.fr sur excel-download et developpez.com *
'***************************************************************************************
Option Explicit
Private Const WM_CAP As Long = &H400 'valeur base =1024 --> hex=&H400
Private Const WM_CAP_DRIVER_CONNECT As Long = 1034 'WM_CAP + 10 'connection a la camera
Private Const WM_CAP_DRIVER_DISCONNECT As Long = 1035 'WM_CAP + 11 'deconnection de la camera
Private Const WM_CAP_EDIT_COPY As Long = 1064 'WM_CAP + 30 'pour copier un cliché dans le clipboard
Private Const WM_CAP_SET_PREVIEW As Long = 1074 'WM_CAP + 50 'enclancher le previws dans la fentre
Private Const WM_CAP_SET_PREVIEWRATE = 1076 'WM_CAP + 52 'nombre d'imagepar seconde (bitrate)
Private Const WM_CAP_GRAB_FRAME_NOSTOP = 1085 'WM_CAP + 61 'rafraichissement dans la fentre de capture constant
Private Const WM_CAP_FILE_SAVEDIB = 1049 'pour enregistrer une capture en image su DD
Private Const WM_CAP_DLG_VIDEOSOURCE = 1066 'pour afficher la boite de dialogue des parametres
Private Const WM_CLOSE = &H10 'fermer les drivers capture
Private Const WM_QUIT = &H12 'quitter la capture
'CONSTANTE POUR MODELISER L'AFFICHAGE DE LA FENETRE
Private Const WS_VISIBLE As Long = &H10000000
Private Const WS_NOCAPTION As Long = &H94080080
Private Const WS_FULLCAPTION As Long = &H94CF0080
#If VBA7 Then
Dim Hcamera As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private 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 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
Private 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
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetParent Lib "User32.dll" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private Declare Function SWLG Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SWPOS Lib "user32" Alias "SetWindowPos" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Dim handle_Form&
#Else
Dim Hcamera As LongPtr
Private Declare PtrSafe Function GetDesktopWindow Lib "user32" () As LongPtr
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare PtrSafe 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
Private Declare PtrSafe 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
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function SetParent Lib "User32.dll" (ByVal hWndChild As LongPtr, ByVal hWndNewParent As LongPtr) As Long
Private Declare PtrSafe Function SWLG Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function SWPOS Lib "user32" Alias "SetWindowPos" (ByVal hwnd As LongPtr, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Dim handle_Form As LongPtr
#End If
Dim PtoPX As Double 'converti point to pixel
Dim ok
Public cheminVBS As String
