Code archives/Graphics/Webcam-class for Windows

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

Download source code

Webcam-class for Windows by Mirko
(Posted 21 years ago)
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