Option Explicit On Public Class iCam #Region "Api/constants" Private Const WS_CHILD As Integer = &H40000000 Private Const WS_VISIBLE As Integer = &H10000000 Private Const SWP_NOMOVE As Short = &H2S Private Const SWP_NOZORDER As Short = &H4S Private Const WM_USER As Short = &H400S Private Const WM_CAP_DRIVER_CONNECT As Integer = WM_USER + 10 Private Const WM_CAP_DRIVER_DISCONNECT As Integer = WM_USER + 11 Private Const WM_CAP_SET_VIDEOFORMAT As Integer = WM_USER + 45 Private Const WM_CAP_SET_PREVIEW As Integer = WM_USER + 50 Private Const WM_CAP_SET_PREVIEWRATE As Integer = WM_USER + 52 Const WM_CAP_SET_SCALE As Integer = WM_USER + 53 Const HWND_BOTTOM As Short = 1 Private Const WM_CAP_GET_FRAME As Long = 1084 Private Const WM_CAP_COPY As Long = 1054 Private Const WM_CAP_START As Long = WM_USER Private Const WM_CAP_STOP As Long = (WM_CAP_START + 68) Private Const WM_CAP_SEQUENCE As Long = (WM_CAP_START + 62) Private Const WM_CAP_SET_SEQUENCE_SETUP As Long = (WM_CAP_START + 64) Private Const WM_CAP_FILE_SET_CAPTURE_FILEA As Long = (WM_CAP_START + 20) 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 Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Short, ByVal lParam As String) As Integer Private 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 hWndParent As Integer, ByVal nID As Integer) As Integer Private Declare Function capGetDriverDescriptionA Lib "avicap32.dll" (ByVal wDriver As Short, ByVal lpszName As String, ByVal cbName As Integer, ByVal lpszVer As String, ByVal cbVer As Integer) As Boolean Private Declare Function BitBlt Lib "GDI32.DLL" (ByVal hdcDest As IntPtr, ByVal nXDest As Integer, ByVal nYDest As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal hdcSrc As IntPtr, ByVal nXSrc As Integer, ByVal nYSrc As Integer, ByVal dwRop As Int32) As Boolean #End Region Private iDevice As String Private hHwnd As Integer Private lwndC As Integer Public iRunning As Boolean Private CamFrameRate As Integer = 25 Private OutputHeight As Integer = 480 Private OutputWidth As Integer = 640 Public Sub resetCam() 'resets the camera after setting change If iRunning Then closeCam() Application.DoEvents() If setCam() = False Then MessageBox.Show("Errror Setting/Re-Setting Camera") End If End If End Sub Public Sub initCam(ByVal parentH As Integer) 'Gets the handle and initiates camera setup If Me.iRunning = True Then MessageBox.Show("Camera Is Already Running") Exit Sub Else hHwnd = capCreateCaptureWindowA(iDevice, WS_VISIBLE Or WS_CHILD, 0, 0, OutputWidth, CShort(OutputHeight), parentH, 0) If setCam() = False Then MessageBox.Show("Error setting Up Camera") End If End If End Sub Public Sub setFrameRate(ByVal iRate As Long) 'sets the frame rate of the camera CamFrameRate = CInt(1000 / iRate) resetCam() End Sub Private Function setCam() As Boolean 'Sets all the camera up If SendMessage(hHwnd, WM_CAP_DRIVER_CONNECT, CShort(iDevice), CType(0, String)) = 1 Then SendMessage(hHwnd, WM_CAP_SET_PREVIEWRATE, CShort(CamFrameRate), CType(0, String)) SendMessage(hHwnd, WM_CAP_SET_PREVIEW, 1, CType(0, String)) SendMessage(hHwnd, WM_CAP_SET_SCALE, True, 0) SetWindowPos(hHwnd, HWND_BOTTOM, 0, 0, Form1.picOutput.Width, Form1.picOutput.Height, SWP_NOMOVE Or SWP_NOZORDER) Me.iRunning = True Return True Else Me.iRunning = False Return False End If End Function Public Function closeCam() As Boolean 'Closes the camera If Me.iRunning Then closeCam = CBool(SendMessage(hHwnd, WM_CAP_DRIVER_DISCONNECT, 0, CType(0, String))) Me.iRunning = False End If End Function Public Function FPS() As Integer Return CInt(1000 / (CamFrameRate)) End Function End Class