frmvideoview.frm

VB6.0编写的医院影像系统

End
Attribute VB_Name = "frmVideoView"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public Filename As String
Public SoundFileName As String      '对应的声音文件名称
Public PlayOver As Boolean          '已经结束播放的标志


Private Status As String            '当前的状态

Public OriginWidth As Long          'AVI原始宽度
Public OriginHeight As Long         'AVI原始高度



Private Sub cmdCapture_Click()
    
    '--------------
    '抓取图片
    '--------------
    
    cdlSave.ShowSave
    If cdlSave.Filename <> vbnullsring Then
        fxvVideo.SaveFileName = cdlSave.Filename
        fxvVideo.SavePicture = True
    End If
        
End Sub

Private Sub cmdFile_Click()
    
    '----------------
    '"文件"按键
    '----------------
    
    cdlOpen.ShowOpen
    If cdlOpen.Filename = vbNullString Then Exit Sub
    Filename = cdlOpen.Filename
    OpenVideo Filename
    
    '设置状态
    Status = "OPEN"
    
End Sub

Private Sub cmdNextFrame_Click()
    
    '--------------
    '到下一帧
    '--------------
    
    SeekTo fxvVideo.Position + 1
    
End Sub



Private Sub cmdPause_Click()
    
    '--------------
    '暂停
    '--------------
    
    fxvVideo.Command = CMD_Pause
    Status = "PAUSE"
    
    '设置功能
    tmrVideo.Enabled = False
    cmdPlay.Enabled = True
    cmdStop.Enabled = True
    cmdPause.Enabled = False
    cmdPreviousFrame.Enabled = True
    cmdNextFrame.Enabled = True
    sldVideo.Enabled = True
    
End Sub

Private Sub cmdPlay_Click()
    
    '------------------------------
    '播放,根据状态决定执行的动作
    '------------------------------
    
    With fxvVideo
        Select Case Status
            Case "PLAYOVER"
                .From = 0
                .Command = CMD_PlayFrom
            Case "PAUSE"
                .Command = CMD_Resume
            Case "OPEN"
                .Command = CMD_Play
            Case "SEEKTO"
                .From = .Position
                .Command = CMD_PlayFrom
            Case Else
                .From = 0
                .Command = CMD_PlayFrom
        End Select
    End With
    
    tmrVideo.Enabled = True
    
    
    '设置功能
    cmdPlay.Enabled = False
    cmdStop.Enabled = True
    cmdPause.Enabled = True
    cmdPreviousFrame.Enabled = False
    cmdNextFrame.Enabled = False
    
    '说明未播放完成
    PlayOver = False
    
End Sub

Private Sub cmdPlayVideoSound_Click()
    
    '-----------------
    '播放视频的配音
    '-----------------
    
    PlaySound Me.SoundFileName
    
End Sub

Private Sub cmdPreviousFrame_Click()
    
    '-----------
    '前一帧
    '-----------
    
    SeekTo fxvVideo.Position - 1
    
End Sub

Private Sub cmdStop_Click()
    
    '-----------
    '设置位置
    '-----------
    
    With fxvVideo
        .Command = CMD_Stop
        .To = 0
        .Command = CMD_SeekTo
    End With
    
    '设置功能
    cmdPlay.Enabled = True
    cmdStop.Enabled = False
    cmdPause.Enabled = False
    cmdPreviousFrame.Enabled = False
    cmdNextFrame.Enabled = False
    
    Status = "PLAYOVER"
    
End Sub



Private Sub Form_Load()
    
    '---------------------------
    '如果已经有文件名,则立即打开
    '---------------------------
        
    '根据版本判断是否应该加载窗体
    If USV.AllowShowVideo = False Then
        Unload Me
        Exit Sub
    End If
    
    '根据版本判断是否允许截取图片
    Me.cmdCapture.Enabled = USV.AllowEditVideo
    
    '判断是否显示播放声音
    If Me.SoundFileName <> vbNullString Then
        fraSound.Visible = True
    End If
    
    Me.WindowState = 2
    
    If Filename <> vbNullString Then
        OpenVideo Filename
        Me.Caption = Me.Caption & " - [" & Filename & "]"
        DoEvents
        cmdPlay_Click
'        If FSO.FileExists(Me.SoundFileName) Then
'            cmdPlayVideoSound_Click
'        End If
    End If

    Screen.MousePointer = cbnormal
    
End Sub


Private Sub Form_Resize()
    
    '-----------------
    '调整控件位置
    '-----------------
    
    If Me.WindowState = vbMinimized Then Exit Sub
    
    fraProgress.Left = 30
    fraProgress.width = Me.ScaleWidth - 60
    lblProgress.Left = fraProgress.width - 900
    sldVideo.width = fraProgress.width - 1800
    
    fraVideo.Move 30, -30, Me.ScaleWidth - 60, Me.ScaleHeight - picV.height - Me.sbrVideo.height + 30
    fxvVideo.Move (fraVideo.width - fxvVideo.width) / 2, (fraVideo.height - fxvVideo.height) / 2
    
End Sub

Private Sub Form_Unload(Cancel As Integer)
    
    '----------------------
    '置空一些初试变量
    '----------------------
    
    SoundFileName = vbNullString
    
End Sub

Private Sub fxvVideo_Notify()
    
    '------------------------
    '获得播放完成的消息
    '------------------------
    Select Case fxvVideo.NotifyValue
        Case 1
            Status = "PLAYOVER"
            cmdStop_Click
        Case 2
        
        Case 3
        
        Case 4
    End Select
    
End Sub

Private Sub hscSpeed_Change()
    
    '--------------------
    '改变播放速度
    '--------------------
    
    fxvVideo.Speed = hscSpeed.Value * 10
    lblSpeed = hscSpeed.Value & "%"
    
End Sub


Public Sub OpenVideo(strFileName)
    
    '----------------------
    '打开一个视频文件
    '----------------------
    
    On Error GoTo ErrHandle
    
    With fxvVideo
        .Filename = Filename
        .Command = CMD_Open
        .AutoSize = VSIZE_ResizeControlToVideo
        OriginWidth = .width
        OriginHeight = .height
        Me.sbrVideo.Panels("Size").Text = "尺寸: " & .width / Screen.TwipsPerPixelX & " x " & .height / Screen.TwipsPerPixelY
        .AutoSize = VSIZE_ResizeVideoToControl
        sldZoom_Click
        sldVideo.Max = .Length
        sldVideo.Value = 0
    End With
    
    '设置功能的禁止与否
    cmdPlay.Enabled = True
    cmdPause.Enabled = False
    cmdStop.Enabled = False
    cmdPreviousFrame.Enabled = True
    cmdNextFrame.Enabled = True
    
    ShowInfo
    
    Exit Sub

ErrHandle:
    ShowError

    
End Sub

Private Sub ShowInfo()
    
    '----------------------
    '显示当前的位置等属性
    '----------------------
    
    With fxvVideo
        Me.sbrVideo.Panels("Position").Text = "位置: " & .Position
        Me.sbrVideo.Panels("Length").Text = "长度: " & .Length
        sldVideo.Value = .Position
        DoEvents
    End With
    
End Sub

Private Sub hscVolumn_Change()
    
    '--------------------
    '改变音量
    '--------------------
    
    fxvVideo.WaveVolume = hscVolumn.Value * 655.35
    lblvolumn = hscVolumn.Value & "%"

End Sub

Private Sub sldVideo_Change()
    
    '-----------------
    '改变指示
    '-----------------
    
    lblProgress.Caption = sldVideo.Value
    
End Sub

Private Sub sldVideo_Click()
    
    '-------------
    '改变进度
    '-------------
    
    If sldVideo.Enabled Then
        fxvVideo.To = sldVideo.Value
        fxvVideo.Command = CMD_SeekTo
        Status = "SEEKTO"
        ShowInfo
    End If
    
End Sub

Private Sub sldZoom_Click()
    
    '-------------------
    '改变放大比例
    '-------------------
    
    With fxvVideo
        .width = OriginWidth * sldZoom.Value
        .height = OriginHeight * sldZoom.Value
        lblZoomRate.Caption = "× " & sldZoom.Value
        Me.sbrVideo.Panels("Zoom").Text = "放大: " & sldZoom.Value & " 倍"
        Form_Resize
        DoEvents
    End With
    
End Sub

Private Sub tmrVideo_Timer()
    
    '----------
    '显示信息
    '----------
    
    ShowInfo
    
End Sub


Private Function SeekTo(ByVal ToPos As Long)
    
    '----------------
    '跳到指定的进度
    '----------------
    
    With fxvVideo
        If ToPos > .Length Then ToPos = .Length
        If ToPos < 0 Then ToPos = 0
        .To = ToPos
        .Command = CMD_SeekTo
        ShowInfo
    End With
    
    Status = "SEEKTO"
    
End Function