GetCurrentImageメソッドを実行するとオートメーションエラーとなります。

渡辺 2009-03-09 22:06:54 No: 101599

使用環境:
パソコン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

K.J.K. 2009-03-10 02:35:33 No: 101600

Bitmap をあらわすバイナリのサイズが正しくないからでは。

で、マルチポストはいろいろ問題を生じやすいので、質問箇所は
どちらかにしてください。片方で有効な回答を得られなかった
場合には、そこにその旨を記した上で、他所でも元の箇所への
言及して投稿するとか。

WATA 2009-03-10 03:58:04 No: 101601

マルチポストすいませんでした。
Bitmapのバイナリサイズとはどこのことでしょうか？
Dim文にあやまりがあるのでしょうか？

K.J.K. 2009-03-10 06:03:10 No: 101602

使用するフィルタによっては、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&))

のように呼び出せますが、標準のタイプライブラリを使う限りはできません。
# まぁ、迂回策もありますけど。

とりあえず、前の投稿とか、その辺りが全部始末を付けたとみなせたら、
その先を投稿するかも知れません。