سورس یک برنامه پخش موزیک و دی وی دی

[Reza Safa]

کلید تشکر فراموش نشود
اگر filter پنجره ای که فایل باز می کند را بردارید تمامی فایل های تصویری و ویدئیی را نمایش می دهد
این مخصوص وی بی 6 است
مخصوص وی بی دات نت هم در قسمت دات نت گذاشتم


Public Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
'----
Public Const NIM_ADD = &H0
Public Const NIM_DELETE = &H2
Public Const NIM_MODIFY = &H1
Public Const NIF_ICON = &H2
Public Const NIF_MESSAGE = &H1
Public Const NIF_TIP = &H4
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const WM_MBUTTONDBLCLK = &H209
Public Const WM_MBUTTONDOWN = &H207
Public Const WM_MBUTTONUP = &H208
Public Const WM_RBUTTONDBLCLK = &H206
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205
Public Const WM_MOUSEMOVE = &H200
Public Const WM_MOUSEWHEEL = &H20A
'----
Public Type NOTIFYICONDATA
cbSize As Long
hwnd As Long
uID As Long
uFlags As Long
uCallbackMessage As Long
hIcon As Long
szTip As String * 64
End Type
'----

[Reza Safa]

Dim PlayerPos As IMediaPosition
Dim Player As FilgraphManager
'----
Dim blnPlay As Boolean
Dim blnStop As Boolean
Dim blnPause As Boolean
'----
Dim intShomareh(100) As Integer
Dim strFileName(100) As String
Dim strFileAddress(100) As String
'----
Dim Free As String
Dim Filerun As String
Dim Index As Integer
'----
Dim Reza As NOTIFYICONDATA
Dim SH As New Shell
Private Sub ClearList()
Dim I As Integer
'----
blnPlay = False
blnStop = False
blnPause = False
'----
With lstPlayList
If .ListCount <> 0 Then
For I = 1 To .ListCount
.RemoveItem 0
Next I
End If
End With
For I = 1 To 100
intShomareh(I) = 0
strFileName(I) = 0
strFileAddress(I) = 0
Next I
'----
Filerun = ""
Index = 0
End Sub
Private Sub MemorySub(Num As Integer, Name As String, Address As String, Vaziat As Boolean)
'True = Open
'False = Other
Dim AddressOpenFileRun As String
Set Player = New FilgraphManager
'----
If Vaziat = True Then

Set PlayerPos = Player 'Position
Player.RenderFile Address ' Load File
Player.Run ' Run File ( Play )
'----
intShomareh(Num) = Num ' Set
strFileName(Num) = Name ' Set
strFileAddress(Num) = Address ' Set
'----
Filerun = Address ' Set File Run ( Run )
Index = Num ' Set Index File Run
'----
blnPlay = True ' Play
blnStop = False ' No
blnPause = False ' No
Else
AddressOpenFileRun = strFileAddress(Index) ' Load File
Player.RenderFile AddressOpenFileRun ' Load File
Player.Run ' Run File ( Play )
'----
Filerun = AddressOpenFileRun ' Set File Run ( Run )
Index = Num ' Set Index File Run
'----
blnPlay = True ' Play
blnStop = False ' No
blnPause = False ' No
End If
End Sub
Private Sub cmdNext_Click()
If Player Is Nothing Then Exit Sub 'Not playing nothing to pause!
'----
Dim MemListCount As Integer
Dim Number As Integer
'----
MemListCount = lstPlayList.ListCount
'----
If blnPlay = True Then Call cmdStop_Click
With lstPlayList
If .ListCount <> 0 Then
If Index = MemListCount Then
Call MemorySub(1, Free, Free, False)
Else
Number = Index + 1
Call MemorySub(Number, Free, Free, False)
End If
Else
Exit Sub
End If
End With
End Sub
Private Sub cmdOpen_Click()
With Dialog
.DialogTitle = "Open File"
.FileName = ""
.Filter = "Audio File (*.mp3 , *.wav , *.midi)|*.wav;*.mid;*.mp3"
.ShowOpen
'----
If .FileName <> "" Then
lstPlayList.AddItem .FileTitle
Call MemorySub(lstPlayList.ListCount, .FileTitle, .FileName, True)
Else
Exit Sub
End If
End With
End Sub
Private Sub cmdPause_Click()
'If Player Is Nothing Then Exit Sub 'Not playing nothing to pause!
'----
If Filerun <> "" Then
If blnPlay <> True Then
Player.Run
blnPlay = True ' Play
blnStop = False ' No
blnPause = False ' No
Else
Player.Pause
'----
blnPause = True
blnPlay = False
blnStop = False
End If
Else
Exit Sub
End If
End Sub
Private Sub cmdPlay_Click()
'If Player Is Nothing Then Exit Sub 'Not playing nothing to pause!
'----
If Filerun <> "" Then
Call MemorySub(Index, Free, Free, False)
Else
Exit Sub
End If
End Sub
Private Sub cmdPrevious_Click()
'If Player Is Nothing Then Exit Sub 'Not playing nothing to pause!
'----
Dim MemListCount As Integer
Dim Number As Integer
'----
MemListCount = lstPlayList.ListCount
'----
If blnPlay = True Then Call cmdStop_Click
With lstPlayList
If .ListCount <> 0 Then
If Index = 1 Then
Call MemorySub(MemListCount, Free, Free, False)
Else
Number = Index - 1
Call MemorySub(Number, Free, Free, False)
End If
Else
Exit Sub
End If
End With
End Sub
Private Sub cmdStop_Click()
If Player Is Nothing Then Exit Sub 'Not playing nothing to pause!
'----
If Filerun <> "" Then
If blnPlay <> True Then
Exit Sub
Else
Player.Stop
'----
blnStop = True
blnPlay = False
blnPause = False
End If
Else
Exit Sub
End If
End Sub
Private Sub Form_Load()
Picture1.Picture = ImgMenu.Picture
'----
Timer.Interval = 100
Reza.cbSize = Len(Reza)
Reza.hwnd = Picture1.hwnd
Reza.uID = 1&
Reza.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
Reza.uCallbackMessage = WM_LBUTTONDOWN Or WM_RBUTTONDOWN
Reza.hIcon = Picture1.Picture
Reza.szTip = "Audio Player - Safasoft Company" & Chr$(0)

Shell_NotifyIcon NIM_ADD, Reza
'----
Call ClearList
End Sub
Private Sub Form_Unload(Cancel As Integer)
Reza.cbSize = Len(Reza)
Reza.hwnd = Picture1.hwnd
Reza.uID = 1&
Shell_NotifyIcon NIM_DELETE, Reza
Call mmClose_Click
End Sub
Private Sub ImgMenu_Click()
PopupMenu mMenu, , ImgMenu.Left, 1920 + 540
End Sub
Private Sub lblSafasoft_Click()
'---- Address Web Site ----'
SH.Open "http://www.safasoftco.com"
End Sub
Private Sub lstPlayList_DblClick()
With lstPlayList
Call cmdStop_Click
If .ListCount <> 0 Then Call MemorySub(.ListIndex + 1, Free, Free, False)
End With
End Sub
Private Sub lstPlayList_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then PopupMenu mPlayList
End Sub
Private Sub mmAbout_Click()
Dim MSG As Integer
'----
MSG = MsgBox("Program : Audio Player" & vbCrLf & _
"Version : 2005 . 1 . 4" & vbCrLf & _
"Programming : Reza Soleymani Safa" & vbCrLf & _
"Visit web site : http://www.SafasoftCo.com", _
vbInformation, "Audio Player - Safasoft")
End Sub
Private Sub mmClose_Click()
Call cmdStop_Click
End
End Sub
Private Sub mmcNext_Click()
Call cmdNext_Click
End Sub
Private Sub mmcPause_Click()
Call cmdPause_Click
End Sub
Private Sub mmcPlay_Click()
Call cmdPlay_Click
End Sub
Private Sub mmcPrevious_Click()
Call cmdPrevious_Click
End Sub
Private Sub mmcStop_Click()
Call cmdStop_Click
End Sub
Private Sub mmOpen_Click()
Call cmdOpen_Click
End Sub
Private Sub mmVisitwebsite_Click()
SH.Open "http://www.safasoftco.com"
End Sub
Private Sub mpClear_Click()
Call cmdStop_Click
Call ClearList
End Sub
Private Sub mpPlay_Click()
With lstPlayList
Call cmdStop_Click
On Error Resume Next
If .ListCount <> 0 Then Call MemorySub(.ListIndex + 1, Free, Free, False)
End With
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
MSG = X / Screen.TwipsPerPixelX
If MSG = WM_RBUTTONDOWN Then
Me.PopupMenu mMenu
End If
End Sub
Private Sub Timer_Timer()
Reza.hIcon = Picture1.Picture
Shell_NotifyIcon NIM_MODIFY, Reza
End Sub

[Reza Safa]

اینم فایل برنامه
---------------------------

[Reza Safa]

دوستان اين نرم افزار را پيشرفته تر نکردند ؟
هرکي اين نرم افزار را قابليتش را بيشتر کرده به ما بگه تا ديگران استفاده کنند