Russian English
   Basic.net
Среда, 23.09.2020, 02:00
Меню сайта
Категории раздела
Basic [28]
У нас вы можете бесплатно скачать QBasic, VisualBasic, FreeBasic, GW-Basic.
QBasic [4]
Visual Basic [4]
GW-Basic [0]
Игры [1]
FreeBasic [1]
PowerBasic [1]
Облако тегов
Статистика

Онлайн всего: 1
Гостей: 1
Пользователей: 0

Форма входа
Главная » Файлы » Basic

Делаем музыкальный плеер в Visual Basic. Часть 5
Share |
[ Скачать с сервера (1.65 Mb) ]
27.07.2013, 17:13
Ну вообщем все основное, что мы хотели, мы уже сделали. Тут я приведу пару интересных вещей, как можно улучшить ваш проигрыватель.

1. Запуск Windows Media Player.
Мы можем прямо из нашей программы запустить этот проигрыватель и заставить его воспроизводить файл:

Код Visual Basic
1
2
3
4
5
6
7
8
9
10
Private Const SW_SHOWNORMAL = 1
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
  (ByVal hwnd As Long, ByVal lpOperation As String, _
  ByVal lpFile As String, ByVal lpParameters As String, _
  ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
 
Sub OpenWMP ()
On Error Resume Next
ShellExecute 0, "open", Player.URL, 0, 0, SW_SHOWNORMAL
End Sub

Здесь используется API-функция ShellExecuteA из библиотеки "shell32.dll". Вместо Player.URL (параметр функции - lpFile) можно использовать любой другой адрес файла.

2. Поиск информации об аудио-файле в Интернете.
Очень интересная программа, она открывает в браузере поиск самой различной информации о исполнителе, альбоме или записи (введенной пользователем в TextBox, но можно использовать теги нашей записи!):

Код Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
Dim url
Private Declare Function ShellExecute& Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long)
 
Private Sub Command1_Click()
url = "http://music.yandex.ru/#!/search?text=" & Text1.Text
Call ShellExecute(0, "Open", url, "", "c:\", 1)
End Sub
 
Private Sub Command2_Click()
url = "http://video.yandex.ru/search?text=" & Text1.Text
Call ShellExecute(0, "Open", url, "", "c:\", 1)
End Sub
 
Private Sub Command3_Click()
url = "http://myzuka.ru/Search?searchText=" & Text1.Text
Call ShellExecute(0, "Open", url, "", "c:\", 1)
End Sub
 
Private Sub Command4_Click()
url = "http://vk.com/audio?q=" & Text1.Text
Call ShellExecute(0, "Open", url, "", "c:\", 1)
End Sub
 
Private Sub Command5_Click()
url = "http://www.youtube.com/results?search_query=" & Text1.Text
Call ShellExecute(0, "Open", url, "", "c:\", 1)
End Sub
 
Private Sub Command6_Click()
url = "http://www.allmusic.com/search/all/" & Text1.Text
Call ShellExecute(0, "Open", url, "", "c:\", 1)
End Sub
 
Private Sub Command7_Click()
url = "http://en.wikipedia.org/w/index.php?title=" & Text1.Text
Call ShellExecute(0, "Open", url, "", "c:\", 1)
End Sub

3. Поиск обложки альбома/песни.
А эта программа уже не открывает браузер с нудной картинкой - она выводит её прямо в программу из Интернета! Для этого она сначала загружается на диск, потом в программу с диска, а затем удаляется файл с диска.



Нужно разместить компонент Inet1 (Microsoft Internet Transfrom Control 6)!

Код Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
Private Sub Command1_Click()
 
        URL$ = "http://" + Me.List1.Text
 
        fname$ = App.Path & "\123" & Right$(URL$, 4)
 
        DLFiles URL$, fname$
 
        Me.Picture1.Picture = LoadPicture(fname$)
        
        Kill fname$
 
End Sub
 
Public Sub LoadListPic(strUrl As String)
On Error Resume Next
Dim b() As Byte
 
       Me.List1.Clear
 
       Me.Inet1.Cancel
       
       Me.Inet1.Protocol = icHTTP
       
       Inet1.URL = strUrl
       
       b() = Inet1.OpenURL(, icByteArray)
       
       p& = UBound(b, 1)
       
       BigBuf$ = Space$(p& + 1)
       
       For i& = 0 To p&
           Mid$(BigBuf$, i& + 1, 1) = Chr$(b(i&))
       Next i&
       
       ppp& = 1
       
       Do
       
          k& = InStr(ppp&, BigBuf$, "src=")
          
          If k& = 0 Then Exit Do
          
          u& = InStr(k& + 5, BigBuf$, Chr$(34))
       
          Pic$ = Mid$(BigBuf$, k& + 7, u& - k& - 7)
       
          If Right$(Pic$, 4) = ".jpg" Or Right$(Pic$, 4) = ".gif" Or Right$(Pic$, 4) = ".png" Then
             Me.List1.AddItem Pic$
          End If
        
          ppp& = u&
       
       Loop
       
End Sub
 
Public Sub DLFiles(strUrl As String, fileName As String)
On Error Resume Next
Dim b() As Byte
       Me.Inet1.Cancel
       Me.Inet1.Protocol = icHTTP
       Inet1.URL = strUrl
       b() = Inet1.OpenURL(, icByteArray)
       Open fileName For Binary Access Write As #1
       Put #1, , b()
       Close #1
End Sub
 
Private Sub Form_Load()
 
    LoadListPic "http://images.yandex.ru"
 
End Sub

4. Воспроизведение видео.
Наш компонент WMP может воспроизводить и видео!

Есть два способа.

Первый - автоматически сразу на весь экран:

Код Visual Basic
1
2
3
4
5
6
7
8
WindowsMediaPlayer1.URL = "c:\ваш_файл.wmv"
WindowsMediaPlayer1.Controls.play
WindowsMediaPlayer1.uiMode = "none"
WindowsMediaPlayer1.windowlessVideo = True
Do
DoEvents
Loop Until WindowsMediaPlayer1.playState = wmppsPlaying
WindowsMediaPlayer1.fullScreen = True

Второй - полный экран по двойному щелчку:

Код Visual Basic
1
2
3
4
5
6
7
8
Form1.WindowState = 0
WindowsMediaPlayer1.uiMode = "none"
WindowsMediaPlayer1.windowlessVideo = True
WindowsMediaPlayer1.settings.autoStart = False
WindowsMediaPlayer1.settings.volume = 100
WindowsMediaPlayer1.settings.setMode "loop", False
WindowsMediaPlayer1.URL = "c:\ваш_файл.wmv"
WindowsMediaPlayer1.Controls.play
5. Дизайн.
Наш проект следует оформит красиво. В частности можно добавить возможность пользователю выбирать скины формы, например из меню.
Это могут быть как и стандартные цвета:

Private Sub mnuSkinClassic_Click()
Me.Picture = Nothing
Me.BackColor = &HC0C0C0
End Sub

Так и изображения:

Private Sub mnuSkinNotes_Click()
Me.Picture = LoadPicture(App.Path & "\skins\backgrounds\Classical Notes.jpg")
End Sub

Здесь обратите внимания на следующий вещи:
1. Me используется вместо названия текущей формы.
2. Цвет фона формы определяется его свойством BackColor, которое содержит определенную константу.
3. Загрузка изображения выполняется функцией LoadPicture, параметр которой - путь файла.
4. Скины следует поставлять вместе с программой. В этом случае они загружаются из той папки, которая расположена рядом с исполняемым файлом. Путь исполняемого файла - App.Path.

Помимо фона формы, можно изменять и оформления кнопок. Например, у нас на кнопках написано просто Play и Stop, а можно изображать привычные нам треугольник и квадрат. Для этого у кнопок свойство Style = Graphical, Picture - выбираем картинку .ico, которую поставим (я рисовал сам в Borland Delphi 7 Image Editor), при желании ToolTipText ставим пояснение пользователю, который не знает, что эта кнопка будет делать (при наведении на кнопку оно появится).



К этой части статьи прилагается файл setup.exe - то, что у меня получилось. Установщик программы я сделал в программе Inno Setup, поскольку помимо основного исполняемого файла Basic Player.exe, к проекту прилагается иконка программы, значки на кнопках, несколько скинов, файл VERSIONS.txt и README.txt, а также библиотеки comdlg32.ocx и MSCOMCTL.OCX.

На последние 2 файла обратите особенное внимание! Без этих двух библиотек ваш проект не будет работать ни на одном компьютере кроме вашего, потому их следует поставлять вместе с программой - либо в той же папке, что и .exe, либо в System32. Кроме того, их нужно зарегистировать в реестре Windows. Чтобы не делать это вручную, это действие, а также вообще всю установку программы выполняет установщик!

А вот скриншоты получившейся программы:














Категория: Basic | Добавил: Admin
Просмотров: 3315 | Загрузок: 282 | Рейтинг: 5.0/2
Всего комментариев: 0
Добавлять комментарии могут только зарегистрированные пользователи.
[ Регистрация | Вход ]
Поиск
Наш опрос
Какую версию Basic вы предпочитаете?
Всего ответов: 2028

© Basic.ucoz.net, 2020