Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Taking image from webcam
Message
 
To
26/01/2023 06:43:49
General information
Forum:
Visual FoxPro
Category:
Windows API functions
Miscellaneous
Thread ID:
01685912
Message ID:
01685970
Views:
82
This message has been marked as the solution to the initial question of the thread.
Likes (1)
>Hi!
>
>>http://www.ml-consult.co.uk/foxst-29.htm
>
>This uses TWAIN interface. Twain drivers are no more shipped with windows. Dragan wrote in this thread that TWAIN in obsolete.
>Is TWAIN recommended method to take photo when creating new application? Will it require special driver installation in every workstation? Does usual webcams have TWAIN drivers?

Perhaps this
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)
Previous
Next
Reply
Map
View

Click here to load this message in the networking platform