www.pudn.com > pdng22src.zip > playlistfrm.frm
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form playlistfrm
BackColor = &H00000000&
BorderStyle = 4 'Fixed ToolWindow
Caption = "PlayList"
ClientHeight = 4035
ClientLeft = 3345
ClientTop = 2790
ClientWidth = 6345
Icon = "playlistfrm.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 269
ScaleMode = 3 'Pixel
ScaleWidth = 423
ShowInTaskbar = 0 'False
Begin MSComDlg.CommonDialog CommonDialog1
Left = 2265
Top = 3540
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.CommandButton Command3
Caption = "&Ok"
Height = 375
Left = 5160
TabIndex = 3
Top = 3540
Width = 1125
End
Begin VB.CommandButton Command2
Caption = "&Remove"
Height = 375
Left = 3990
TabIndex = 1
Top = 3540
Width = 1125
End
Begin VB.CommandButton Command1
Caption = "&Add file..."
Height = 375
Left = 2880
TabIndex = 2
Top = 3540
Width = 1125
End
Begin VB.ListBox List1
BackColor = &H00FFFFFF&
ForeColor = &H00000000&
Height = 3375
Left = 45
TabIndex = 0
Top = 30
Width = 6240
End
Begin VB.Label Label4
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "PowerDivx"
BeginProperty Font
Name = "Nasalization"
Size = 18
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H0080C0FF&
Height = 330
Left = 60
TabIndex = 5
Top = 3450
Width = 2235
End
Begin VB.Label Label5
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Next Generation"
BeginProperty Font
Name = "Nasalization"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H0080C0FF&
Height = 210
Left = 420
TabIndex = 4
Top = 3780
Width = 2430
End
End
Attribute VB_Name = "playlistfrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
CommonDialog1.FileName = ""
'CommonDialog1.DialogTitle = "Ajouter un fichier Avi"
CommonDialog1.Filter = "Media files (*.mpg;*.avi;*.mov)|*.mpg;*.avi;*.mov|"
CommonDialog1.FilterIndex = 1
CommonDialog1.flags = cdlOFNCreatePrompt And _
cdlOFNPathMustExist And cdlOFNLongFileNames And cdlOFNExplorer
CommonDialog1.Action = 1
If Not CommonDialog1.FileName = "" Then
List1.AddItem (CommonDialog1.FileName)
End If
End Sub
Private Sub Command2_Click()
On Error Resume Next
List1.RemoveItem (List1.ListIndex)
List1.ListIndex = 0
End Sub
Private Sub Command3_Click()
Me.Hide
On Error Resume Next
List1.ListIndex = 0
If Not List1.Text = "" Then
frmMain.ctrlCommonDlg.FileName = List1.Text
Dim nCount, iCount As Long
Dim qnr, file$, temp$
Dim objFilter As Object
'******* Essai debut
'On Local Error GoTo ErrLine
' reset the application's module-level objects
If ObjPtr(m_objFilterInfo) > 0 Then Set m_objFilterInfo = Nothing
If ObjPtr(m_objSelectedPin) > 0 Then Set m_objSelectedPin = Nothing
If ObjPtr(m_objRegFilterInfo) > 0 Then Set m_objRegFilterInfo = Nothing
If ObjPtr(m_objMediaControl) > 0 Then Set m_objMediaControl = Nothing
' create a new IMediaControl object
Set m_objMediaControl = New FilgraphManager
' refresh the display for registered filters
If ObjPtr(m_objMediaControl) > 0 Then
If ObjPtr(m_objMediaControl.RegFilterCollection) > 0 Then
Set m_objRegFilterInfo = m_objMediaControl.RegFilterCollection
Call frmMain.RefreshRegFilters
End If
End If
' clear the contents of the listboxes, textboxes, and labels
frmMain.listFilters.Clear: frmMain.listPins.Clear
frmMain.txtPinInfo.Text = vbNullString: frmMain.lblFilterName.Caption = vbNullString: frmMain.lblVendorInfo.Caption = vbNullString
' set the current playback state to stopped
m_GraphState = StateStopped
'******* Essai fin
On Local Error GoTo ErrLine
If frmMain.ctrlCommonDlg.FileName <> vbNullString Then
'verify that the filter has not already been appended to the list
For nCount = 0 To frmMain.listFilters.ListCount
If LCase(frmMain.listFilters.List(nCount)) = LCase(frmMain.ctrlCommonDlg.FileName) Then
'the item has already been appended to the list, so exit
Exit Sub
End If
Next
Call m_objMediaControl.AddSourceFilter(frmMain.ctrlCommonDlg.FileName, objFilter)
frmMain.RefreshFilters ' update all info displayed by this VB app
frmMain.nomfich.Caption = frmMain.ctrlCommonDlg.FileName
End If
If EXISTE(App.Path + "\Newdev.mpw") Then
CheckAudio.ProgressBar1.MAX = frmMain.listRegFilters.ListCount - 1
CheckAudio.Show
For iCount = 10 To frmMain.listRegFilters.ListCount - 1
CheckAudio.ProgressBar1.Value = iCount
frmMain.listRegFilters.ListIndex = iCount
If frmMain.listRegFilters.Text = "Default WaveOut Device" Then
On Error Resume Next
qnr = FreeFile
file$ = App.Path + "\English.mpw"
Open file$ For Output As #qnr
temp$ = "English Driver = Enabled"
Print #qnr, temp$
Close #qnr
Kill (App.Path + "\Newdev.mpw")
Kill (App.Path + "\French.mpw")
ElseIf frmMain.listRegFilters.Text = "Périphérique par défaut WaveOut" Then
On Error Resume Next
qnr = FreeFile
file$ = App.Path + "\French.mpw"
Open file$ For Output As #qnr
temp$ = "French Driver = Enabled"
Print #qnr, temp$
Close #qnr
Kill (App.Path + "\Newdev.mpw")
Kill (App.Path + "\English.mpw")
End If
Next iCount
End If
If EXISTE(App.Path + "\english.mpw") Then
frmMain.listRegFilters.Text = "Default WaveOut Device"
ElseIf EXISTE(App.Path + "\english.mpw") Then
frmMain.listRegFilters.Text = "Périphérique par défaut WaveOut"
End If
Unload CheckAudio
Call frmMain.cmdAddRegFilter_Click
frmMain.listFilters.ListIndex = 1
'render the selected pin
m_objSelectedPin.Render
'update the ui
frmMain.RefreshFilters
Set m_objMediaPosition = m_objMediaControl
frmMain.dureelbl.Caption = m_objMediaPosition.Duration
frmMain.Slider1.MAX = frmMain.dureelbl.Caption
Exit Sub
ErrLine:
If Err.Number = 32755 Then Exit Sub
Err.Clear
Exit Sub
End If
End Sub