Capturar Imagen Camara Digital

Hola que tal a todos los miembros del foro... Sucede que estoy desarrollando una aplicación donde necesito tener conectada una cámara digital, así mismo, sacar fotografías con dicha cámara y que me almacene la imagen en una determinada ruta en mi disco duro.

No tengo la menor idea de como empezar... Alguien podría ayudarme?? Se los agradecería mucho

Saludos

aqui tienes un ejemplo

Write the following code in a module

'******************* module code **************

Public Const WS_CHILD As Long = &H40000000
Public Const WS_VISIBLE As Long = &H10000000


Public Const WM_USER As Long = &H400
Public Const WM_CAP_START As Long = WM_USER


Public Const WM_CAP_DRIVER_CONNECT As Long = WM_CAP_START + 10
Public Const WM_CAP_DRIVER_DISCONNECT As Long = WM_CAP_START + 11
Public Const WM_CAP_SET_PREVIEW As Long = WM_CAP_START + 50
Public Const WM_CAP_SET_PREVIEWRATE As Long = WM_CAP_START + 52
Public Const WM_CAP_DLG_VIDEOFORMAT As Long = WM_CAP_START + 41
Public Const WM_CAP_FILE_SAVEDIB As Long = WM_CAP_START + 25


Public 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


Public Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long _
, ByVal wParam As Long, ByRef lParam As Any) As Long

'************* end of module code ******************

Add the following controls in a form

1. A picture box with name "PicWebCam"

2. A commondialog control with name "CDialog"

3. Add 4 command buttons with name "cmd1","cmd2,"cmd3","cmd4"

then paste the following code

'************************** Code **************

Dim hCap As Long
Private Sub cmd4_Click()
Dim sFileName As String
Call SendMessage(hCap, WM_CAP_SET_PREVIEW, CLng(False), 0&)
With CDialog
.CancelError = True
.Flags = cdlOFNPathMustExist Or cdlOFNOverwritePrompt
.Filter = "Bitmap Picture(*.bmp)|*.bmp|JPEG Picture(*.jpg)|*.jpg|All Files|*.*"
.ShowSave
sFileName = .FileName


End With
Call SendMessage(hCap, WM_CAP_FILE_SAVEDIB, 0&, ByVal CStr(sFileName))
DoFinally:
Call SendMessage(hCap, WM_CAP_SET_PREVIEW, CLng(True), 0&)
End Sub

Private Sub Cmd3_Click()
Dim temp As Long
temp = SendMessage(hCap, WM_CAP_DRIVER_DISCONNECT, 0&, 0&)
End Sub

Private Sub Cmd1_Click()
hCap = capCreateCaptureWindow("Take a Camera Shot", WS_CHILD Or WS_VISIBLE, 0, 0, PicWebCam.Width, PicWebCam.Height, PicWebCam.hWnd, 0)
If hCap <> 0 Then
Call SendMessage(hCap, WM_CAP_DRIVER_CONNECT, 0, 0)
Call SendMessage(hCap, WM_CAP_SET_PREVIEWRATE, 66, 0&)
Call SendMessage(hCap, WM_CAP_SET_PREVIEW, CLng(True), 0&)
End If
End Sub

Private Sub Cmd2_Click()
Dim temp As Long
temp = SendMessage(hCap, WM_CAP_DLG_VIDEOFORMAT, 0&, 0&)
End Sub

Private Sub Form_Load()
cmd1.Caption = "Start &Cam"
cmd2.Caption = "&Format Cam"
cmd3.Caption = "&Close Cam"
cmd4.Caption = "&Save Image"
End Sub
'**************** Code end ************************

Tengo un lio barbaro de OCX por todos ladoshttp://www.canalvisualbasic.net/foro...ys/smiley5.gif pero si no recuerdo mal este toma imagenes de una camara o webcam:
http://www.geocities.com/diego91268/actiVideo.zip

Si no llega a ser ese avisame y busco mejor. Saludos!
(diergui[-A.R.R.O.B.A-]gmail.com)

Hola a ver si te sirve esto:

Option Explicit

'Constantes
Private Const WM_CAP_DRIVER_CONNECT As Long = 1034
Private Const WM_CAP_DRIVER_DISCONNECT As Long = 1035
Private Const WM_CAP_GRAB_FRAME As Long = 1084
Private Const WM_CAP_EDIT_COPY As Long = 1054
Private Const WM_CAP_DLG_VIDEOFORMAT As Long = 1065
Private Const WM_CAP_DLG_VIDEOSOURCE As Long = 1066
Private Const WM_CLOSE = &H10

'Declaraciones
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 ReleaseCapture Lib "USER32" () As Long

'Variables
Private mCapHwnd As Long
Private mLivePreview As Boolean

'Metodos
Private Sub Form_Load()
mCapHwnd = capCreateCaptureWindow("My Own Capture Window", 0, 0, 0, 320, 240, Me.hwnd, 0)
LivePreview = True
End Sub

Private Sub Form_Unload(Cancel As Integer)
LivePreview = False
SendMessage mCapHwnd, WM_CLOSE, 0, 0
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
ReleaseCapture
SendMessage Me.hwnd, &HA1, 2, 0&
End Sub

Private Sub Form_Resize()
Static Running As Boolean
If Running = True Then
Exit Sub
End If
Running = True
If WindowState <> vbMinimized Then
GrabFrame
Width = ScaleX(Picture.Width, vbHimetric, vbTwips)
Height = ScaleY(Picture.Height, vbHimetric, vbTwips)
lblPaused.Move ScaleWidth - lblPaused.Width, ScaleHeight - lblPaused.Height
chkPaused.Move lblPaused.Left - chkPaused.Width - 3, lblPaused.Top
End If
Running = False
End Sub

Private Sub lblSize_Click()
SendMessage mCapHwnd, WM_CAP_DLG_VIDEOFORMAT, 0, 0
Form_Resize
End Sub

Private Sub lblSource_Click()
SendMessage mCapHwnd, WM_CAP_DLG_VIDEOSOURCE, 0, 0
Form_Resize
End Sub

Private Sub Salida_Click()
Unload CapturaImagen
End
End Sub

Private Sub Timer1_Timer()
GrabFrame
End Sub

Private Sub GrabFrame()
On Error Resume Next
SendMessage mCapHwnd, WM_CAP_GRAB_FRAME, 0, 0
SendMessage mCapHwnd, WM_CAP_EDIT_COPY, 0, 0
Set Picture = Clipboard.GetData
End Sub

Private Sub lblPaused_Click()
chkPaused.Value = IIf(chkPaused.Value = 0, 1, 0)
End Sub

Private Sub chkPaused_Click()
If chkPaused.Value = 1 Then
LivePreview = False
Else
LivePreview = True
End If
End Sub

Friend Property Let LivePreview(ByVal b As Boolean)
'Conmuta el video de on a off o viceversa
If b = False Then
'Apaga el video
If mLivePreview = True Then
SendMessage mCapHwnd, WM_CAP_DRIVER_DISCONNECT, 0, 0
End If
Else
'Enciende el video
If mLivePreview = False Then
SendMessage mCapHwnd, WM_CAP_DRIVER_CONNECT, 0, 0
End If
End If
mLivePreview = b
Timer1.Enabled = b
End Property

Gracias a todos por sus expliaciones, ahora las pongo en practica. Saludos y gracias nuevamene