Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Video capture

Status
Not open for further replies.

SytzedeBoer

Programmer
Apr 1, 2013
15
NZ
I have a small application that needs to capture a photo.
I've seen reference to this on this forum, especially Mike Lewis, but I'll be darned if I can get it to work to my satisfaction.
Most references involve AVICAP32.DLL

On my Lenovo X1 Carbon laptop it is 100% satisfactory and works a treat.

On several other devices WITH BUILT IN CAMERAS it is not working and the message pops up: "Using Video Capture: failed to connect"

On all these devices I CAN take photos if I click the windows button, and type camera.
i.e. the camera pops up and I can take a photo

At this stage I am desperate and willing to try anything.
Is there anyone who can help and make some suggestions?
I just want to take a photo, rename or copy it to a folder of my choosing.
 
Mike, I really appreciate your response.

Here is my code

Local oForm
oForm = Createobject("Tform")
oForm.Show(1)
* end of main

Define Class Tform As Form
#Define WM_CAP_START 0x0400
#Define WM_CAP_DRIVER_CONNECT (WM_CAP_START+10)
#Define WM_CAP_DRIVER_DISCONNECT (WM_CAP_START+11)
#Define WM_CAP_DRIVER_GET_CAPS (WM_CAP_START+14)
#Define WM_CAP_SET_PREVIEW (WM_CAP_START+50)
#Define WM_CAP_SET_OVERLAY (WM_CAP_START+51)
#Define WM_CAP_SET_PREVIEWRATE (WM_CAP_START+52)
#Define WM_CAP_GET_STATUS (WM_CAP_START+54)
#Define WM_CAP_GRAB_FRAME (WM_CAP_START+60)

Width=340
Height=310
AutoCenter=.T.
Caption="Using Video Capture"
MinButton=.F.
MaxButton=.F.
ShowWindow=1
WindowType=1

hWindow=0
hCapture=0
capWidth=0
capHeight=0
capOverlay=0

Add Object cmdGetFrame As CommandButton With ;
Left=15, Top=264, Height=27, Width=90, Caption="Take Photo",;
Enabled=.F.

Add Object cmdPreview As CommandButton With Default=.T.,;
Left=106, Top=264, Height=27, Width=100, Caption="Preview Video",;
Enabled=.F.

Add Object cmdClose As CommandButton With Cancel=.T.,;
Left=207, Top=264, Height=27, Width=70, Caption="Close"

Procedure Activate
If This.hWindow = 0
Declare Integer GetFocus In user32
This.hWindow = GetFocus()
This.CreateCaptureWindow
This.DriverConnect
This.cmdPreview.Click
Endif

Procedure Destroy
This.ReleaseCaptureWindow

Procedure cmdClose.Click
Thisform.Release

Procedure cmdGetFrame.Click
Thisform.GetFrame

Procedure cmdPreview.Click
Thisform.StartPreview

Procedure GetFrame
#Define WM_CAP_FILE_SAVEDIB (WM_CAP_START + 25)

Local lcFile
lcFile = "c:\temp\sample.bmp"

This.msg(WM_CAP_GRAB_FRAME, 0,0)
This.msg(WM_CAP_FILE_SAVEDIB, 0, lcFile,1)

Procedure CreateCaptureWindow
#Define WS_CHILD 0x40000000
#Define WS_VISIBLE 0x10000000

Declare Integer capCreateCaptureWindow In avicap32;
STRING lpszWindowName, Long dwStyle,;
INTEGER x, Integer Y,;
INTEGER nWidth, Integer nHeight,;
INTEGER hParent, Integer nID

This.hCapture = capCreateCaptureWindow("",;
WS_CHILD+WS_VISIBLE,;
10,8,320,240, This.hWindow, 1)

***********************************
*WAIT a while
Declare Integer GetTickCount In WIN32API
IniTime = GetTickCount()
Do While GetTickCount() < (IniTime + 2000)
DoEvents
Enddo


*******************************************
Procedure DriverConnect
This.msg(WM_CAP_DRIVER_CONNECT, 0,0)
If This.IsCaptureConnected()
This.GetCaptureDimensions

Store .T. To This.cmdGetFrame.Enabled,;
This.cmdPreview.Enabled

This.Caption = This.Caption + ": connected, " +;
LTRIM(Str(This.capWidth)) + "x" +;
LTRIM(Str(This.capHeight))
Else
This.Caption = This.Caption + ": failed to connect"
Endif

Procedure DriverDisconnect
This.msg(WM_CAP_DRIVER_DISCONNECT, 0,0)

Procedure ReleaseCaptureWindow
If This.hCapture <> 0
This.DriverDisconnect
Declare Integer DestroyWindow In user32 Integer HWnd
= DestroyWindow(This.hCapture)
This.hCapture = 0
Endif

Procedure msg(msg, wParam, Lparam, nMode)
If This.hCapture = 0
Return
Endif

If Vartype(nMode) <> "N" Or nMode=0
Declare Integer SendMessage In user32;
INTEGER HWnd, Integer Msg,;
INTEGER wParam, Integer Lparam
= SendMessage(This.hCapture, msg, wParam, Lparam)
Else
Declare Integer SendMessage In user32;
INTEGER HWnd, Integer Msg,;
INTEGER wParam, String @Lparam
= SendMessage(This.hCapture, msg, wParam, @Lparam)
Endif

Function IsCaptureConnected
* analyzing fCaptureInitialized member of the CAPDRIVERCAPS structure
#Define CAPDRIVERCAPS_SIZE 44
Local cBuffer, nResult
cBuffer = Repli(Chr(0),CAPDRIVERCAPS_SIZE)
This.msg(WM_CAP_DRIVER_GET_CAPS, Len(cBuffer), @cBuffer, 1)
This.capOverlay = buf2dword(Substr(cBuffer,5,4))
nResult = Asc(Substr(cBuffer, 21,1))
Return (nResult<>0)

Procedure GetCaptureDimensions
* reading uiImageWidth and uiImageHeight members
* of the CAPSTATUS structure
#Define CAPSTATUS_SIZE 76
Local cBuffer
cBuffer = Repli(Chr(0), CAPSTATUS_SIZE)
This.msg(WM_CAP_GET_STATUS, Len(cBuffer), @cBuffer, 1)
This.capWidth = buf2dword(Substr(cBuffer,1,4))
This.capHeight = buf2dword(Substr(cBuffer,5,4))

Procedure StartPreview
This.msg(WM_CAP_SET_PREVIEWRATE, 30,0)
This.msg(WM_CAP_SET_PREVIEW, 1,0)
If This.capOverlay <> 0
This.msg(WM_CAP_SET_OVERLAY, 1,0)
Endif

Procedure StopPreview
This.msg(WM_CAP_SET_PREVIEW, 0,0)
Enddefine

Function buf2dword(lcBuffer)

Return Asc(Substr(lcBuffer, 1,1)) + ;
BitLShift(Asc(Substr(lcBuffer, 2,1)), 8) +;
BitLShift(Asc(Substr(lcBuffer, 3,1)), 16) +;
BitLShift(Asc(Substr(lcBuffer, 4,1)), 24)
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top