frmmediap.frm

国防工业部VB高级编程源码

VERSION 5.00
Object = "{22D6F304-B0F6-11D0-94AB-0080C74C7E95}#1.0#0"; "MSDXM.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frmMediaP 
   Caption         =   "多媒体播放器"
   ClientHeight    =   4305
   ClientLeft      =   165
   ClientTop       =   735
   ClientWidth     =   5565
   Icon            =   "frmMediaP.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   4305
   ScaleWidth      =   5565
   StartUpPosition =   3  '窗口缺省
   Begin MSComDlg.CommonDialog cmdlgFile 
      Left            =   2160
      Top             =   1560
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin MediaPlayerCtl.MediaPlayer MediaP 
      Height          =   3375
      Left            =   240
      TabIndex        =   0
      Top             =   0
      Width           =   4215
      AudioStream     =   -1
      AutoSize        =   0   'False
      AutoStart       =   -1  'True
      AnimationAtStart=   -1  'True
      AllowScan       =   -1  'True
      AllowChangeDisplaySize=   -1  'True
      AutoRewind      =   0   'False
      Balance         =   9640
      BaseURL         =   ""
      BufferingTime   =   5
      CaptioningID    =   ""
      ClickToPlay     =   -1  'True
      CursorType      =   0
      CurrentPosition =   -1
      CurrentMarker   =   0
      DefaultFrame    =   ""
      DisplayBackColor=   0
      DisplayForeColor=   16777215
      DisplayMode     =   0
      DisplaySize     =   4
      Enabled         =   -1  'True
      EnableContextMenu=   -1  'True
      EnablePositionControls=   -1  'True
      EnableFullScreenControls=   0   'False
      EnableTracker   =   -1  'True
      Filename        =   ""
      InvokeURLs      =   -1  'True
      Language        =   -1
      Mute            =   0   'False
      PlayCount       =   1
      PreviewMode     =   0   'False
      Rate            =   1
      SAMILang        =   ""
      SAMIStyle       =   ""
      SAMIFileName    =   ""
      SelectionStart  =   -1
      SelectionEnd    =   -1
      SendOpenStateChangeEvents=   -1  'True
      SendWarningEvents=   -1  'True
      SendErrorEvents =   -1  'True
      SendKeyboardEvents=   0   'False
      SendMouseClickEvents=   0   'False
      SendMouseMoveEvents=   0   'False
      SendPlayStateChangeEvents=   -1  'True
      ShowCaptioning  =   0   'False
      ShowControls    =   -1  'True
      ShowAudioControls=   -1  'True
      ShowDisplay     =   0   'False
      ShowGotoBar     =   0   'False
      ShowPositionControls=   -1  'True
      ShowStatusBar   =   0   'False
      ShowTracker     =   -1  'True
      TransparentAtStart=   0   'False
      VideoBorderWidth=   0
      VideoBorderColor=   0
      VideoBorder3D   =   0   'False
      Volume          =   -600
      WindowlessVideo =   0   'False
   End
   Begin VB.Menu mnuFile 
      Caption         =   "文件（&F）"
      Begin VB.Menu mnuFileOpen 
         Caption         =   "打开（&O）"
      End
      Begin VB.Menu mnuFileClose 
         Caption         =   "关闭（&C）"
      End
      Begin VB.Menu mnuFileLine 
         Caption         =   "-"
         Visible         =   0   'False
      End
      Begin VB.Menu mnuFileName0 
         Caption         =   "文件名"
         Visible         =   0   'False
      End
      Begin VB.Menu mnuFileName1 
         Caption         =   "文件名"
         Visible         =   0   'False
      End
      Begin VB.Menu mnuFileline1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuFileExit 
         Caption         =   "退出（&x）"
      End
   End
   Begin VB.Menu mnuView 
      Caption         =   "查看（&V）"
      Begin VB.Menu mnuViewMin 
         Caption         =   "最小（&M）"
      End
      Begin VB.Menu mnuViewC 
         Caption         =   "简洁（&C）"
      End
      Begin VB.Menu mnuViewS 
         Caption         =   "标准（&S）"
      End
      Begin VB.Menu mnuViewBar 
         Caption         =   "工具条（&B）..."
         Begin VB.Menu mnuViewBarMenu 
            Caption         =   "菜单栏"
         End
         Begin VB.Menu mnuViewBarControls 
            Caption         =   "播放控制"
         End
         Begin VB.Menu mnuViewBarAudio 
            Caption         =   "声音控制"
         End
         Begin VB.Menu mnuViewBarCaptioning 
            Caption         =   "字幕"
         End
         Begin VB.Menu mnuViewBarDisplay 
            Caption         =   "信息显示栏"
         End
         Begin VB.Menu mnuViewBarGoto 
            Caption         =   "GoTo栏"
         End
         Begin VB.Menu mnuViewBarPosition 
            Caption         =   "显示位置条"
         End
         Begin VB.Menu mnuViewBarTracker 
            Caption         =   "轨道栏"
         End
         Begin VB.Menu mnuViewBarStatus 
            Caption         =   "状态栏"
         End
      End
      Begin VB.Menu mnuViewLine0 
         Caption         =   "-"
      End
      Begin VB.Menu mnuViewFull 
         Caption         =   "全屏显示（&F）"
         Shortcut        =   ^F
      End
      Begin VB.Menu mnuViewsf 
         Caption         =   "缩放..."
         Begin VB.Menu mnuViewsfSame 
            Caption         =   "原始大小"
            Shortcut        =   {F5}
         End
         Begin VB.Menu mnuViewsfHalf 
            Caption         =   "50％"
         End
         Begin VB.Menu mnuViewsfTwo 
            Caption         =   "200%"
         End
         Begin VB.Menu mnuViewsfSix 
            Caption         =   "屏幕的1/16"
         End
         Begin VB.Menu mnuViewsfFour 
            Caption         =   "屏幕的1/4"
         End
         Begin VB.Menu mnuViewsfTwoOne 
            Caption         =   "屏幕的1/2"
         End
      End
      Begin VB.Menu mnuViewLine1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuViewStat 
         Caption         =   "统计信息（&T）..."
      End
      Begin VB.Menu mnuViewLine2 
         Caption         =   "-"
      End
      Begin VB.Menu mnuViewPre 
         Caption         =   "选项（&O）..."
      End
   End
   Begin VB.Menu mnuPlay 
      Caption         =   "播放（&P）"
      Begin VB.Menu mnuPlayPP 
         Caption         =   "播放/暂停"
         Shortcut        =   ^P
      End
      Begin VB.Menu mnuPlayStop 
         Caption         =   "停止"
         Shortcut        =   ^S
      End
      Begin VB.Menu mnuPlayLine0 
         Caption         =   "-"
      End
      Begin VB.Menu mnuPlaykt 
         Caption         =   "快退"
         Shortcut        =   ^B
      End
      Begin VB.Menu mnuPlaykj 
         Caption         =   "快进"
         Shortcut        =   ^G
      End
      Begin VB.Menu mnuPlayhj 
         Caption         =   "向后跳进"
         Shortcut        =   ^K
      End
      Begin VB.Menu mnuPlayqj 
         Caption         =   "向前跳进"
         Shortcut        =   ^J
      End
   End
   Begin VB.Menu mnuCtrl 
      Caption         =   "控制（&K）"
      NegotiatePosition=   3  'Right
      Begin VB.Menu mnuCtrlMute 
         Caption         =   "静音"
         Shortcut        =   ^M
      End
      Begin VB.Menu mnuCtrlBig 
         Caption         =   "声量增大"
         Shortcut        =   ^{INSERT}
      End
      Begin VB.Menu mnuCtrlSmall 
         Caption         =   "声量减少"
         Shortcut        =   +{INSERT}
      End
      Begin VB.Menu mnuCtrlline1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuCtrlLeft 
         Caption         =   "左声道"
         Shortcut        =   ^L
      End
      Begin VB.Menu mnuCtrlRight 
         Caption         =   "右声道"
         Shortcut        =   ^R
      End
      Begin VB.Menu mnuCtrlStereo 
         Caption         =   "立体声"
         Shortcut        =   ^T
      End
      Begin VB.Menu mnuCtrlLine2 
         Caption         =   "-"
      End
      Begin VB.Menu mnuCtrl3d 
         Caption         =   "3D边界"
      End
      Begin VB.Menu mnuCtrlColor 
         Caption         =   "边界颜色..."
      End
      Begin VB.Menu mnuCtrlWidth 
         Caption         =   "边界宽度..."
         Begin VB.Menu mnuCtrlWidthBig 
            Caption         =   "增加"
         End
         Begin VB.Menu mnuCtrlWidthSmall 
            Caption         =   "减少"
         End
      End
      Begin VB.Menu mnuCtrlLine3 
         Caption         =   "-"
      End
      Begin VB.Menu mnuCtrBackColor 
         Caption         =   "背景色..."
      End
      Begin VB.Menu mnuCtrFrontColor 
         Caption         =   "前景色..."
      End
   End
   Begin VB.Menu mnuHelp 
      Caption         =   "帮助（&H）"
      Begin VB.Menu mnuHelpMP 
         Caption         =   "Media Player帮助..."
      End
      Begin VB.Menu mnuHelpAboutMP 
         Caption         =   "关于Media Player..."
      End
      Begin VB.Menu mnuHelpLine 
         Caption         =   "-"
      End
      Begin VB.Menu mnuHelpAboutMe 
         Caption         =   "关于此程序..."
      End
   End
End
Attribute VB_Name = "frmMediaP"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'打开文件名数组
Private arrFileName() As String
'打开文件数目
Private m_intFileCount As Integer
'前一文件名
Private m_strPreFileName As String
'保存屏幕大小
Private m_sngScreenHeight As Single
Private m_sngScreenWidth As Single

Private Sub Form_Load()
    '设置MediaPlayer的大小和窗口匹配
    MediaP.Left = 0
    MediaP.Top = 0
    MediaP.Height = frmMediaP.ScaleHeight
    MediaP.Width = frmMediaP.ScaleWidth
    
    m_sngScreenHeight = frmMediaP.ScaleHeight
    m_sngScreenWidth = frmMediaP.ScaleWidth
    
    '设置菜单栏状态
    mnuViewMin.Checked = False
    mnuViewC.Checked = False
    mnuViewS.Checked = False
    
    '设置MediaPlayer界面为简约形式
    mnuViewC_Click
    mnuViewBarMenu.Checked = True
    mnuViewBarPosition.Checked = True
    mnuViewsf.Enabled = False
    
    '设置窗口的边界
    If MediaP.VideoBorder3D Then mnuCtrl3d.Checked = True
    
    '定义文件数组
    m_intFileCount = 0
    ReDim arrFileName(0) As String
    arrFileName(0) = ""
    '从注册表中读取最近打开的文件名
    mnuFileName0.Caption = GetSetting("MPApp", "FileName", "File1")
    mnuFileName1.Caption = GetSetting("MPApp", "FileName", "File2")
    
    '显示在文件菜单栏上
    If mnuFileName1.Caption <> "文件名" And mnuFileName1.Caption <> "" Then
        m_intFileCount = m_intFileCount + 1
        ReDim Preserve arrFileName(m_intFileCount) As String
        arrFileName(m_intFileCount) = mnuFileName1.Caption
        mnuFileName1.Visible = True
        mnuFileLine.Visible = True
    End If
    If mnuFileName0.Caption <> "文件名" And mnuFileName0.Caption <> "" Then
        m_intFileCount = m_intFileCount + 1
        ReDim Preserve arrFileName(m_intFileCount) As String
        arrFileName(m_intFileCount) = mnuFileName0.Caption
        mnuFileName0.Visible = True
        mnuFileLine.Visible = True
    End If
    
End Sub

Sub FormResize()
'使窗口大小和MediaPlayer大小匹配
    MediaP.Left = 0
    MediaP.Top = 0
    MediaP.AllowChangeDisplaySize = True
    frmMediaP.Height = frmMediaP.Height + MediaP.Height - m_sngScreenHeight
    frmMediaP.Width = frmMediaP.Width + MediaP.Width - m_sngScreenWidth
    m_sngScreenHeight = frmMediaP.ScaleHeight
    m_sngScreenWidth = frmMediaP.ScaleWidth

End Sub


Private Sub Form_Resize()
'使MediaPlayer大小和窗口大小匹配
    MediaP.Height = frmMediaP.ScaleHeight
    MediaP.Width = frmMediaP.ScaleWidth
End Sub





Private Sub mnuCtrBackColor_Click()
'弹出颜色对话框，选择背颜色
    cmdlgFile.ShowColor
    MediaP.DisplayBackColor = cmdlgFile.Color
End Sub

Private Sub mnuCtrFrontColor_Click()
'弹出颜色对话框，选择前景色
    cmdlgFile.ShowColor
    MediaP.DisplayForeColor = cmdlgFile.Color
End Sub

Private Sub mnuCtrl3d_Click()
'设置3D效果的边界
    mnuCtrl3d.Checked = Not mnuCtrl3d.Checked
    If mnuCtrl3d.Checked Then
        MediaP.VideoBorder3D = True
    Else
        MediaP.VideoBorder3D = False
    End If

End Sub

Private Sub mnuCtrlBig_Click()
'增大声量
    If MediaP.Volume + 300 <= 0 Then
        MediaP.Volume = MediaP.Volume + 300
    End If

End Sub

Private Sub mnuCtrlColor_Click()
'弹出颜色对话框，选择边界颜色
    cmdlgFile.ShowColor
    MediaP.VideoBorderColor = cmdlgFile.Color
End Sub

Private Sub mnuCtrlLeft_Click()
'设置左声道
    mnuCtrlLeft.Checked = Not mnuCtrlLeft.Checked
    If mnuCtrlLeft.Checked Then
        MediaP.Balance = –10000
        mnuCtrlRight.Checked = False
        mnuCtrlStereo.Checked = False
    Else
        MediaP.Balance = 0
        mnuCtrlLeft.Checked = False
        mnuCtrlRight.Checked = False
    End If
End Sub

Private Sub mnuCtrlMute_Click()
'设置静音
    If MediaP.Mute Then
        MediaP.Mute = False
        mnuCtrlBig.Enabled = True
        mnuCtrlSmall.Enabled = True
    Else
        MediaP.Mute = True
        mnuCtrlBig.Enabled = False
        mnuCtrlSmall.Enabled = False
    End If
    mnuCtrlMute.Checked = MediaP.Mute

End Sub

Private Sub mnuCtrlRight_Click()
'设置右声道
    mnuCtrlRight.Checked = Not mnuCtrlRight.Checked
    If mnuCtrlRight.Checked Then
        MediaP.Balance = 10000
        mnuCtrlLeft.Checked = False
        mnuCtrlStereo.Checked = False
    Else
        MediaP.Balance = 0
        mnuCtrlRight.Checked = False
        mnuCtrlLeft.Checked = False
    End If

End Sub

Private Sub mnuCtrlSmall_Click()