avicap32.dll and directshow problem

[didijaba]

Hello,
I need help for updating VBA code made for Win7 to Win8 tablet. I have code for capturing images via camera and it works great with Win7 and Office 2010 (32_bit). Now I have Acer Iconia with Win 8 and my camera capture shows external web camera that I pluged with USB, but internal cameras just do not work. I have read that this is transfer from avicap32.dll to Directshow tecnology in Win8. This is code I have found but I don't know how to modify it. Thank you very, very much. I know this is not easy task.

Const WM_CAP_START = &H400S
    Const WS_CHILD = &H40000000
    Const WS_VISIBLE = &H10000000

    Const WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10
    Const WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11
    Const WM_CAP_EDIT_COPY = WM_CAP_START + 30
    Const WM_CAP_SEQUENCE = WM_CAP_START + 62
    Const WM_CAP_FILE_SAVEAS = WM_CAP_START + 23

    Const WM_CAP_SET_SCALE = WM_CAP_START + 53
    Const WM_CAP_SET_PREVIEWRATE = WM_CAP_START + 52
    Const WM_CAP_SET_PREVIEW = WM_CAP_START + 50

    Const SWP_NOMOVE = &H2S
    Const SWP_NOSIZE = 1
    Const SWP_NOZORDER = &H4S
    Const HWND_BOTTOM = 1
    '--The capGetDriverDescription function retrieves the version 
    ' description of the capture driver--
    Declare Function capGetDriverDescriptionA Lib "avicap32.dll" _
       (ByVal wDriverIndex As Short, _
        ByVal lpszName As String, ByVal cbName As Integer, _
        ByVal lpszVer As String, _
        ByVal cbVer As Integer) As Boolean

    '--The capCreateCaptureWindow function creates a capture window--
    Declare Function capCreateCaptureWindowA Lib "avicap32.dll" _
       (ByVal lpszWindowName As String, ByVal dwStyle As Integer, _
        ByVal x As Integer, ByVal y As Integer, ByVal nWidth As Integer, _
        ByVal nHeight As Short, ByVal hWnd As Integer, _
        ByVal nID As Integer) As Integer

    '--This function sends the specified message to a window or windows--
    Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
       (ByVal hwnd As Integer, ByVal Msg As Integer, _
        ByVal wParam As Integer, _
       <MarshalAs(UnmanagedType.AsAny)> ByVal lParam As Object) As Integer

    '--Sets the position of the window relative to the screen buffer--
    Declare Function SetWindowPos Lib "user32" Alias "SetWindowPos" _
       (ByVal hwnd As Integer, _
        ByVal hWndInsertAfter As Integer, ByVal x As Integer, _
        ByVal y As Integer, _
        ByVal cx As Integer, ByVal cy As Integer, _
        ByVal wFlags As Integer) As Integer

    '--This function destroys the specified window--
    Declare Function DestroyWindow Lib "user32" _
       (ByVal hndw As Integer) As Boolean
    '---used to identify the video source---
    Dim VideoSource As Integer
    '---used as a window handle---
    Dim hWnd As Integer


    Private Sub btnSave_Click(sender As System.Object, e As System.EventArgs) Handles btnSave.Click
        Dim path As String
        path = "C:\data\"
        Dim number As Integer
        number = System.IO.Directory.GetFiles(path).Length
        SendMessage(hWnd, WM_CAP_EDIT_COPY, 0, 0)
        Dim loData As IDataObject = Clipboard.GetDataObject()
        If loData.GetDataPresent(GetType(System.Drawing.Bitmap)) Then
            Using loBitmap As Image = CType(loData.GetData(GetType(System.Drawing.Bitmap)), Image)
                loBitmap.Save(path & "image" & number & ".jpg", Imaging.ImageFormat.Jpeg)
                PictureBox2.Image = Image.FromFile(path & "image" & number & ".jpg")
                PictureBox2.SizeMode = PictureBoxSizeMode.StretchImage
            End Using
        End If
        

    End Sub

    Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
        System.IO.Directory.CreateDirectory("C:\data")
        ListVideoSources()

    End Sub
    '---list all the various video sources---
    Private Sub ListVideoSources()
        Dim DriverName As String = Space(80)
        Dim DriverVersion As String = Space(80)
        For i As Integer = 0 To 9
            If capGetDriverDescriptionA(i, DriverName, 80, _
               DriverVersion, 80) Then
                lstVideoSources.Items.Add(DriverName.Trim)

            End If
        Next
    End Sub

    '---list all the video sources---
    Private Sub lstVideoSources_SelectedIndexChanged( _
       ByVal sender As System.Object, ByVal e As System.EventArgs) _
       Handles lstVideoSources.SelectedIndexChanged
        '---check which video source is selected---
        VideoSource = lstVideoSources.SelectedIndex
        '---preview the selected video source
        PreviewVideo(picCapture)
    End Sub
    '---preview the selected video source---
    Private Sub PreviewVideo(ByVal pbCtrl As PictureBox)
        hWnd = capCreateCaptureWindowA(VideoSource, _
            WS_VISIBLE Or WS_CHILD, 0, 0, 0, _
            0, pbCtrl.Handle.ToInt32, 0)
        If SendMessage( _
           hWnd, WM_CAP_DRIVER_CONNECT, _
           VideoSource, 0) Then
            '---set the preview scale---
            SendMessage(hWnd, WM_CAP_SET_SCALE, True, 0)
            '---set the preview rate (ms)---
            SendMessage(hWnd, WM_CAP_SET_PREVIEWRATE, 30, 0)
            '---start previewing the image---
            SendMessage(hWnd, WM_CAP_SET_PREVIEW, True, 0)
            '---resize window to fit in PictureBox control---
            SetWindowPos(hWnd, HWND_BOTTOM, 0, 0, _
               pbCtrl.Width, pbCtrl.Height, _
               SWP_NOMOVE Or SWP_NOZORDER)
        Else
            '--error connecting to video source---
            DestroyWindow(hWnd)
        End If
    End Sub
    '---stop the preview window---
    Private Sub btnStopCamera_Click( _
       ByVal sender As System.Object, _
       ByVal e As System.EventArgs)

        StopPreviewWindow()
    End Sub
    '--disconnect from video source---
    Private Sub StopPreviewWindow()
        SendMessage(hWnd, WM_CAP_DRIVER_DISCONNECT, VideoSource, 0)
        DestroyWindow(hWnd)
    End Sub
    '---Start recording the video---
    Private Sub btnStartRecording_Click( _
       ByVal sender As System.Object, _
       ByVal e As System.EventArgs) _
       Handles btnStartRecording.Click
        btnStartRecording.Enabled = False
        btnStopRecording.Enabled = True
        '---start recording---
        SendMessage(hWnd, WM_CAP_SEQUENCE, 0, 0)
    End Sub
    '---stop recording and save it on file---
    Private Sub btnStopRecording_Click( _
       ByVal sender As System.Object, _
       ByVal e As System.EventArgs) _
       Handles btnStopRecording.Click
        btnStartRecording.Enabled = True
        btnStopRecording.Enabled = False
        '---save the recording to file---
        SendMessage(hWnd, WM_CAP_FILE_SAVEAS, 0, _
           "C:\RecordedVideo.avi")
    End Sub

and my avicap32 code

Option Explicit
'***************************************************
'
'source http://www.vbfrance.com/code.aspx?ID=30202
'TheHacker & Sylvain298
'
'
'***************************************************
'adapté par michelxld le 26.03.2005
'pour le forum http://www.excel-downloads.com
'
Dim mCapHwnd As Long
Dim retvale As Long
Dim CapParms As TCAPTUREPARMS
Dim Bitmap As Variant 'on declare une variable qui sera le chemin d'acces pour les photos
Dim Valeur As Long
Dim strFormClassName As String

Private Type TCAPTUREPARMS
 dwRequestMicroSecPerFrame As Long
 fLimitEnabled  As Boolean
 fCaptureAudio  As Boolean
 fMCIControl  As Boolean
 fYield  As Boolean
 vKeyAbort As Byte
 fAbortLeftMouse  As Boolean
 fAbortRightMouse As Boolean
End Type


Private Type tagInitCommonControlsEx 'pour l'effet windows XP
   lngSize As Long
   lngICC As Long
End Type

Private Declare Function InitCommonControlsEx Lib "comctl32.dll" (iccex As tagInitCommonControlsEx) As Boolean
Private Const ICC_USEREX_CLASSES = &H200

'la constante de depart est 1024
'video capture calls
Private Const WM_CAP_DRIVER_CONNECT As Long = 1034          'pour savoir si la webcam est connecté
Private Const WM_CAP_GRAB_FRAME As Long = 1084              'pour povoir previsualiser la webcam
Private Const WM_CAP_EDIT_COPY As Long = 1054               'pour copier l'image de la webcam, mais ici ca ne marche pas car on affiche un prwiev de la webcam grace a u copier coller (si vous trouvez autre chose pour le preview ca marche super)
Private Const WM_CAP_DRIVER_DISCONNECT = 1035               'pour savoir si la webcam est pas connectée
Private Const WM_CAP_SEQUENCE = 1086                        'pour la capture AVI
Private Const WM_CAP_GET_SEQUENCE_SETUP = 1089              'sais pas
Private Const WM_CAP_SET_SEQUENCE_SETUP = 1088              'sais pas
Private Const WM_CAP_FILE_SET_CAPTURE_FILE = 1044           'pour changer le chemin de destination du fichier AVI
Private Const WM_CAP_DLG_VIDEOSOURCE = 1066                 'pour afficher les parametre
Private Const WM_CAP_FILE_SAVEAS = 1047                     'pour enregistrer dans un fichier specifier
Private Const WM_CAP_STOP = 1092                            'pour arreter la capture


Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function capCreateCaptureWindow Lib "avicap32.dll" Alias "capCreateCaptureWindowA" (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 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 Sauvegarde Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As String) As Long



Private Sub CommandButton1_Click()
On Error Resume Next
SendMessage mCapHwnd, WM_CAP_GRAB_FRAME, 0, 0 'on rafraichit l'image "webcam"
SendMessage mCapHwnd, WM_CAP_EDIT_COPY, 0, 0
DoEvents
'*****************************************************************************
'
'attention module ModPastePicture adapté pour transformer les images d'une WebCam
'par michelxld le 26.03.2005
'pour le forum http://www.excel-downloads.com
'
'*****************************************************************************
Set Image1.Picture = PastePicture(WM_CAP_EDIT_COPY)

End Sub

Private Sub CommandButton2_Click()
'boite de dialogue parametres de la WebCam
SendMessage mCapHwnd, WM_CAP_DLG_VIDEOSOURCE, 0, 0
End Sub

Private Sub CommandButton3_Click()
Dim iPic As StdPicture
Set iPic = Me.Image1.Picture

If iPic Is Nothing Then Exit Sub

SavePicture iPic, ThisWorkbook.Path _
& "\ImageWebCam" & Format(Date, "YYYYMMDD") & " " & Format(Time, "HHMMSS") & ".jpg"

DestroyIcon iPic.handle
Set iPic = Nothing
End Sub



Private Sub UserForm_Activate()
Dim I As Double
On Error Resume Next ' j'ai ajouté cette ligne
'recuperer le Handle de l'Usf : Daniel Klann, mpep
If Val(Application.Version) < 9 Then 'Excel 2000
strFormClassName = "ThunderXFrame"
Else
strFormClassName = "ThunderDFrame" 'Excel 2000/2002
End If

Valeur = FindWindow(strFormClassName, "UserForm1") 'le Handle de la fenetre

'on definie la variable necessaire au bon fonctionnement de la capture video
mCapHwnd = capCreateCaptureWindow("My Own Capture Window", 0, 0, 0, 320, 240, Valeur, 0)
'on dit au prog que la camera est branchée
SendMessage mCapHwnd, WM_CAP_DRIVER_CONNECT, 0, 0

If SendMessage(mCapHwnd, WM_CAP_DRIVER_CONNECT, 0, 0) = 0 Then
MsgBox ("La camera n'est pas connectée")
retvale = SendMessage(mCapHwnd, WM_CAP_DRIVER_DISCONNECT, 0, 0)
DestroyWindow (mCapHwnd)
Unload Me
Else ' j'ai ajouté cette ligne
I = 1 ' j'ai ajouté cette ligne
Do ' j'ai ajouté cette ligne
If I Mod 1000 = 0 Then ' Lorsque la boucle s'est ' j'ai ajouté cette ligne
' répétée 1000 fois. ' j'ai ajouté cette ligne
DoEvents ' Cčde le contrôle au ' j'ai ajouté cette ligne
' systčme d'exploitation. ' j'ai ajouté cette ligne
SendMessage mCapHwnd, WM_CAP_GRAB_FRAME, 0, 0 'on rafraichit l'image "webcam" ' j'ai ajouté cette ligne
SendMessage mCapHwnd, WM_CAP_EDIT_COPY, 0, 0 ' j'ai ajouté cette ligne
Set Image1.Picture = PastePicture(WM_CAP_EDIT_COPY) ' j'ai ajouté cette ligne
End If ' j'ai ajouté cette ligne
'End If
I = I + 1 ' j'ai ajouté cette ligne ==> en fait je me sert de I pour pouvoir quitter la boucle quand on clique sur la croix, je l'initialise ŕ -1 car vu qu'ici il va faire +1 i=0 sinon le programme se ferme mais ne se coupe pas ŕ cause du DoEvents
Loop Until I = 0
End If
End Sub
'-------------------------------------------------------------------
' dans la procédure termiate, j'ai ajouté 2 commandes
'-------------------------------------------------------------------
Private Sub UserForm_Terminate()
Dim I As Double
Dim oDataObject As DataObject

'Etape Importante avant de quitter sinon ca peut bloquer !
retvale = SendMessage(mCapHwnd, WM_CAP_DRIVER_DISCONNECT, 0, 0)
DestroyWindow (mCapHwnd)

Set oDataObject = New DataObject 'vider le presse papier
oDataObject.SetText ""
oDataObject.PutInClipboard

Set oDataObject = Nothing
Unload Me 'j'ai ajouté cette ligne
I = -1 'j'ai ajouté cette ligne
End Sub

I can send you file on PM.

 

[excelvbacoder]

<marshalas(unmanagedtype.asany)>Hello Everyone,

for my application, I am also using the same code and everything seems pretty straight forward to me, that I had to make very minor changes to the actual, in order to fit my requirement and I am able to see the PREVIEW of the pictures, before clicking the "CAPTURE PICTURE" button.

But my concern is, everytime I go to this page to take a picture, I get this pop up to choose the VIDEO SOURCE, in which I have 2 options:
1. The CAMERA integrated with my laptop
2. The WebCam that I have externally connected (Logitech Cam)

Now it is quite annoying to choose the Camera everytime when I want to take a picture. I would like to get rid off this situation. Looked on the Internet, but with no success so far.

Could someone help me how to choose the Camera to be used BY DEFAULT? Hoping to get some help/hints from the experts.

Regards,
Praveen.</marshalas(unmanagedtype.asany)>