controlfrm.frm

毕业设计

      Left            =   1460
      Picture         =   "Controlfrm.frx":D961
      ScaleHeight     =   480
      ScaleWidth      =   480
      TabIndex        =   14
      ToolTipText     =   "快进"
      Top             =   560
      Visible         =   0   'False
      Width           =   480
   End
   Begin VB.PictureBox AboutPic 
      AutoSize        =   -1  'True
      BorderStyle     =   0  'None
      Height          =   180
      Index           =   1
      Left            =   600
      Picture         =   "Controlfrm.frx":E62B
      ScaleHeight     =   180
      ScaleWidth      =   135
      TabIndex        =   16
      ToolTipText     =   "帮助"
      Top             =   320
      Width           =   135
   End
End
Attribute VB_Name = "Controlfrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim NewCur As Long   '新鼠标标记存储
Dim OldCur As Long   '旧鼠标的存储
'Dim MidCur As Long   '过度鼠标存储
Dim PicName As Integer  '确定经过按键的编号

Private Sub AboutPic_Click(Index As Integer) '帮助
frmAbout.Show
End Sub

Private Sub AboutPic_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
AboutPic(0).Visible = False  '鼠标移动到时显示
PicName = 7
End Sub

Private Sub BackPic_Click(Index As Integer)
GoBackFor (False)  '回放
End Sub

Private Sub BackPic_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
BackPic(0).Visible = False '鼠标移动到时显示
PicName = 3
End Sub

Private Sub ClosePic_Click(Index As Integer) '退出
End
End Sub

Private Sub ClosePic_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
ClosePic(0).Visible = False
PicName = 6
End Sub

Private Sub DownPic_Click(Index As Integer)
With Showfrm.Media1   '下调音量
If .Volume <> -4000 Then .Volume = .Volume - 200
End With
End Sub

Private Sub DownPic_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
DownPic(0).Visible = False '鼠标移动到时显示
PicName = 5
End Sub

Private Sub Form_Load() '窗体启动
OnForm.Top = Me.Height / 2 - OnForm.Height / 2
OnForm.Left = Me.Width / 2 - OnForm.Width / 2
toggleFrame Controlfrm, OnForm, True  '隐形窗体
CirclePic Controlfrm                 '控件处理
NewCur = LoadCursorFromFile(App.Path + "\icon\first.cur")
'上面*.ANI动画光标的路径可自己设定
OldCur = SetClassLong(OpenPic(0).hwnd, -12, NewCur)

ForFrm.Hide
frmAbout.Hide
MenuBar.Hide
Showfrm.Hide

End Sub
    
    

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> vbLeftButton Then
         '鼠标移出控件时恢复图标
         Select Case PicName
                Case 0
                     OpenPic(0).Visible = True
                Case 1
                     PlayPic(0).Visible = True
                Case 2
                     FroPic(0).Visible = True
                Case 3
                     BackPic(0).Visible = True
                Case 4
                     UpPic(0).Visible = True
                Case 5
                     DownPic(0).Visible = True
                Case 6
                     ClosePic(0).Visible = True
                Case 7
                     AboutPic(0).Visible = True
         End Select
         Exit Sub
    End If
    ReleaseCapture
    SendMessage Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&

End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
SetClassLong OpenPic(0).hwnd, -12, OldCur '退出恢复
SetWindowRgn hwnd, 0, False
DeleteObject mFormRegion    '清除内存变量
DeleteObject PlPa
DeleteObject EndTimePos
DeleteObject EndFramePos
DeleteObject OldVolumn
DeleteObject CurTime
DeleteObject StartM
DeleteObject NewCur
'DeleteObject MidCur
DeleteObject OldCur
End Sub





Private Sub FroPic_Click(Index As Integer)
GoBackFor (True)  '前进
End Sub

Private Sub FroPic_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
FroPic(0).Visible = False '鼠标移动到时显示
PicName = 2
End Sub

Private Sub OpenPic_Click(Index As Integer) '开启
Dim temp As Integer
On Error GoTo ErrHandler
temp = 1
PlPa = False
Do While temp
  CommonDialog1.CancelError = False
  CommonDialog1.Filter = "AVI (*.avi)|*.avi|MPEG (*.mpg;*.dat)|*.mpg;*.dat|Windows Media(*.asf;*.wn)|*.asf;*.wn|Movie (*.mov)|*.mov|MP3 (*.mp3;mp2)|*.mp3;mp2|WAV Sound (*.wav)|*.wav|MIDI Sequence (*.mid; *.rmi)|*.mid; *.rmi|AU (*.au)|*.au"
  CommonDialog1.ShowOpen
  If CommonDialog1.FileName <> "" Then
        '显示控件
        
        OpenPic(0).Visible = True
        OpenPic(1).Visible = True
        PlayPic(0).Visible = True
        PlayPic(1).Visible = True
        UpPic(0).Visible = True
        UpPic(1).Visible = True
        DownPic(0).Visible = True
        DownPic(1).Visible = True
        BackPic(0).Visible = True
        BackPic(1).Visible = True
        FroPic(0).Visible = True
        FroPic(1).Visible = True
        StartM = True
        CurTime = 10
        temp = 0
        OldVolumn = 0
        '初使化
      With Showfrm.Media1
        .FileName = CommonDialog1.FileName
        .CurrentPosition = &HFFFFFF
        If .DisplayMode = mpFrames Then
            EndFramePos = .CurrentPosition
            .DisplayMode = mpTime
            EndTimePos = .CurrentPosition
            .DisplayMode = mpFrames
        Else
            EndTimePos = .CurrentPosition
            .DisplayMode = mpFrames
            EndFramePos = .CurrentPosition
            .DisplayMode = mpTime
        End If
        .Volume = -2000
        
        ChangeSize (1)  '窗口设为默认状态
        .CurrentPosition = 0    '位置恢复为0
        
        If CommonDialog1.FilterIndex < 5 Then  '为视频模式启动窗口
           Showfrm.Show
            Showfrm.Caption = CommonDialog1.FileName
        Else
            Showfrm.Visible = False     '消失
        End If
        
      End With
      
  Else  '出错判断 1,未选文件
     MsgBox "Plase Selcet One File To Play!", 16, "None Select"
  End If
Loop
Exit Sub

ErrHandler:        '出错2 不认识文件.
On Error GoTo 0
MsgBox CommonDialog1.FileName & " is not playable !", 16, "File Error"

End Sub

Private Sub OpenPic_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
OpenPic(0).Visible = False '鼠标移动到时显示
OpenPic(1).Visible = True
PicName = 0
End Sub

Private Sub PlayPic_Click(Index As Integer) '播放控制
On Error GoTo ErrorHandler
With Showfrm.Media1
PlayPbb  '播放函数
End With
Exit Sub
ErrorHandler: '出错判定
On Error GoTo 0
MsgBox CommonDialog1.FileName & " is not playable !", 16, "File Error"
End Sub

Private Sub PlayPic_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
PlayPic(0).Visible = False
PicName = 1 '鼠标移动到时显示
End Sub

Private Sub UpPic_Click(Index As Integer)
With Showfrm.Media1      '增大音量
If .Volume <> 0 Then .Volume = .Volume + 200
End With
End Sub

Private Sub UpPic_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
UpPic(0).Visible = False
PicName = 4
End Sub