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 SkipVought 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
0
0
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