初めまして。
突然の質問で失礼とは思いますが、どうしても分からず、お教えしていただきたいと思い、投稿させて頂きました。
宜しければご回答をお願い致します。
私は今、VisualBASIC6.0(SP3)を使用しています。
マルチメディアコントロールでAVIファイルの特定フレームをBMP（JPGでもよい）で保存、それと、PictureコントロールにPictureとして表示をさせたいのです。
今は下のような状態です。
Private Sub Command1_Click()
MMControl1.Command = "Plev"
MMControl1.Command = "Step"
Picture2.Picture = Picture1.Image
End Sub
Private Sub Form_Load()
MMControl1.DeviceType = "AVIVideo"
MMControl1.FileName = "Download.avi" '試し用のAVIファイル
MMControl1.hWndDisplay = Picture1.hWnd
MMControl1.Command = "Open"
MMControl1.Frames = 1
End Sub
4行目の「Picture2.Picture = Picture1.Image」はPicture1の画像をPicture2に写しはするのですが、AVIファイルのフレームは画面に表示されているにも関わらず、全く写してくれません。
Picture1に表示しているAVIファイルのフレームをPicture2にPictureとして表示させて、その上で保存させたいのですが、何か良い方法はないでしょうか？
説明が分かりにくいとは思いますが、上手に説明ができず、申し訳ないのですが、ご回答をよろしくお願い致します。
MMCのhWndDisplayにPictureBoxを指定しても
動画が「PictureBoxに描画」されるわけではなくて
「PictureBoxの中の(勝手に作られる)別ウィンドウに描画」されるんです。
そのウィンドウはPictureBoxではないので
4行目のような感じで簡単に静止画を取得することは無理ですね。
画面に表示されている動画のイメージを取得するのは
環境にもよりますが基本的には無理だと思います。
(PaintPictureやBitbltでも取得不可能です)
環境にもよると思いますが、BitBltで可能な様ですね。
編集 削除＞黒猫トラさん、NaClさん
ご回答、どうもありがとうございます。
お返事が遅れてしまい、失礼しました。
黒猫トラさんのお陰で理由が良く分かりました。
PictureBoxに表示しているわけではないのですね。
NaClさんのご回答では、BitBltで可能かも知れないと言うことですが、どうなのでしょうか？
もし、宜しければお教えいただけないでしょうか？
それと、何度も質問するようで申し訳ないのですが、もう一つだけお願いします。
黒猫トラさんのご回答では、画面に表示されている動画のイメージを取得するのは無理と言うことですが、イメージを表示せずにBMPなどで特定のフレームを保存することなどはできませんでしょうか？
質問を増やしてしまい、大変に恐縮ですが、ご回答をよろしくお願い致します。
> NaClさんのご回答では、BitBltで可能かも知れないと言うことですが、どうなのでしょうか？
> もし、宜しければお教えいただけないでしょうか？
PrintScreenキーなどで(動画部分の)イメージがコピー＆ペーストできる環境なら
できるかもしれません。
> 画面に表示されている動画のイメージを取得するのは無理と言うことですが、
> イメージを表示せずにBMPなどで特定のフレームを保存することなどはできませんでしょうか？
DirectShowのMediaDetオブジェクトにあるWriteBitmapBitsメソッドを使えば
動画ファイル中の任意の位置のイメージ（ポスターフレーム）をBMPファイルに出力することができます。
動画の再生もDirectShowで行う必要がありますのでちょっと大変かもしれませんが、
DirectX8のSDKにサンプルがあります。
（私はDirectShowならちょっとわかりますがMMCがよくわかってませんｗ
だって環境によってよくフリーズするんだもん＞MMC）
> BitBltで可能かも知れないと言うことですが
MMControlは使った経験が無いので、詳しいことはわかりませんが、
ミューズさんのソースに少し手を入れてみました。
Picture表示後、BMP保存してみてください。
この場合、Picture1からフレームサイズが得られないので、PictureBox
のサイズにしました。これだと、BMPファイルのサイズに影響しますね。
（AVIFileInfo()APIを使用すれば、フレームサイズが得られます。）
Option Explicit
Private Declare Function BitBlt Lib "gdi32" _
(ByVal hDestDC As Long, ByVal x As Long, _
ByVal y As Long, ByVal nWidth As Long, _
ByVal nHeight As Long, ByVal hSrcDC As Long, _
ByVal xSrc As Long, ByVal ySrc As Long, _
ByVal dwRop As Long) As Long
Private Sub Form_Load()
MMControl1.DeviceType = "AVIVideo"
MMControl1.FileName = "Download.avi" '試し用のAVIファイル
MMControl1.hWndDisplay = Picture1.hWnd
MMControl1.Command = "Open"
MMControl1.Frames = 1
Picture1.AutoRedraw = False
With Picture2
.AutoRedraw = True
.Width = Picture1.Width
.Height = Picture1.Height
End With
End Sub
Private Sub Form_Unload(Cancel As Integer)
MMControl1.Command = "Close"
End Sub
Private Sub Command1_Click()
MMControl1.Command = "Plev"
MMControl1.Command = "Step"
With Picture2
.Picture = LoadPicture()
Call BitBlt(.hDc, 0, 0, _
.ScaleWidth / Screen.TwipsPerPixelX, _
.ScaleHeight / Screen.TwipsPerPixelY, _
Picture1.hDc, 0, 0, vbSrcCopy)
.Picture = .Image
End With
End Sub
Private Sub Command2_Click()
SavePicture Picture2.Image, App.Path & _
"\frame" & MMControl1.Position & ".bmp"
End Sub
> イメージを表示せずにBMPなどで特定のフレームを保存する
avifil32.dllのAPIを駆使すれば可能ですが、かなり面倒です。
昔、どこかのサイトのサンプルを参考にして、VB6で作った憶え
があるんですが、思い出せない。
>avifil32.dllのAPIを駆使すれば可能ですが、かなり面倒です。
>昔、どこかのサイトのサンプルを参考にして、VB6で作った憶え
>があるんですが、思い出せない。
私もVB6でAVIの処理をやったことがあって、以前このサイトにも
サンプルを書いたことがあった気がしますが、確かに結構面倒で
す。が、環境に依存しにくい、という利点はあるかも。
ちょっと今VB6のサンプルは手元にないんですが、Cで書いたもの
なら以下にあります。ほとんどAPIを呼び出しているだけなので、
APIの宣言とバッファの確保さえすればVB6でも同じ流れで出来た
はず。
http://www.sm.rim.or.jp/~shishido/aviframe.html
DIBさえ得られれば、後はそれにBITMAPFILEHEADERをつけてファイル
に保存しBMPを作ることも、またデバイスコンテキストに描画して
表示することも出来ます。
横レスです。素人です。初心者です。わずらわしく思われたら無視してください。
興味があってNaClさんの方法で確認しました。
Call BitBlt(・・・・)で、みごとにできました。
ただ私の場合、
なんのお役には立たないかもわかりませんが似たようなことをやった
ことがあります。
自分の場合はＵＳＢカメラの画像をPicture1に表示・コマンドボタン
のイベントでPicture2にクリップボード経由で貼付けて
SavePicture Picture2.Image, "X:\xxxx.bmp"で保存できています。
>動画が「PictureBoxに描画」されるわけではなくて
>「PictureBoxの中の(勝手に作られる)別ウィンドウに描画」されるんです。
っていうことなので、「別ウインドウ」のハンドルが取得できればクリップボード経由でPicture2に貼り付けることができるのではないでしょうか。
＞黒猫トラさん、NaClさん、宍戸輝光さん、年寄りの冷や水さん
大変参考になりました。
お教えしていただいたやり方、色々と試してみたいと思います。
一つ一つに対してコメントしたいのですが、長くなってしまい、掲示板に書くには不適切と思われますので、割愛させてください。
皆様、親切にご回答いただき、本当にどうもありがとうございました。
頑張ってプログラミングしていきます。
> イメージを表示せずにBMPなどで特定のフレームを保存する
http://www.mapletown.net/~nekora/soft/howto/avi.html
第２章 ＡＶＩファイルからビットマップを取り出す
のサンプルを参考にして、VB6で作ってみました（時間が空いたんで）。
Formに、Picture1, Command1, Command2の各コントロールを貼って下さい。
'// フォームモジュール
Option Explicit
Private Sub Command1_Click()
Dim szAviFile As String
Dim iFrame As Long
Dim szBmpFile As String
szAviFile = "AVIファイルのフルパス名"
iFrame = 0
szBmpFile = App.Path & "\test.bmp"
If (Dir(szBmpFile) <> "") Then Kill szBmpFile
Call AviToBmp(szAviFile, iFrame, szBmpFile)
End Sub
Private Sub Command2_Click()
On Error Resume Next
Picture1.Picture = LoadPicture(App.Path & "\test.bmp")
End Sub
'// 標準モジュール
Option Explicit
Private Type BITMAPFILEHEADER
bfType As Integer
bfSize As Long
bfReserved1 As Integer
bfReserved2 As Integer
bfOffBits As Long
End Type
Private Type BITMAPINFOHEADER
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type
Private Const BI_RGB As Long = 0
Private Const AVIERR_OK As Long = 0
Private Declare Sub AVIFileInit Lib "avifil32.dll" ()
Private Declare Sub AVIFileExit Lib "avifil32.dll" ()
Private Declare Function AVIFileOpen Lib "avifil32.dll" _
(ByRef ppfile As Long, ByVal szFile As String, _
ByVal uMode As Long, ByVal pclsidHandler As Long) As Long
Private Const OF_READ As Long = &H0
Private Const OF_SHARE_DENY_NONE As Long = &H40
Private Declare Function AVIFileRelease Lib "avifil32.dll" _
(ByVal pfile As Long) As Long
Private Declare Function AVIFileGetStream Lib "avifil32.dll" _
(ByVal pfile As Long, ByRef ppaviStream As Long, _
ByVal fccType As Long, ByVal lParam As Long) As Long
Private Const streamtypeVIDEO As Long = 1935960438
Private Declare Function AVIStreamRelease Lib "avifil32.dll" _
(ByVal pavi As Long) As Long
Private Declare Function AVIStreamGetFrameOpen Lib "avifil32.dll" _
(ByVal pAviStream As Long, ByRef bih As Any) As Long
Private Declare Function AVIStreamGetFrame Lib "avifil32.dll" _
(ByVal pGetFrameObj As Long, ByVal lPos As Long) As Long
Private Declare Function AVIStreamGetFrameClose Lib "avifil32.dll" _
(ByVal pGetFrameObj As Long) As Long
Private Declare Sub MoveMemory Lib "kernel32.dll" Alias "RtlMoveMemory" _
(ByRef dest As Any, ByRef src As Any, ByVal dwLen As Long)
Public Function AviToBmp(ByVal szAviFile As String, _
ByVal iFrame As Long, _
ByVal szBmpFile As String) As Long
Dim pbmih As Long ' LPBITMAPINFOHEADER
Dim pavi As Long ' PAVIFILE
Dim pstm As Long ' PAVISTREAM
Dim pfrm As Long ' PGETFRAME
Call AVIFileInit
If (AVIFileOpen(pavi, szAviFile, OF_READ Or _
OF_SHARE_DENY_NONE, 0) <> 0) Then GoTo ErrOut
If (AVIFileGetStream(pavi, pstm, 0, 0) <> 0) Then GoTo ErrOut
pfrm = AVIStreamGetFrameOpen(pstm, ByVal 0&)
If (pfrm = 0) Then GoTo ErrOut
pbmih = AVIStreamGetFrame(pfrm, iFrame)
If (pbmih = 0) Then GoTo ErrOut
Call BmpSave(szBmpFile, pbmih)
AviToBmp = 1
ErrOut:
If (pfrm <> 0) Then Call AVIStreamGetFrameClose(pfrm)
If (pstm <> 0) Then Call AVIStreamRelease(pstm)
If (pavi <> 0) Then Call AVIFileRelease(pavi)
Call AVIFileExit
End Function
Private Sub BmpSave(ByVal fname As String, pbmih As Long)
Dim bmih As BITMAPINFOHEADER
Dim s As Long, x As Long, y As Long
Dim bmfh As BITMAPFILEHEADER
Dim bbmih() As Byte
Dim fn As Integer
Call MoveMemory(bmih, ByVal pbmih, Len(bmih))
x = bmih.biWidth
y = Abs(bmih.biHeight)
bmfh.bfType = &H4D42
bmfh.bfReserved1 = 0
bmfh.bfReserved2 = 0
If (bmih.biClrUsed = 0) Then
Select Case (bmih.biBitCount)
Case 1: bmfh.bfOffBits = 8
Case 4: bmfh.bfOffBits = 64
Case 8: bmfh.bfOffBits = 1024
Case 24: bmfh.bfOffBits = 0
Case 16, 32: bmfh.bfOffBits = IIf(bmih.biCompression = BI_RGB, 12, 0)
End Select
Else
bmfh.bfOffBits = bmih.biClrUsed * 4
End If
bmfh.bfOffBits = bmfh.bfOffBits + Len(bmfh) + Len(bmih)
If (bmih.biSizeImage = 0) Then
Select Case (bmih.biBitCount)
Case 1: s = (x + 7) \ 8
Case 4: s = (x + 1) \ 2
Case 8: s = x
Case 16: s = x * 2
Case 24: s = x * 3
Case 32: s = x * 4
End Select
bmfh.bfSize = bmfh.bfOffBits + ((s + 3) \ 4) * 4 * y
Else
bmfh.bfSize = bmfh.bfOffBits + bmih.biSizeImage
End If
ReDim bbmih(0 To bmfh.bfSize - Len(bmfh) - 1)
Call MoveMemory(bbmih(0), ByVal pbmih, bmfh.bfSize - Len(bmfh))
On Error Resume Next
fn = FreeFile
Open fname For Binary As #fn
Put #fn, , bmfh
Put #fn, , bbmih()
Close #fn
Erase bbmih()
End Sub
＞NaClさん
何度もどうもありがとうございます。
お陰様で、私の力不足を除いては順調に進んでいます。
自分では丸4日を使ってもできなかったので、本当に助かりました。
何かあったときはまたご質問させて頂くかも知れませんが、そのときもどうかよろしくお願い致します。