一个视频截图的问题

bbsbb 2004-08-22 06:16:57
引用ActiveMovie Control Type Library,用下面的代码在2000,XP能实现载图但在98中出错,经查找可能是出现在quartz.dll版本的问题上,但在98不能引用2000,XP中的quartz.dll,那位大侠能帮我修改一下程序,或者还有什么别的方法能在98中实现视频截图


'ActiveMovie技术下的多媒体控制器
Public Movie1 As FilgraphManager
Public Video1 As IBasicVideo2
Public Sound1 As IBasicAudio
Public Windows1 As IVideoWindow
Public Position1 As IMediaPosition
Public MovieEvent1 As IMediaEventEx

Private Sub Command1_Click()
'截图
Captch "c:\1.bmp"
End Sub

Private Sub Captch(ByVal fileName As String)
'截图

' Call Video1.GetCurrentImage(lngLength, ByVal 0&)
' ReDim bytImage(0& To lngLength - 1&) As Byte
' lngPointer = VarPtr(bytImage(0&))
' Call objVideo.GetCurrentImage(lngLength, lngPointer)

'得到高/宽
Dim vx As Long, vy As Long
vy = Video1.VideoHeight
vx = Video1.VideoWidth
'暂停一下
Movie1.Pause

'得到图象数据
'先是40个字节的DIB头
'然后就是长*宽*4字节的数据
Dim sz As Long
Dim img() As Long
sz = vx * vy + 10
ReDim img(sz - 1)
Video1.GetCurrentImage sz * 4, img(0)

'保存位置

'如果是图片格式未知
If (img(0) <> 40) Or (img(3) <> &H200001) Then
MsgBox "未知的格式!"
GoTo goOnPlay
End If
'设置图象框大小
With Me.PicSave
.Visible = True
.Height = vy
.Width = vx
End With
'取得图象数据
Dim x As Long, y As Long
Dim col As Long, rr As Long, gg As Long, bb As Long
Dim pp As Long
pp = 10
'数据的格式是从下到上,从左到右的方式
For y = 0 To vy - 1
For x = 0 To vx - 1
col = img(pp)
bb = col And 255&
gg = (col \ 256&) And 255&
rr = (col \ 65536) And 255&
col = RGB(rr, gg, bb)
'输出到图片框中去
Me.PicSave.PSet (x, vy - y), col
pp = pp + 1
Next
Next
'保存图片
SavePicture PicSave.Image, fileName


goOnPlay:

'继续
Movie1.Run
End Sub

Private Sub MenuOpen_Click()

'打开文件
Me.OpenFile.fileName = ""
Me.OpenFile.ShowOpen
If Me.OpenFile.fileName = "" Then
Exit Sub
End If

'播放文件
Call PlayMovie(Me.OpenFile.fileName)
End Sub

Private Sub PlayMovie(strFile As String)
'播放当前文件

On Error GoTo error1

'准备开始播放
'初始化控制器
Set Position1 = Nothing
Set Windows1 = Nothing
Set Sound1 = Nothing
Set Video1 = Nothing
Set Movie1 = Nothing
Set Movie1 = New FilgraphManager
Set Video1 = Movie1
Set Sound1 = Movie1
Set Windows1 = Movie1
Set Position1 = Movie1
Set MovieEvent1 = Movie1

'载入文件
Movie1.RenderFile strFile

'则初始化窗口
Windows1.Owner = Form2.MovieScreen.hWnd
Windows1.MessageDrain = Form2.MovieScreen.hWnd
movieHwnd = Me.hWnd
MovieEvent1.SetNotifyWindow Me.hWnd, MOVIE_EVENT, 0
Windows1.Top = 0
Windows1.Left = 0

Windows1.WindowStyle = &H560B0000

'初始化各个窗口和图象大小


Form2.MovieScreen.Width = Video1.VideoWidth
Form2.MovieScreen.Height = Video1.VideoHeight
Form2.ScaleMode = 1
Form2.Width = Form2.MovieScreen.Width
Form2.Height = Form2.MovieScreen.Height
Form2.ScaleMode = 3
Form2.Visible = True


'开始播放
Movie1.Run

Exit Sub
error1:
'出错处理
Set MovieEvent1 = Nothing
Set Position1 = Nothing
Set Windows1 = Nothing
Set Sound1 = Nothing
Set Video1 = Nothing
Set Movie1 = Nothing
Form2.Visible = False
MsgBox "不支持的文件格式....."

End Sub

...全文
256 9 打赏 收藏 转发到动态 举报
写回复
用AI写文章
9 条回复
切换为时间正序
请发表友善的回复…
发表回复
幻影时空 2004-08-27
  • 打赏
  • 举报
回复
楼主,把问题解决后,把代码公开哟!!

3q 3q 33q
bbsbb 2004-08-23
  • 打赏
  • 举报
回复
我需要实例
starsoulxp 2004-08-23
  • 打赏
  • 举报
回复
使用SetDIBitsToDevice
bbsbb 2004-08-23
  • 打赏
  • 举报
回复
UP
bbsbb 2004-08-23
  • 打赏
  • 举报
回复
UP
Andy__Huang 2004-08-22
  • 打赏
  • 举报
回复
代碼太長了,應該選一些關鍵的代碼帖出來不是可以了麼?
zyl910 2004-08-22
  • 打赏
  • 举报
回复
应该可以直接用SetDIBitsToDevice直接绘制DIB


SetDIBitsToDevice

VB声明
Declare Function SetDIBitsToDevice Lib "gdi32" Alias "SetDIBitsToDevice" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal dx As Long, ByVal dy As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal Scan As Long, ByVal NumScans As Long, Bits As Any, BitsInfo As BITMAPINFO, ByVal wUsage As Long) As Long
说明
将一幅与设备无关位图的全部或部分数据直接复制到一个设备。这个函数在设备中定义了一个目标矩形,以便接收位图数据。它也在DIB中定义了一个源矩形,以便从中提取数据
返回值
Long,执行成功则返回扫描线的数量,零表示失败。会设置GetLastError
参数表
参数 类型及说明
hdc Long,一个设备场景的句柄。该场景用于接收位图数据
x,y Long,用逻辑坐标表示的目标矩形的起点
dx,dy Long,用目标矩形的设备单位表示的宽度及高度
SrcX,SrcY Long,用设备坐标表示的源矩形在DIB中的起点
Scan Long,Bits数组中第一条扫描线的编号。如BitsInfo之BITMAPINFOHEADER部分的biHeight字段是正数,那么这条扫描线就会从位图的底部开始计算;如果是负数,就从顶部开始计算
NumScans Long,欲复制的扫描线数量
Bits Any,指向一个缓冲区的指针。这个缓冲区包含了以DIB格式描述的位图数据;这种格式是由BitsInfo指定的
BitsInfo BITMAPINFO,对Bits DIB的格式和颜色进行描述的一个结构
wUsage Long,下述常数之一
DIB_PAL_COLORS 颜色表是一个整数数组,其中包含了与目前选入hdc设备场景的调色板相关的索引
DIB_RGB_COLORS 颜色表包含了RG颜色
注解
用GetDeviceCaps判断设备是否支持这个函数

wwqna 2004-08-22
  • 打赏
  • 举报
回复
用GetDC()这个函数吧,然后再把它画到picturebox上面去!
bbsbb 2004-08-22
  • 打赏
  • 举报
回复
UP

7,763

社区成员

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧