使用環境:
パソコン10台 OS:Windows XP Pro(SP3)
DirectX Ver9.0C
パソコン10台 OS:Windows2000(SP4)
DirectX Ver9.0C
USBカメラはLogicoolのQcam Connect(型番QVP-61)
開発言語:
VB6(SP5)
仕様:
コマンドボタン1押下で、サブルーチン「USBCamera起動」→
「USBCamera描画」を実行してPicture1に静止画像を写す。
不具合発生:
Windows XP Pro(SP3)のパソコン10台の内8台が
サブルーチン「USBCamera描画」のbv.GetCurrentImage sz * 4, img(0)で
オートメーションエラーが発生します。
Windows XP Pro(SP3)のパソコン2台とすべてのWin2kでは正常に
実行します。
GetCurrentImageメソッドを実行すると
「実行時エラー '-2147467259 (80004005)':
オートメーションエラーです。
エラーを特定できません」
となります。
windows2000では問題なくスナップショットがとれていたのでコードが
間違ってはいないと思います。エラーの原因が分かりませんでしょうか。
よろしくご教授をお願いいたします。
Private Sub USBCamera起動()
Set mGraph = New FilgraphManager
'キャプチャフィルタを探してグラフに追加
Dim regflt As IRegFilterInfo
Dim flt As IFilterInfo
For Each regflt In mGraph.RegFilterCollection
If regflt.Name = "Logicool Qcam IM/Connect" Or _
UCase(regflt.Name) = "LOGICOOL QCAM IM/CONNECT" Then 'カメラ固有のフィルタ名
regflt.Filter flt
Exit For
End If
Next
'グラフ作成
Dim pp As IPinInfo
flt.Pins.Item 0, pp
pp.Render
'PictureBoxのサイズを変更
Dim bv As IBasicVideo
Dim vx As Long, vy As Long
Me.ScaleMode = vbPixels
Set bv = mGraph
bv.GetVideoSize vx, vy
With Picture1
'.BorderStyle = 0
'.Move 0, 0, vx, vy
.AutoRedraw = True
End With
'ビデオレンダラウィンドウを隠す
Dim vw As IVideoWindow
Set vw = mGraph
vw.Owner = Me.hwnd
vw.SetWindowPosition -vx, -vy, vx, vy
'カメラ起動&再生
mGraph.Run
End Sub
Private Sub USBCamera描画()
On Error GoTo Err_USBCamera
'ビデオサイズ取得
Dim bv As IBasicVideo
Dim vx As Long, vy As Long
Set bv = mGraph
bv.GetVideoSize vx, vy
'グラフを一時停止させる
mGraph.Pause
'ビットマップ読み込み
Dim sz As Long
Dim img() As Long
sz = 10 + vx * vy
ReDim img(sz - 1)
bv.GetCurrentImage sz * 4, img(0)
'グラフを再開させる
mGraph.Run
'描画準備
Dim bi As BITMAPINFOHEADER
With bi
.biSize = Len(bi)
.biWidth = vx
.biHeight = vy
.biPlanes = 1
.biBitCount = 32
End With
'描画
SetDIBitsToDevice Picture1.hdc, 0, 0, vx, vy, 0, 0, 0, vy, img(0), bi, 0
Picture1.Refresh
End Sub
Bitmap をあらわすバイナリのサイズが正しくないからでは。
で、マルチポストはいろいろ問題を生じやすいので、質問箇所は
どちらかにしてください。片方で有効な回答を得られなかった
場合には、そこにその旨を記した上で、他所でも元の箇所への
言及して投稿するとか。
マルチポストすいませんでした。
Bitmapのバイナリサイズとはどこのことでしょうか？
Dim文にあやまりがあるのでしょうか？
使用するフィルタによっては、GetCurrentImage の第1引数に適切な値が
指定されていないと呼び出しが失敗します。適切な値は、タイプライブラリを
自作するなどすれば、
Dim iLength As Long
' ...
iLength = 0&
Call bv.GetCurrentImage(iLength, ByVal 0&)
ReDim img(0& To iLength - 1&) As Byte
Call bv.GetCurrentImage(iLength, bv(0&))
のように呼び出せますが、標準のタイプライブラリを使う限りはできません。
# まぁ、迂回策もありますけど。
とりあえず、前の投稿とか、その辺りが全部始末を付けたとみなせたら、
その先を投稿するかも知れません。