VFP 愛用者社區

hanychen · 註冊時間: 2003-12-10 文章: 14 第 1 樓

如題..

syntech · 發表於: 星期四八月 14, 2008 8:27 am 文章主題:

看看有沒有提供VB 範例及 ACTIVE X 物件,
否則機會很低

nelsonchuang · 發表於: 星期四八月 14, 2008 9:09 am 文章主題:

http://www.shrinkwrapvb.com/ezvidcap.htm
我沒用過,不過看樣子是可行~
另外
http://fox.wikis.com/wc.dll?Wiki~VideoCaptureApi~VFP
引用文章出處:
http://www.news2news.com/vfp/?example=437

程式內容如下(我也沒試過)

(使用設備為:USB cameras Logitech QuickCam Pro 4000 及 Dimera 350C)
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.
hWindow=0
hCapture=0
capWidth=0
capHeight=0
capOverlay=0

ADD OBJECT cmdGetFrame As CommandButton WITH Default=.T.,;
Left=15, Top=264, Height=27, Width=90, Caption="Get Frame",;
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=250, 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
ENDIF

PROCEDURE Destroy
THIS.ReleaseCaptureWindow

PROCEDURE cmdClose.Click
ThisForm.Release

PROCEDURE cmdGetFrame.Click
ThisForm.GetFrame

PROCEDURE cmdPreview.Click
ThisForm.StartPreview

PROCEDURE GetFrame
THIS.msg(WM_CAP_GRAB_FRAME, 0,0)

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)

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)), Cool

+;
BitLShift(Asc(SUBSTR(lcBuffer, 3,1)), 16) +;
BitLShift(Asc(SUBSTR(lcBuffer, 4,1)), 24)
&&-------------------------------------------------------------------
如果程式可用,煩請回文告知,以回饙其他Vfp使用者,謝謝~

garfield · 發表於: 星期四八月 14, 2008 9:40 am 文章主題:

去 http://www.twain.org/ 下載 TWAIN Developers Toolkit
可能可以用吧

215001 · 註冊時間: 2003-06-11 文章: 393 第 5 樓

以前試過可以. 可參考 "Visual Basic 範例集" 文魁楊倉杰編著

1.先建立表單
ShowWindow=2 && 頂層表單 (因為影像要放在本Form,故須取得 hwnd )
load 事件:
Declare integer SendMessage in user32 integer,integer,Integer, integer && hwnd,指令,參數1,參數2
Declare integer capCreateCaptureWindow in avicap32 string,integer,integer,integer,integer,integer,integer,integer
Declare integer GetForegroundWindow in user32

public xhwnd && CCD 視窗的 hwnd
xhwnd=0

2.建立按鈕: 啟動攝影機:
local wno
WNo = GetForegroundWindow() && 取得本form 的 hwnd
xhwnd=capcreatecapturewindow( "我的攝影機",0x40000000+0x10000000,0,0,640,480,wno , 0 ) && 建立CCD 子視窗,並傳回hwnd
&& 視窗標題 ,子視窗+顯示 ,x,y,width,height,目前form hwnd, 0
retval=sendmessage( xhwnd,0x400+10,0,0) && 將CCD裝置連接到 CCD視窗 && hwnd,連接指令,裝置代號(內定0),0 -9
if retval=0
messagebox( "連接失敗")
return
endif

**retval=sendmessage( xhwnd,0x400+14,len(Caps),Caps) && 傳回CCD的最大能力 (Caps 為結構型變數,故不執行本列)
retval=sendmessage( xhwnd,0x400+52,66,0) && 設定每毫秒預視速率rate 15 FPS
retval=sendmessage( xhwnd,0x400+50,1,0) && 啟動攝影機開始預視

3.建立按鈕: 結束
retval=sendmessage( xhwnd,0x400+11,0,0) && 取消CCD裝置連接
thisform.release

garfield · 發表於: 星期四八月 14, 2008 12:15 pm 文章主題:

哇!
真的可以用,
謝謝 215001

nelsonchuang · 發表於: 星期四八月 14, 2008 1:03 pm 文章主題:

讓我們高呼三聲:
萬歲,萬歲,萬萬歲~

215001 · 註冊時間: 2003-06-11 文章: 393 第 8 樓

參考 "Visual Basic 範例集" 文魁楊倉杰編著

可於表單再加上幾個按鈕,可做的功能就多樣了

1.建立按鈕: 影像控制
retval=sendmessage( xhwnd,0x400+42,0,0) && 會開啟影像控制視窗(可變更影像來源及設定彩色/黑白,亮度,對比...)

2.建立按鈕: 壓縮比
retval=sendmessage( xhwnd,0x400+46,0,0) && 會開啟視訊壓縮視窗(可壓縮的格式依所安裝過的影像程式而有不同)

3.建立按鈕: 影像格式
retval=sendmessage( xhwnd,0x400+41,0,0) && 會開啟影像格式視窗(可設定解析度640*480,RGB24 等.....)

4.建立按鈕: 照相存檔(存成BMP 檔)
retval=sendmessage( xhwnd,0x400+60,0,0) && 先凍結畫面
Declare integer SendMessage in user32 integer,integer,Integer, string && 因需傳字串參數,故重新宣告Sendmessage
retval=sendmessage( xhwnd,0x400+25,0,"1214.bmp") && 影像儲存到指定的檔名
messagebox("已經存檔: 1214.bmp" )
Declare integer SendMessage in user32 integer,integer,Integer, integer && 恢復正常的Sendmessage 宣告
retval=sendmessage( xhwnd,0x400+50,1,0) && 解除凍結畫面,恢復預視

5.建立按鈕: 開始錄影(存成AVI檔內定為C:\Capture.avi )
local xpara2
Declare integer SendMessage in user32 integer,integer,Integer, string@ xpara=repl( chr(0),4*24) 因需傳結構型字串參數,故重新宣告Sendmessage
* 以字串傳送結構型參數
* 例: chr(1)+chr(2)+chr(3)+chr(4) 代表 1 + 2*256 + 3*256*256 + 4*256*256*256=67305985 長整數 (long)
xpara2=chr(0)+chr(0)+chr(1)+chr(0) ; && 65536 麥克風取樣頻率 int(1000000/15)
+chr(1)+chr(0)+chr(0)+chr(0) ; && 是否先出現 "開始錄影" 之對話框 1是/0否
+chr(10)+chr(0)+chr(0)+chr(0) ; &&
+chr(0)+chr(0)+chr(0)+chr(0) ; &&
+chr(40)+chr(35)+chr(0)+chr(0) ; && 9000 = 15分 *60秒/分 *10張/秒
+chr(0)+chr(0)+chr(0)+chr(0) ; &&
+chr(0)+chr(0)+chr(0)+chr(0) ; &&
+chr(32)+chr(0)+chr(0)+chr(0) ; &&
+chr(1)+chr(0)+chr(0)+chr(0) ; && 是否錄聲音
+chr(4)+chr(0)+chr(0)+chr(0) ; &&
+chr(0)+chr(0)+chr(0)+chr(0) ; && 按鍵是否可結束錄影 (?)
+chr(1)+chr(0)+chr(0)+chr(0) ; && 按滑鼠左鍵是否可結束錄影
+chr(1)+chr(0)+chr(0)+chr(0) ; && 按滑鼠右鍵是否可結束錄影
+chr(1)+chr(0)+chr(0)+chr(0) ; && 是否指定錄影秒數
+chr(5)+chr(0)+chr(0)+chr(0) ; && 指定要錄影的秒數
+chr(0)+chr(0)+chr(0)+chr(0) ; &&
+chr(0)+chr(0)+chr(0)+chr(0) ; &&
+chr(0)+chr(0)+chr(0)+chr(0) ; &&
+chr(0)+chr(0)+chr(0)+chr(0) ; &&
+chr(0)+chr(0)+chr(0)+chr(0) ; &&
+chr(0)+chr(0)+chr(0)+chr(0) ; &&
+chr(0)+chr(0)+chr(0)+chr(0) ; &&
+chr(1)+chr(0)+chr(0)+chr(0) ; &&
+chr(0)+chr(0)+chr(0)+chr(0) &&
retval=sendmessage( xhwnd,0x400+64,4*24,@xpara2) && 傳送錄影基本設定結構參數長度4*24

Declare integer SendMessage in user32 integer,integer,Integer, integer && 恢復正常的Sendmessage 宣告
retval=sendmessage( xhwnd,0x400+62,0,0) && 開始錄影 (可按滑鼠左鍵,右鍵結束錄影)
messagebox("已經錄影存檔 C:\Capture.avi" )

nelsonchuang · 發表於: 星期四八月 14, 2008 1:48 pm 文章主題:

題外話,我家有那個外接視訊卡,就是有接攝影鏡頭+Cable的那種
也搞得定嗎?或著是根本就要視訊卡的專用Driver?

tccvincent · 註冊時間: 2003-05-26 文章: 54 來自: TAIPEI 第 10 樓

vfp6 好像不能用耶

kib48660 · 註冊時間: 2003-02-24 文章: 121 第 11 樓

您可以用 ezVidC60.ocx 直接加到您的程式就可以,WEBCAM不會有影像延遲的問題,但用電視卡(來源可選CABLE或S端子),就會有影像延遲的問題,還找不到解決方法

hanychen · 註冊時間: 2003-12-10 文章: 14 第 12 樓

vfp 9.0 所有功能都可以用~~

但如果要把它做成安裝檔, 需要加入那些檔案一起包裝

mp484 · 註冊時間: 2006-08-08 文章: 84 第 13 樓

請問如果有兩台Webcam在同一台電腦時，有辦法由程式指定使用哪一個嗎？

用意：一個正在做視訊，另一個可以當成錄影設備

有誰知道呢？