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

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

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