'СОРС ЗА ФОРМАТА

'Декларация на флаг използван при превъртане на песен

Dim FlagPlazgane As Integer

 

'При въвеждане на формата

Private Sub Form_Load()

    Command8.Left = -1000 'Скриваме празния бутон, който го ползваме само за прехвърляне на фокус

End Sub

 

' Пуснат при стартиране таймер за забавяне на зареждането на Listbox

Private Sub Timer3_Timer()

    Timer3.Enabled = False ' Спираме таймера, защото тойни трябва еднократно

    ZarediListbox List1, App.Path & "\Muzika\" ' Стартираме процедурата за зареждане на List1

End Sub

 

'При натискане на бутона за изборна папка ПАПКА с mp3

Private Sub Command4_Click()

    Papka = BrowseForFolder 'Задействаме функцията за избор на директория

    ZarediListbox List1, Papka ' Допълваме в List1 с файлове mp3 намерени в посочената директория

End Sub

 

'При натискане на бутона ИЗБОР

Private Sub Command7_Click()

    On Error GoTo dolu 'Манипулаторза грешка

    STOPIRANE ' Задействаме процедурата за спиране

    sFile = IzbranFail ' Задействаме функцията за избор на един файл

    If Len(sFile) > 0 Then List1.AddItem sFile ' Ако броя на буквите на избраното е > 0 допълваме List1

    If List1.ListCount = 0 Then GoTo dolu ' Ako все пак след допълване то броя на файловете в list1 е 0 прескачаме всичко

    SilaZvuk HScroll2.Value ' Задаваме сила на звука съответстваща на стойността на плъзгача за звук

    List1.ListIndex = List1.ListCount - 1 ' Пращаме индекса на List1 на последния ред

    'Пренастройваме бутоните ипращаме фокуса на бутона за ПАУЗА

    Command1.Enabled = False

    Command2.Enabled = True

    Command2.SetFocus

    Command3.Enabled = True

dolu:

End Sub

 

' При натискане на бутона СТАРТ

Private Sub Command1_Click()

    sFile = Chr(34) & List1.Text & Chr(34) 'Слагаме кавички на пълния път

    START sFile ' Задействаме функцията за възпроизвеждане на файла sFile

    Timer1.Enabled = True ' Задействаме таймера определящ моментното положение на песента

    'Пренастройваме бутоните ипращаме фокуса на бутона за ПАУЗА

     Command1.Enabled = False

     Command2.Enabled = True

     Command3.Enabled = True

     Command2.SetFocus

End Sub

 

'При фокус върху command1 и натиснат и пуснат бутон ( шпация)

Private Sub Command1_KeyUp(KeyCode As Integer, Shift As Integer)

    'Пренастройваме бутоните и пращаме фокуса в бутона ПАУЗА

     Command1.Enabled = False

     Command2.Enabled = True

     Command3.Enabled = True

     Command2.SetFocus

End Sub

 

'При кликане с мишката върху command1 и бутон на мишка в горно положение

Private Sub Command1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

    'Пренастройваме бутоните и пращаме фокуса в бутона ПАУЗА

    Command1.Enabled = False

    Command2.Enabled = True

    Command3.Enabled = True

    Command2.SetFocus

End Sub

 

' При натискане на бутона ПАУЗА

Private Sub Command2_Click()

    PAUZA ' Задействаме процедурата за пауза

    FlagPlazgane = 0 ' Нулираме флага за превъртане

    'Пренастройваме бутоните ипращаме фокуса на бутона за СТАРТ

    Command2.Enabled = False

    Command1.Enabled = True

    Command1.SetFocus

End Sub

 

'При фокус върху command2 и натиснат и пуснат бутон ( шпация)

Private Sub Command2_KeyUp(KeyCode As Integer, Shift As Integer)

    FlagPlazgane = 0 ' Нулираме флага за превъртане

    'Пренастройваме бутоните,като пращаме фокуса в бутона СТАРТ

    Command1.Enabled = True

    Command1.SetFocus

End Sub

 

'При натискане на бутона СТОП

Private Sub Command3_Click()

    Timer1.Enabled = False 'Спираме таймера определящ моментното положение на песента

    STOPIRANE ' Задействаме процедурата за спиране

    'Пренастройваме бутоните

    Command1.Enabled = True

    Command2.Enabled = False

    Command3.Enabled = False

End Sub

 

'При натискане на бутона СТАРТ ЗАПИС

Private Sub Command5_Click()

    Command3_Click ' Натискаме бутона за СТОП

    STARTZAPIS ' Задействаме процедурата за запис

    'Пренастройваме бутоните

    Command5.Visible = False

    Command1.Enabled = False

    Command2.Enabled = False

    Command3.Enabled = False

End Sub

 

'При натискане на бутона СТОП ЗАПИС

Private Sub Command6_Click()

    STOPZAPIS ' Задействаме процедурата за спиране на записа

    List1.AddItem sFile ' Добавяме в списъка List1, записаният файл

    List1.ListIndex = List1.ListCount - 1 ' Избираме послефния запис в List1

    Command1_Click ' Натискаме бутона за възпроизвеждане на файла sFile

    SilaZvuk HScroll2.Value ' Задаваме сила на звука

    Command5.Visible = True 'Правим видим бутона ЗАПИС

End Sub

 

' При натискане на бутона за почистване на List1 - червеното бутонче с Х

Private Sub Command9_Click()

    Command3_Click ' Натискаме бутона за СПИРАНЕ

    List1.Clear ' Почистваме List1

    Command1.Enabled = False ' Забраняваме бутона СТАРТ

End Sub

 

' При кликане върху List1

Private Sub List1_Click()

    If List1.ListCount > 0 Then ' Ако има нещо въведено в списъка

        Command1_Click ' При кликане върху List1, натискаме бутона СТАРТ

    End If

End Sub

 

' При натиснат и пуснат клавиш, когато фокуса е върху List1

Private Sub List1_KeyUp(KeyCode As Integer, Shift As Integer)

    If KeyCode = 40 Or KeyCode = 39 Then ' Ако са били натиснати Стрелка Надолу или стрелка Надясно

        Timer1.Enabled = False 'Спираме таймера за моментното състояние на песента

        If List1.ListIndex = List1.ListCount - 1 Then ' Ако сме на последния ред в List1

            List1.ListIndex = 0 ' Пращаме индекса на първия ред

        Else

            List1.ListIndex = List1.ListIndex + 1 ' В противен случай отиваме на следващия ред

        End If

    End If

    If KeyCode = 37 Or KeyCode = 38 Then ' Ако са били натиснати Стрелка Ннагоре или стрелка Наляво

        If List1.ListIndex = 0 Then ' Ако сме на първия ред в List1

            List1.ListIndex = List1.ListCount - 1 ' Пращаме индекса на последния ред

        Else

            List1.ListIndex = List1.ListIndex - 1 ' В противен случай отиваме на предишния ред

        End If

    End If

End Sub

 

' При взимане на фокуса на плъзгача за превъртане

Private Sub HScroll1_GotFocus()

    Timer1.Enabled = False ' Спираме таймера за определяне на моментното състояние

    PAUZA ' Паузираме

    FlagPlazgane = 1 ' Сменяме състоянието на флага за превъртане

    Command1.Enabled = False ' Забраняваме бутона за Стартиране

    Timer2.Enabled = True ' Пускаме следящия таймер, който следи кога ще пуснем бутона на мишката

End Sub

 

'Таймер, който следи кога ще пуснем бутона на мишката

Private Sub Timer2_Timer()

If MouseKey = False Then ' Ако бутона е в горно положение

    Timer2.Enabled = False ' Спираме следящия таймера

    If FlagPlazgane = 1 Then ' Ако е задействан флага за превъртане

        setPositionTo HScroll1.Value ' Задействаме публична функцияза превъртане

        Timer1.Enabled = True ' Пускаме таймера за определяне на моментното положение на песента

        folagplazgane = 0 ' Нулираме флага за превъртане

        If HScroll1.Value <> HScroll1.Max Then ' Внимание, ако плъзгача не е в крайно дясно положение

            Command2.Enabled = True ' Разрешаваме бутона за Пауза

            Command2.SetFocus ' Изпращаме фокуса на бутона за Пауза

        Else

            Command3_Click ' Ако е в крайно дясно положение натискаме бутона стоп

        End If

    End If

End If

End Sub

 

'Същинският Таймер за определяне на моментаната позиция на по време на свиренето

Private Sub Timer1_Timer()

    HScroll1.Visible = True ' Правим видим плъзгача при свирене

    Dim totalTime As String * 256 ' Декларация на стрингова променлива за дължината на файла в мили секунди

    Dim sPosition As String * 256 ' Декларация на стрингова променлива за моментната позиция

    Call mciSendString("Set MM time format milliseconds", vbNullString, 0, 0&) ' Указваме формата да е в мили секунди

    Call mciSendString("status MM length", totalTime, 256, 0&) ' Получаваме дължината на песента

    HScroll1.Max = Int(Val(totalTime)) / 1000 ' Задаваме максимума на скалата на плъьгача да е равен на дължината на песента

    Call mciSendString("Status MM Position", sPosition, 256, 0) ' Определяме моментното положение

    HScroll1.Value = Int(Val(sPosition)) / 1000 ' Задаваме моментната стойност на плъзгача

    If HScroll1.Value = HScroll1.Max Then ' Ако се достигне крайно дясно положение

        Command3_Click ' Първо спираме песента

        If List1.ListCount <> 0 Then ' Ако списъка не е празен

            If List1.ListIndex = List1.ListCount - 1 Then ' Ако сме на последната песен

                List1.ListIndex = 0 ' Отиваме на първата

            Else

                List1.ListIndex = List1.ListIndex + 1 ' В противен случай песен напред

            End If

        End If

    End If

End Sub

 

' При промяна на Плъзгач за  силата на звука

Private Sub HScroll2_Change()

    SilaZvuk HScroll2.Value ' Задействаме функция за задаване сила равна на стойността на плъзгача

    Label1.Caption = "Сила на звука " & Int(HScroll2.Value / 10) & "%" ' Визуализираме избранта стойност

    Timer4.Enabled = True ' Пускаме таймера следящ за пускане на бутона на мишката

End Sub

 

' Таймер следящ пускане на бутона на мишката след промяна на силата на звука

Private Sub Timer4_Timer()

    If MouseKey = False Then ' Ако бутона на мишката е пуснат

        Command2.SetFocus ' Изпращаме фокуса на бутона за ПАУЗА

        Timer4.Enabled = False ' Спираме Следящия таймер

    End If

End Sub

 

'Празен бутон въведен последен,използва се при натискане на стрелка Наляво или Нагоре

Private Sub Command8_GotFocus()

List1.SetFocus ' При попадане фокуса върху празния бутон, изпращаме фокуса List1, за да сменяме песни със стрелките

End Sub

 

'При извеждане на формата

Private Sub Form_Unload(Cancel As Integer)

    STOPIRANE ' Задействаме процедурата за спиране

End Sub

 

'СОРС ЗА МОДУЛА KontrolMouse

'Декларация на АПИ функция за проверка състоянието на клавиш

Public Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer

 

' Публична функция връщаща TRUE, ако е натиснат левия бутон на мишката

Function MouseKey() As Boolean

    MouseKey = (GetAsyncKeyState(1) And &H8000)

End Function

 

'СОРС ЗА МОДУЛА Player

'Декларираме АПИ функцията за изпращане на команди към библиотеката на windows winmm.dll

Public Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long

Public sFile As String ' Декларираме променлива в която съхраняваме пътя на файла

Public FlagPauza ' Флаг за натисната пауза

Public FileLength As Long  'Декларацияна променлива за дължина на файла в секунди

 

'Функция за за стартиране на звуковия файл

Public Function START(ZvukovFail)

    If FlagPauza <> 1 Then Call mciSendString("Close MM", 0, 0, 0) ' Ако не е натисната паузата първо затваряме действащия файл

    Call mciSendString("Open " & ZvukovFail & " Alias MM", 0, 0, 0) ' Отваряме звуковия файл и го подаваме на winmm.dll

    Call mciSendString("Play MM", 0, 0, 0) ' Подаваме команда за започване на възпроизвеждането на звука

    FlagPauza = 0 ' Нулираме флага за пауза, защото може да е и 1

End Function

 

' Процедура за паузиране

Public Sub PAUZA()

    Call mciSendString("Pause MM", 0, 0, 0) ' Подаваме команда за ПАУЗА

    FlagPauza = 1 ' Променяме флага за ПАУЗА

End Sub

 

' Процедура за стопиране

Public Sub STOPIRANE()

    Call mciSendString("Close MM", 0, 0, 0) ' Подаваме команда за затваряне на звуковия файл

End Sub

 

' Процедура за започване на запис

Public Sub STARTZAPIS()

    Call mciSendString("Close MM", 0, 0, 0) ' Затваряме действащия в момента файл

    Call mciSendString("open new type waveaudio alias capture", 0, 0, 0) ' Отваряме нов файл

    ' Подаваме параметри за запис на файла, който ще записваме

    Call mciSendString("set capture bitspersample 16", 0, 0, 0)

    Call mciSendString("set capture samplespersec 47999", 0, 0, 0)

    Call mciSendString("set capture channels 2", 0, 0, 0)

    Call mciSendString("record capture overwrite", 0, 0, 0) ' Подаваме команда за ЗАПИС

 

End Sub

 

' Процедура за спиране на записа

Public Sub STOPZAPIS()

    Call mciSendString("stop capture", 0, 0, 0) ' Подаваме команда за спиране на записа

    sFile = ImeZaZapis ' Задействаме функция, която да отвори диалогова форма за избор на място и име на новия файл

    Call mciSendString("save capture " + """" + sFile + """", 0, 0, 0) ' Записваме новия файл

    Call mciSendString("close capture", 0, 0, 0) ' Затваряме записвания файл

    Call mciSendString("Close MM", 0, 0, 0) ' Подаваме команда за затваряне на файла към winmm.dll

End Sub

 

' Функция за избор на файл за отваряне

Public Function IzbranFail()

    Set objDialog = CreateObject("MSComDlg.CommonDialog") '

    objDialog.ShowOpen

    If Len(objDialog.FileName) > 1 Then

        IzbranFail = objDialog.FileName

    End If

End Function

 

' Функция за избор на място за запис на файла при записване

Public Function ImeZaZapis()

    Set IzborZaZapis = CreateObject("MSComDlg.CommonDialog")

    IzborZaZapis.FileName = "proba.wav"

    IzborZaZapis.ShowSave

    ImeZaZapis = IzborZaZapis.FileName

End Function

 

' Публична процедура за промяна силата на звука на самия Плеар, а не на компютъра

Public Sub SilaZvuk(Kolko)

    Call mciSendString("setaudio MM volume to " & Kolko, 0, 0, 0)

End Sub

 

'Публична фунция за превъртане на определено време

Public Function setPositionTo(Second As Long)

    Second = Second * 1000 ' Преминаваме в милисекунди, защото така работи функцията

    Call mciSendString("play MM from " & Second, 0, 0, 0) ' Изпращане на съобщение за стартиране от посоченото време

End Function

 

' СОРС НА МОДУЛА ЗА ИЗБОР НА ДИРЕКТОРИЯ

' Декларация на тип

Private Type BrowseInfo

    hWndOwner As Long

    pIDLRoot As Long

    pszDisplayName As Long

    lpszTitle As String

    ulFlags As Long

    lpfnCallback As Long

    lParam As Long

    iImage As Long

End Type

' Декларация на АПИ функции

Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)

Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long

Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long

Private Declare Function GetActiveWindow Lib "user32" () As Long

 

' Същинската фунция за показване на диалогово форма за избор на директория

Public Function BrowseForFolder(Optional sCaption As String = "Select a folder", Optional sDefault As String) As String

    Const BIF_RETURNONLYFSDIRS = 1

    Const MAX_PATH = 260

    Dim lPos As Integer, lpIDList As Long, lResult As Long

    Dim sPath As String, tBrowse As BrowseInfo

 

    With tBrowse

        .hWndOwner = GetActiveWindow

        .lpszTitle = sCaption

        .ulFlags = BIF_RETURNONLYFSDIRS     '

    End With

 

    lpIDList = SHBrowseForFolder(tBrowse)

    If lpIDList Then

        sPath = String$(MAX_PATH, 0)

        SHGetPathFromIDList lpIDList, sPath

        CoTaskMemFree lpIDList

        lPos = InStr(sPath, vbNullChar)

        If lPos Then

            BrowseForFolder = Left$(sPath, lPos - 1)

            If Right$(BrowseForFolder, 1) <> "\" Then

                BrowseForFolder = BrowseForFolder & "\"

            End If

        End If

    Else

        BrowseForFolder = sDefault

    End If

End Function

 

'Публична процедура за зареждане на Listbox с пътища на файлове тип mp3

Public Sub ZarediListbox(ListObekt As ListBox, KoiaPapka)

    Myfile = Dir(KoiaPapka & "\*.mp3") ' Първо търсене, като получаваме пътя на първия намерен файл mp3

    If Myfile = "" Then GoTo dolu ' Ако не е намерено нищо стринга е празен и прескачаме dolu

    ListObekt.AddItem KoiaPapka & Myfile ' В противен случай добавяме намерения файл към List1

    'Цикъл за следващи търсения, до като не се получи празен стринг

    Do While Myfile <> ""

        Myfile = Dir ' Търсим отново задействайки Dir

        If Myfile <> "" Then ' Ако намерим

            ListObekt.AddItem KoiaPapka & Myfile ' Добавяме в List1

        End If

    Loop

    If ListObekt.ListCount > 0 Then ListObekt.ListIndex = 0 ' Отиваме на първата песен от List1

dolu:

End Sub