VBA+WebCAM 拍个照, 留个念吧!

时　间:2011-10-06 19:40:00
作　者:dbaseIIIer   ID：22003  城市：深圳
摘　要:VB能做什么一切都来自微软! 微软那么多人服待我们, 只是我们有没有真正被服待到!
正　文:

XP通用!
ME 和 Win7 都要用别的类库呢! 未找到! 啊! 示列而已, 自己玩玩@

Option Compare Database

Sub b()

Dim oWIA As WIALib.Wia
Dim d As WIALib.DeviceInfo
Dim wiaRoot As WIALib.Item
Dim wiaPics As WIALib.Collection
Dim wiaItem As WIALib.Item

Set oWIA = New WIALib.Wia

For Each d In oWIA.Devices
    If d.Type = "StreamingVideo" Then      ' <----- 如不筛选 StreamingVideo 是可以把 扫描仪也拿来用的
        Set wiaRoot = oWIA.Create(d.ID)    ' <----- 我只用第一个找到的摄像头, 有多的话 可以像QQ一样造个画面让人选用哪个摄像头

        Exit For
    End If
Next

'Set wiaPics = wiaRoot.GetItemsFromUI(UseCommonUI, ImageTypeColor)    '<---- 这是捕获 多张图片的
Set wiaPics = wiaRoot.GetItemsFromUI(SingleImage, ImageTypeColor)     '<---- 这是捕获 一张图片的

If wiaPics Is Nothing Then
Else
    For Each wiaItem In wiaPics
        If wiaItem.ItemType = "file;image" Then
            wiaItem.Transfer "C:\" & wiaItem.Name, False              '<----  只能保存的, 后面的 True/False 是否用Async保存即再用事件捕获已存好
                                                                      '<----  Access 不支持True 的呢
        End If
    Next
End If

End Sub

刚在网上找到 C#代码, 翻译过来的!

试过成功, 不过限制是只能在 XP下操作! 理论上在任何 VBA上都能执行.

原文在 http://www.codeproject.com/KB/dotnet/wiascriptingdotnet.aspx

Limitations

• Again, for Windows XP only! if you need .NET imaging for older systems, try this TWAIN sample
• Windows ME has an older version of WIA, but you can't use the same code/type-lib from these samples for that version.
• WIA devices must be fully detected and configured by Windows.
• As far as I know, WIA needs your app to have the [STAThread] attribute on the Main() method used to launch your application.
• Item.Thumbnail was left out as it uses an undocumented Asynchronous Pluggable Protocol (APP) and has bugs.
• Code was only tested with an Olympus digi-cam, an Epson scanner, a Logitech QuickCam, and a Sony DV CamCorder, 还有我的上网本

啊, 记得引用  "Microsoft Windows Image Acquisition 1.01 Type Library" (wiascr.dll) 啊!

原文内还有使用 WIAVideo类库 的, 可是我试过, 并不能在 Access的窗体内让这控件播放 Video,

wiaVideo = new WiaVideoClass();
wiaVideo.CreateVideoByWiaDevID( wiaDeviceID, window.Handle, 0, 1 );

转为

Dim wiaVideo As WIAVIDEOLib.WiaVideo

Dim oWIA As WIALib.Wia

set wiaVideo = New WIAVIDEOLib.WiaVideo

set oWIA = New WIALib.Wia

wiaVideo.CreateVideoByWiaDevID oWIA.Devices(0).ID), me.Hwnd, 0, 1

会报错  "Visual Basic 不支持的 自动化 (Automation) 错误!"