Webcam to picturebox

Smileon
01-12-2005, 01:12 AM
Hi!

I have this problem. I use a video for windows interface to get my video playing in VB6. Then there is a GrabFrame function that fills an Byte array with the data. But now I would like to display this data as a picture... Any ideas on how to do this pretty FAST. As I would like to do this at least once per second, plus do some serious calculations on the image data...

Thank you in advance!!

Smiley

GregDuncan
01-12-2005, 01:33 AM
Option Explicit
'This code sourced from http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=29004&lngWId=1

Private Declare Function CreateStreamOnHGlobal Lib "ole32" (ByVal hGlobal As Long, ByVal fDeleteOnRelease As Long, ppstm As Any) As Long
Private Declare Function OleLoadPicture Lib "olepro32" (pStream As Any, ByVal lSize As Long, ByVal fRunmode As Long, riid As Any, ppvObj As Any) As Long
Private Declare Function CLSIDFromString Lib "ole32" (ByVal lpsz As Any, pclsid As Any) As Long
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)

Public Function PictureFromByteStream(b() As Byte) As IPicture
Dim LowerBound As Long
Dim ByteCount As Long
Dim hMem As Long
Dim lpMem As Long
Dim IID_IPicture(15)
Dim istm As stdole.IUnknown

On Error GoTo Err_Init
If UBound(b, 1) < 0 Then
Exit Function
End If

LowerBound = LBound(b)
ByteCount = (UBound(b) - LowerBound) + 1
hMem = GlobalAlloc(&H2, ByteCount)
If hMem <> 0 Then
lpMem = GlobalLock(hMem)
If lpMem <> 0 Then
MoveMemory ByVal lpMem, b(LowerBound), ByteCount
Call GlobalUnlock(hMem)
If CreateStreamOnHGlobal(hMem, 1, istm) = 0 Then
If CLSIDFromString(StrPtr("{7BF80980-BF32-101A-8BBB-00AA00300CAB}"), IID_IPicture(0)) = 0 Then
Call OleLoadPicture(ByVal ObjPtr(istm), ByteCount, 0, IID_IPicture(0), PictureFromByteStream)
End If
End If
End If
End If

Exit Function

Err_Init:
If Err.Number = 9 Then
'Uninitialized array
MsgBox "You must pass a non-empty byte array to this function!"
Else
MsgBox Err.Number & " - " & Err.Description
End If
End Function

Smileon
01-13-2005, 11:34 PM
Thanx Greg!
Your code was pretty helpfull, but in the end I finished with Get/SetDIBits function

lazerfisk
01-15-2005, 06:41 AM
Hey :) Could i by any chance have a look at your webcam sourcecode? That would be great.

Cheers,
Christopher

Smileon
01-16-2005, 12:31 AM
Well actualy it is not mine... It's a free code from the web...
I can give it to you, but it's quite long and I dont know how to...

Hey :) Could i by any chance have a look at your webcam sourcecode? That would be great.

Cheers,
Christopher

lazerfisk
01-16-2005, 11:31 AM
Put it all together in a zip-file and upload it with a post as an attachment :)

Cheers,
Christopher

EZ Archive Ads Plugin for vBulletin Copyright 2006 Computer Help Forum