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

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

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

←解決時は質問者本人がここをチェックしてください。

戻る