vb ile webcam kontrolü [soru] - Visual Basic ve VB#

Ole nesnesi kullanmadan da olur dersen ve forma bi tane picturebox eklersen bu çalışıo ;) :

Const ws_visible = &H10000000
Const ws_child = &H40000000
Const WM_USER = 1024
Const WM_CAP_EDIT_COPY = WM_USER + 30
Const wm_cap_driver_connect = WM_USER + 10
Const wm_cap_set_preview = WM_USER + 50
Const wm_cap_set_overlay = WM_USER + 51
Const WM_CAP_SET_PREVIEWRATE = WM_USER + 52
Const WM_CAP_SEQUENCE = WM_USER + 62
Const WM_CAP_SINGLE_FRAME_OPEN = WM_USER + 70
Const WM_CAP_SINGLE_FRAME_CLOSE = WM_USER + 71
Const WM_CAP_SINGLE_FRAME = WM_USER + 72
Const DRV_USER = &H4000
Const DVM_DIALOG = DRV_USER + 100
Const PREVIEWRATE = 30
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function capCreateCaptureWindow Lib "avicap32.dll" Alias "capCreateCaptureWindowA" (ByVal a As String, ByVal b As Long, ByVal c As Integer, ByVal d As Integer, ByVal e As Integer, ByVal f As Integer, ByVal g As Long, ByVal h As Integer) As Long
Dim hwndc As Long
Dim saveflag As Integer
Dim pictureindex As Integer
Dim filter1(-1 To 1, -1 To 1) As Single
Dim filter2(-1 To 1, -1 To 1) As Single
Dim temp As String
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Form_Load()
On Error GoTo handler:
hwndc = capCreateCaptureWindow("CaptureWindow", ws_child Or ws_visible, 0, 0, PichWnd.Width, PichWnd.Height, PichWnd.hWnd, 0)
If (hwndc <> 0) Then
      temp = SendMessage(hwndc, wm_cap_driver_connect, 0, 0)
      temp = SendMessage(hwndc, wm_cap_set_preview, 1, 0)
      temp = SendMessage(hwndc, WM_CAP_SET_PREVIEWRATE, PREVIEWRATE, 0)
      temp = SendMessage(Me.hWnd, WM_CAP_EDIT_COPY, 1, 0)
      Picture1.Picture = Clipboard.GetData
Else
      MsgBox "Unable to capture video.", vbCritical
End If
Exit Sub
handler:
End
End Sub

'GhostYourself by Jesse Seidel
'Please do not steal my code without including me somewhere in your program
'I will get pissed off and you never know what happens then :@

Option Explicit

'This API is the key to the translucency
Private Declare Function AlphaBlend Lib "msimg32" ( _
ByVal hDestDC 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 widthSrc As Long, _
ByVal heightSrc As Long, ByVal blendFunct As Long) As Boolean

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
Destination As Any, Source As Any, ByVal Length As Long)

'For changing transparency levels
Private Type typeBlendProperties
tBlendOp As Byte
tBlendOptions As Byte
tBlendAmount As Byte
tAlphaType As Byte
End Type

Private Sub barAmount_Scroll()
Dim tProperties As typeBlendProperties
Dim lngBlend As Long
picDestination.Cls 'Clear the destination picturebox
tProperties.tBlendAmount = 255 - barAmount 'Change transparency level
CopyMemory lngBlend, tProperties, 4
AlphaBlend picDestination.hDC, 0, 0, picSource.ScaleWidth, picSource.ScaleHeight, _
picSource.hDC, 0, 0, picSource.ScaleWidth, picSource.ScaleHeight, lngBlend 'Fade image
picDestination.Refresh 'Refresh to display
Label1.Caption = barAmount.Value 'Change the label to value of transparency
End Sub

Private Sub Command1_Click()
mCapHwnd = capCreateCaptureWindow("WebcamCapture", 0, 0, 0, 320, 240, Me.hWnd, 0) 'Get hWnd for webcam so we can use it
DoEvents: SendMessage mCapHwnd, CONNECT, 0, 0 'Capture from webcam
tmrMain.Enabled = True 'Enable timer to refresh webcam images
Command2.Enabled = True 'Make stop button enabled
Command1.Enabled = False 'Make start button disabled
Command4.Enabled = True 'Make Set BG button enabled
sb1.SimpleText = "Webcam started..." 'Change statusbar caption
End Sub

Private Sub Command2_Click()
tmrMain.Enabled = False 'Disable refreshing of webcam images
DoEvents: SendMessage mCapHwnd, DISCONNECT, 0, 0 'Stop capturing of images from webcam
Command1.Enabled = True 'Make start enabled
Command2.Enabled = False 'Make stop disabled
Command4.Enabled = False 'Make Set BG button disabled
sb1.SimpleText = "Webcam stopped..." 'Change statusbar caption
End Sub

Private Sub Command3_Click()
Image1.Picture = picDestination.Image 'Capture current image for saving
cd1.Filter = "Bitmap (*.BMP)|*.BMP|Jpeg (*.JPEG)|*.JPG|Gif (*.GIF)|*.GIF" 'Supported file-types
cd1.ShowSave 'Show save dialog
SavePicture Image1, cd1.FileName 'Write picture to hard-drive
sb1.SimpleText = "Image saved to " & cd1.FileName 'Change statusbar caption
End Sub

Private Sub Command4_Click()
picSource.Picture = picDestination.Image 'Set background image
sb1.SimpleText = "Background set..." 'Change statusbar caption
End Sub

Private Sub Form_Load()
barAmount_Scroll 'This is just for my own purposes
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
DoEvents: SendMessage mCapHwnd, DISCONNECT, 0, 0 'Stop webcam capturing
End Sub

Private Sub Picture2_Click()

End Sub

Private Sub tmrMain_Timer()
On Error Resume Next
SendMessage mCapHwnd, GET_FRAME, 0, 0 'Capture frame from webcam
SendMessage mCapHwnd, COPY, 0, 0 'Copy frame
picDestination.Picture = Clipboard.GetData 'Paste captured frame from clipboard
Clipboard.Clear 'Clear clipboard
barAmount_Scroll 'Change alpha-blending and such
picSource.Height = picDestination.Height 'Make sure both the source and destination pictures are the same height/width
picSource.Width = picDestination.Width 'Make sure both the source and destination pictures are the same height/width
End Sub

bide modül ekle
modül kısmı
'All of this is for capturing frames from the webcam

Public Declare Function SendMessage Lib "USER32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
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 mCapHwnd As Long

Public Const CONNECT As Long = 1034
Public Const DISCONNECT As Long = 1035
Public Const GET_FRAME As Long = 1084
Public Const COPY As Long = 1054