Webcam-class for Windows

This code has been declared by its author to be Public Domain code.

Webcam-class for Windows by Mirko

2005

It is just a small class to capture pictures from a webcam and put them into a pixmap so you can draw them on the bmx screen.
Pherhaps someone might find this usefull for something.
If you manage to optimize the code, don't forgett to let me know ;-)
(It's windows only!)

'Application: webcam - class
'Author: 		Mirko 'NAPALM' Tocchella
'Description: 	I little wrapper to capture pictures from a webcam and put
'				them into a pixmap	
'				At the end of the source there is a little example
'

Import BRL.System

Import PUB.Win32


extern "Win32"
	function webcam_GetActiveWindow:int () "Win32" = "GetActiveWindow"
	Function webcam_SendMessage( hWnd,MSG,wParam,lParam) "Win32" = "SendMessageA"
	Function webcam_FreeLibrary ( hnd:Int ) "Win32" = "FreeLibrary"
end extern

const WM_CAP_START = WM_USER

const WM_CAP_SET_CALLBACK_ERROR = WM_CAP_START + 2
const WM_CAP_SET_CALLBACK_STATUS = WM_CAP_START + 3
const WM_CAP_SET_CALLBACK_YIELD = WM_CAP_START + 4
const WM_CAP_SET_CALLBACK_FRAME = WM_CAP_START + 5
const WM_CAP_SET_CALLBACK_VIDEOSTREAM = WM_CAP_START + 6
const WM_CAP_SET_CALLBACK_WAVESTREAM = WM_CAP_START + 7

const WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10
const WM_CAP_DRIVER_GET_CAPS = WM_CAP_START + 14

const WM_CAP_DLG_VIDEOFORMAT = WM_CAP_START + 41
const WM_CAP_DLG_VIDEOSOURCE = WM_CAP_START + 42
const WM_CAP_DLG_VIDEODISPLAY = WM_CAP_START + 43

const WM_CAP_GET_VIDEOFORMAT = WM_CAP_START +44
const WM_CAP_SET_VIDEOFORMAT = WM_CAP_START +45

const WM_CAP_SET_PREVIEW = WM_CAP_START + 50
const WM_CAP_SET_OVERLAY = WM_CAP_START + 51
const WM_CAP_SET_PREVIEWRATE = WM_CAP_START + 52
const WM_CAP_SET_SCALE = WM_CAP_START +53
const WM_CAP_GET_STATUS = WM_CAP_START + 54

const WM_CAP_SET_CALLBACK_CAPCONTROL = WM_CAP_START + 85


type TWebcam
	field  Handle:Int
	field  DeviceID:Int
	field  FrameRate:Int
	field  LibHandle:Int
	global Width:Int
	global Height:Int
	global PMWidth:Int
	global PMHeight:Int
	global Image:TPixmap 
	field webcam_CreateCaptureWindow:Int (WName:Byte Ptr, Style:int, X:int, y:int, w:int, h:Int, ..
									  ParentWnd:int, ID:int) "Win32"
	
	method New ()
		Image = CreatePixmap(16,16,PF_RGB888)
		FrameRate = 15
		Handle = NULL
		DeviceID = -1
		' Get the library handle
		LibHandle = LoadLibraryA("AVICAP32.DLL")
		If Not LibHandle Then Throw "Can't load AVICAP32.DLL"
		
		' Get the Adress of the capCreateCaptureWindow function
		webcam_CreateCaptureWindow = GetProcAddress( LibHandle, "capCreateCaptureWindowA" ) 
'		If Not webcam_CreateCaptureWindow Then Throw "Can't get adress of capCreateCaptureWindowA"			
	End Method
	
	method Delete ()
		DeInit()
		FreeLibrary(LibHandle)
		Image = NULL
	End Method
	
	method Init:Int (WHnd:Int, x:int, y:int, w:int, h:Int)
		local res:int = false
		if (Handle <> NULL) DeInit()
		DeviceID = -1
		Handle = Webcam_CreateCaptureWindow (NULL, WS_VISIBLE+WS_CHILD, x, y, w, h, WHnd, 1)
		if (Handle <> NULL)
			res = ConnectDevice()
			if (res) EnablePreviewMode(true)
			if (res) SetFrames(Framerate)			
		endif
		return (res)
	End Method
	
	method DeInit ()
		if (handle <> NULL)
			DestroyWindow (Handle)
			Handle = NULL			
		end if		
		DeviceID = -1
	End Method
	
	Method ConnectDevice:Int ()
		if (deviceID = -1)
  		  for local i:int = 0 to 9
			local res:Int = Webcam_SendMessage(Handle, WM_CAP_DRIVER_CONNECT, i, 0)
			if (res <> 0)
			  DeviceID = i
			  exit
			endif
		  Next
		endif
		return (DeviceID <> -1)		
	End Method
	
	method EnablePreviewMode (enable:Int)
		if (DeviceID <> -1)
			Webcam_SendMessage (Handle, WM_CAP_SET_PREVIEW, enable, 0)
		end if		
	End Method
	
	method EnableOverlayMode (enable:Int)
		if (DeviceID <> -1)
			Webcam_SendMessage (Handle, WM_CAP_SET_OVERLAY, enable, 0)
		end if		
	End Method
	
	method SetFrames (XFrames:Int)
		FrameRate = XFrames
		if (DeviceID <> -1)
			Webcam_SendMessage (Handle, WM_CAP_SET_PREVIEWRATE, FrameRate, 0)
		end if		
	End Method
	
	method ShowSettings (nr:Int) 'use 0 to 2	
		if (DeviceID <> -1)
			Webcam_SendMessage (Handle, WM_CAP_DLG_VIDEOFORMAT+nr, 0, 0)
		end if		
	End Method
	
	method SetScale (DoScale:Int)
		if (DeviceID <> -1)
			Webcam_SendMessage (Handle, WM_CAP_SET_SCALE, DoScale, 0)
		end if		
	End Method
	
	method SetFrameCallbackRoutine ()
		if (DeviceID <> -1)		   
			local Routine:Byte Ptr 
			Routine = FrameCallback
			Webcam_SendMessage (Handle, WM_CAP_SET_CALLBACK_FRAME, 0, int(Routine))
		end if		
	End Method
	
	method SetPMSize (w:int, h:int)
		PMWidth = w
		PMHeight = h
	End Method
	
	method SetSize (w:int, h:int)
		local res:Int = false
		if (DeviceID <> -1)		   
			' Get The size of the structure first
			local size:Int = Webcam_SendMessage (Handle, WM_CAP_GET_VIDEOFORMAT, 0, NULL)
			if (size > 0)
				' Get The Space for the Data
				local Bank:TBank = createBank(size)
				Webcam_SendMessage (Handle, WM_CAP_GET_VIDEOFORMAT, size, int(BankBuf(Bank)))
				'Manipulate the buffer
				Width  = PeekInt(Bank, 4)
				Height = PeekInt(Bank, 8)
				DebugLog "Width: "+Width+" Height: "+Height
				PokeInt(Bank, 4, w)
				PokeInt(Bank, 8, h)
				'Write it back
				res = Webcam_SendMessage (Handle, WM_CAP_SET_VIDEOFORMAT, size, int(BankBuf(Bank)))
				if (res)
					Width  = w
					Height = h	
				end if
				Bank = NULL
			end if			
		end if		
		return(res)
	End Method
	
function FrameCallback (lwnd:Int, lpVHdr:Byte Ptr)
	local VideoHeader:Tbank = CreateStaticBank(lpVHdr, 40)
	local VideoMemoryAdress:Byte ptr	= Byte Ptr(PeekInt(VideoHeader, 0))
	local dwBytesUsed:Int				= PeekInt(VideoHeader, 4)	

	if (dwBytesUsed = (Width*Height*3)) ' 640 * 480 * 24bit
		local TempMap:TPixMap = CreateStaticPixMap (VideomemoryAdress, Width, Height, Width*3,PF_BGR888)		
'		WebCamImage = LoadImage(TempMap)
		Image = YFlipPixmap(TempMap)
		if (PMWidth <> Width) or (PMHeight <> Height)
			Image = ResizePixMap (Image, PMWidth,PMHeight)
		endif
	else
		debuglog "Wrong Picture Size. Expected "+Width+"/"+Height	
	end if
End Function
	
	
End type

'rem 

' TEST
graphics 800,600,0'32,60
local whnd = Webcam_GetActiveWindow()
local Webcam:TWebcam = new TWebcam
local rot:Int

if (Webcam.Init(whnd, 0,0,640,480))
'	Webcam.ShowSettings(0)
	Webcam.SetFrames(30)
	Webcam.SetSize(320,240)
	Webcam.SetPMSize(800,600)
	Webcam.SetScale(false)
	Webcam.EnablePreviewMode(false)
	Webcam.EnableOverlayMode(false)
	Webcam.SetFrameCallbackRoutine()
	while not keyhit(key_escape)
		cls 
		setcolor 255,255,255
		DrawPixMap (Webcam.Image, 0,0)
		drawtext "Memory usage:"+MemAlloced(), 0,580
		flip
		flushmem
	wend
else
	RuntimeError ("Cant Initialize Webcam")	
end if
endgraphics()
'end rem

Comments

xlsior

2005

Filax

2005

It's strange i get an error on ?

FreeLibrary(LibHandle)

And in the console output :

Warning: resolving _GetActiveWindow by linking to _GetActiveWindow@0
Use --enable-stdcall-fixup to disable these warnings
Use --disable-stdcall-fixup to disable these fixups
Warning: resolving _SendMessageA by linking to _SendMessageA@16

Process complete

BlitzSupport

2005

Nice job, Mirko. I ran into the same problem as Filax, but hacked it to work for me...

'Application: webcam - class
'Author: 		Mirko 'NAPALM' Tocchella
'Description: 	I little wrapper to capture pictures from a webcam and put
'				them into a pixmap	
'				At the end of the source there is a little example
'

Import BRL.System

Import PUB.Win32


'Extern "Win32"
'	Function webcam_GetActiveWindow:Int () "Win32" = "GetActiveWindow"
'	Function webcam_SendMessage( hWnd,MSG,wParam,lParam) "Win32" = "SendMessageA"
'	Function webcam_FreeLibrary ( hnd:Int ) "Win32" = "FreeLibraryA"
'End Extern

Global webcam_GetActiveWindow:Int () "Win32"
Global webcam_SendMessage( hWnd,MSG,wParam,lParam) "Win32"
Global webcam_FreeLibrary ( hnd:Int ) "Win32"

user32 = LoadLibraryA ("user32.dll")

If user32 webcam_GetActiveWindow = GetProcAddress (user32, "GetActiveWindow")
If user32 webcam_SendMessage = GetProcAddress (user32, "SendMessageA")

kernel32 = LoadLibraryA ("kernel32.dll")

If kernel32 webcam_FreeLibrary = GetProcAddress (kernel32, "FreeLibrary")

Const WM_CAP_START = WM_USER

Const WM_CAP_SET_CALLBACK_ERROR = WM_CAP_START + 2
Const WM_CAP_SET_CALLBACK_STATUS = WM_CAP_START + 3
Const WM_CAP_SET_CALLBACK_YIELD = WM_CAP_START + 4
Const WM_CAP_SET_CALLBACK_FRAME = WM_CAP_START + 5
Const WM_CAP_SET_CALLBACK_VIDEOSTREAM = WM_CAP_START + 6
Const WM_CAP_SET_CALLBACK_WAVESTREAM = WM_CAP_START + 7

Const WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10
Const WM_CAP_DRIVER_GET_CAPS = WM_CAP_START + 14

Const WM_CAP_DLG_VIDEOFORMAT = WM_CAP_START + 41
Const WM_CAP_DLG_VIDEOSOURCE = WM_CAP_START + 42
Const WM_CAP_DLG_VIDEODISPLAY = WM_CAP_START + 43

Const WM_CAP_GET_VIDEOFORMAT = WM_CAP_START +44
Const WM_CAP_SET_VIDEOFORMAT = WM_CAP_START +45

Const WM_CAP_SET_PREVIEW = WM_CAP_START + 50
Const WM_CAP_SET_OVERLAY = WM_CAP_START + 51
Const WM_CAP_SET_PREVIEWRATE = WM_CAP_START + 52
Const WM_CAP_SET_SCALE = WM_CAP_START +53
Const WM_CAP_GET_STATUS = WM_CAP_START + 54

Const WM_CAP_SET_CALLBACK_CAPCONTROL = WM_CAP_START + 85


Type TWebcam
	Field  Handle:Int
	Field  DeviceID:Int
	Field  FrameRate:Int
	Field  LibHandle:Int
	Global Width:Int
	Global Height:Int
	Global PMWidth:Int
	Global PMHeight:Int
	Global Image:TPixmap 
	Field webcam_CreateCaptureWindow:Int (WName:Byte Ptr, Style:Int, X:Int, y:Int, w:Int, h:Int, ..
									  ParentWnd:Int, ID:Int) "Win32"
	
	Method New ()
		Image = CreatePixmap(16,16,PF_RGB888)
		FrameRate = 15
		Handle = Null
		DeviceID = -1
		' Get the library handle
		LibHandle = LoadLibraryA("AVICAP32.DLL")
		If Not LibHandle Then Throw "Can't load AVICAP32.DLL"
		
		' Get the Adress of the capCreateCaptureWindow function
		webcam_CreateCaptureWindow = GetProcAddress( LibHandle, "capCreateCaptureWindowA" ) 
'		If Not webcam_CreateCaptureWindow Then Throw "Can't get adress of capCreateCaptureWindowA"			
	End Method
	
	Method Delete ()
		DeInit()
		webcam_FreeLibrary(LibHandle)
		Image = Null
	End Method
	
	Method Init:Int (WHnd:Int, x:Int, y:Int, w:Int, h:Int)
		Local res:Int = False
		If (Handle <> Null) DeInit()
		DeviceID = -1
		Handle = Webcam_CreateCaptureWindow (Null, WS_VISIBLE+WS_CHILD, x, y, w, h, WHnd, 1)
		If (Handle <> Null)
			res = ConnectDevice()
			If (res) EnablePreviewMode(True)
			If (res) SetFrames(Framerate)			
		EndIf
		Return (res)
	End Method
	
	Method DeInit ()
		If (handle <> Null)
			DestroyWindow (Handle)
			Handle = Null			
		End If		
		DeviceID = -1
	End Method
	
	Method ConnectDevice:Int ()
		If (deviceID = -1)
  		  For Local i:Int = 0 To 9
			Local res:Int = Webcam_SendMessage(Handle, WM_CAP_DRIVER_CONNECT, i, 0)
			If (res <> 0)
			  DeviceID = i
			  Exit
			EndIf
		  Next
		EndIf
		Return (DeviceID <> -1)		
	End Method
	
	Method EnablePreviewMode (enable:Int)
		If (DeviceID <> -1)
			Webcam_SendMessage (Handle, WM_CAP_SET_PREVIEW, enable, 0)
		End If		
	End Method
	
	Method EnableOverlayMode (enable:Int)
		If (DeviceID <> -1)
			Webcam_SendMessage (Handle, WM_CAP_SET_OVERLAY, enable, 0)
		End If		
	End Method
	
	Method SetFrames (XFrames:Int)
		FrameRate = XFrames
		If (DeviceID <> -1)
			Webcam_SendMessage (Handle, WM_CAP_SET_PREVIEWRATE, FrameRate, 0)
		End If		
	End Method
	
	Method ShowSettings (nr:Int) 'use 0 to 2	
		If (DeviceID <> -1)
			Webcam_SendMessage (Handle, WM_CAP_DLG_VIDEOFORMAT+nr, 0, 0)
		End If		
	End Method
	
	Method SetScale (DoScale:Int)
		If (DeviceID <> -1)
			Webcam_SendMessage (Handle, WM_CAP_SET_SCALE, DoScale, 0)
		End If		
	End Method
	
	Method SetFrameCallbackRoutine ()
		If (DeviceID <> -1)		   
			Local Routine:Byte Ptr 
			Routine = FrameCallback
			Webcam_SendMessage (Handle, WM_CAP_SET_CALLBACK_FRAME, 0, Int(Routine))
		End If		
	End Method
	
	Method SetPMSize (w:Int, h:Int)
		PMWidth = w
		PMHeight = h
	End Method
	
	Method SetSize (w:Int, h:Int)
		Local res:Int = False
		If (DeviceID <> -1)		   
			' Get The size of the structure first
			Local size:Int = Webcam_SendMessage (Handle, WM_CAP_GET_VIDEOFORMAT, 0, Null)
			If (size > 0)
				' Get The Space for the Data
				Local Bank:TBank = CreateBank(size)
				Webcam_SendMessage (Handle, WM_CAP_GET_VIDEOFORMAT, size, Int(BankBuf(Bank)))
				'Manipulate the buffer
				Width  = PeekInt(Bank, 4)
				Height = PeekInt(Bank, 8)
				DebugLog "Width: "+Width+" Height: "+Height
				PokeInt(Bank, 4, w)
				PokeInt(Bank, 8, h)
				'Write it back
				res = Webcam_SendMessage (Handle, WM_CAP_SET_VIDEOFORMAT, size, Int(BankBuf(Bank)))
				If (res)
					Width  = w
					Height = h	
				End If
				Bank = Null
			End If			
		End If		
		Return(res)
	End Method
	
Function FrameCallback (lwnd:Int, lpVHdr:Byte Ptr)
	Local VideoHeader:TBank = CreateStaticBank(lpVHdr, 40)
	Local VideoMemoryAdress:Byte Ptr	= Byte Ptr(PeekInt(VideoHeader, 0))
	Local dwBytesUsed:Int				= PeekInt(VideoHeader, 4)	

	If (dwBytesUsed = (Width*Height*3)) ' 640 * 480 * 24bit
		Local TempMap:TPixmap = CreateStaticPixmap (VideomemoryAdress, Width, Height, Width*3,PF_BGR888)		
'		WebCamImage = LoadImage(TempMap)
		Image = YFlipPixmap(TempMap)
		If (PMWidth <> Width) Or (PMHeight <> Height)
			Image = ResizePixmap (Image, PMWidth,PMHeight)
		EndIf
	Else
		DebugLog "Wrong Picture Size. Expected "+Width+"/"+Height	
	End If
End Function
	
	
End Type

'rem 

' TEST
Graphics 800,600',0'32,60
Local whnd = Webcam_GetActiveWindow()
Local Webcam:TWebcam = New TWebcam
Local rot:Int

If (Webcam.Init(whnd, 0,0,640,480))
'	Webcam.ShowSettings(0)
	Webcam.SetFrames(30)
	Webcam.SetSize(320,240)
	Webcam.SetPMSize(800,600)
	Webcam.SetScale(False)
	Webcam.EnablePreviewMode(False)
	Webcam.EnableOverlayMode(False)
	Webcam.SetFrameCallbackRoutine()
	While Not KeyHit(key_escape)
		Cls 
		DrawPixmap (Webcam.Image, 0, 0)
		SetColor 255,255,255
		DrawText "Memory usage:"+MemAlloced(), 0,580
		Flip
		FlushMem
	Wend
Else
	RuntimeError ("Cant Initialize Webcam")	
End If
EndGraphics()
'end rem

Mirko

2005

I sorry that i did not notice that someone asked a question, but i not going to this code archiv page very often, as i know my code ;-)

I have a selfmade include file with all the needed routines an much more which i use in any of my applications, so i did not notice that i forgott to include some routines, sorry.

But James completed the code, as far as i can see.

Lukasha

2005

Hi,
I copied the code,
but it doesn't work.
There's only a black screen and if I close the program,
there's an error.
Did I make a mistake?

thx, Lukas Hauprich

MarkAM

2006

Discovered the problem. My camera only generates 12 BPP images ...... need to write conversion for different BPP modes (8,12,16,24 and 32) ... Will post updated code once completed.

Code Archives Forum