Понадобилось в одном проекте добавлять возможность проигрывания mp3 в документах TrichView в качестве контрола. Написал, пока что в черновом варианте, простой OneSongMp3Player на bass.dll. Здесь опишу создание в качестве отдельной программы, чуть позже, в качестве отдельного компонента. А ещё чуть позже допишу остальной функционал плеера, уж больно это затягивающее занятие. А библиотека bass.dll к этому располагает!
Скачиваем bass.dll
Это можно сделать на разных сайтах, я скачал отсюда. Прямая ссылка для скачивания под WIndows находится здесь. В результате у нас получится следующее. Глаз радуется, когда видишь папочку delphi!
Как видно – в этой директории находится файл bass.dll – он нам понадобится!
Внутри папки delphi, кроме кучи интересных примеров находится файл bass.pas
Всего для работы нам понадобятся файлы bass.dll и bass.pas. Я их положил в папку с программой – ограничился самым простым вариантом.
Структура проекта
Структура проекта получилась следующей. Файлы исходников можно скачать далее.
Файлы исходников
Скачать файлы исходников
Проектирование
В принципе, лучше всего читать код и справку, но некоторые моменты поясню. При проектировании программа выглядит таким образом.
В качестве элемента управления временем выбран стандартный scrollbar – его возможностей вполне хватило для реализации основного функционала. Кнопки Play, Stop, Pause, Restart это TSpeedButton – они связаны одним GroupIndex. Кнопка Loop также TSpeedButton. Если она нажата, то при достижении конца трека – он начинается сначала.
MainUnit
Подключение библиотеки bass через uses – просто добавляем в папку с проектом bass.dll и bass.pas и пишем в uses BASS
Также, второй момент – с расчетом времени. Я сначала сихрофазотронил, но потом упростил – написал одну процедуру для расчета всех необходимых времен (CountTime) и добавил её к событию таймера, а также на всё кнопки. Функция рассчитывает всё время трека, оставшееся и прошедшее. Значения записываются в поля. класса формы как строковые значения и оттуда считываются в лабели.
На FormCreate стоит пара проверок, которые фигурируют во всех примерах библиотеки bass.dll.
|
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 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 |
unit MainUnit; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,BASS, Vcl.StdCtrls, Vcl.ExtCtrls,uTime, Vcl.Buttons,Math, uDMButtonImages; type TMainForm = class(TForm) OpenDialog: TOpenDialog; TimeScrollBar: TScrollBar; MainTimer: TTimer; lAllTime: TLabel; lRemainingTime: TLabel; lEllapsedTime: TLabel; Label1: TLabel; Label2: TLabel; Label3: TLabel; VolumeScrollBar: TScrollBar; Bevel2: TBevel; lVolume: TLabel; bOpen: TBitBtn; bLoop: TSpeedButton; Bevel1: TBevel; bPlay: TSpeedButton; bStop: TSpeedButton; bPause: TSpeedButton; bRestart: TSpeedButton; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure bOpenClick(Sender: TObject); procedure bPlayClick(Sender: TObject); procedure bRestartClick(Sender: TObject); procedure bPauseClick(Sender: TObject); procedure MainTimerTimer(Sender: TObject); procedure TimeScrollBarScroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer); procedure VolumeScrollBarScroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer); procedure bLoopClick(Sender: TObject); procedure bStopClick(Sender: TObject); private FStream:HSTREAM; FTrack:boolean; FTime:TDMTime; FSecondsAtAll:integer; //Всё время трека в секундах FRemainingSeconds:integer; // Оставшееся время, после перемотки в секундах FEllapsedSeconds:integer; // Прошедшее время в секундах FAllTime:string; FRemainingTime:string; // Оставшееся время, для вывода в Label FEllapsedTime:string; // Прошедшее время, для вывода в Label FEnableLoop:boolean; //Включатель Loop FdmButtonImages:TdmButtonImages; procedure CountTime; procedure Loop; procedure LoadButtonImages; { Private declarations } public { Public declarations } end; var MainForm: TMainForm; implementation {$R *.dfm} //--------------------------FormCreate------------------------------------------ procedure TMainForm.FormCreate(Sender: TObject); begin ReportMemoryLeaksOnShutdown:=true; FdmButtonImages:=TdmButtonImages.Create(Self); // модуль загрузки картинок из ресурсов LoadButtonImages; // <<Загрузка картинок из ресурсов FEnableLoop:=false; // check the correct BASS was loaded if (HIWORD(BASS_GetVersion) <> BASSVERSION) then begin MessageBox(0,'An incorrect version of BASS.DLL was loaded',0,MB_ICONERROR); Halt; end; // Initialize BASS with the default device if not BASS_Init(-1, 44100, 0, handle, nil) then begin showmessage('Could not initialize BASS'); Exit; end; FTime:=TDMTime.Create(Self); //Установка громкости Bass_SetVolume(0.5); VolumeScrollBar.Position:=50; end; //-----------------------FormDestroy-------------------------------------------- procedure TMainForm.FormDestroy(Sender: TObject); begin BASS_Free; end; //------------------Рассчет времени--------- ----------------------------------- procedure TMainForm.CountTime; // Всё время трека // Оставшееся время // Истекшее время var kRemaining,kEllapsed:double; // коэфф-ты оставшегося и прошедшего времени HAtAll,MAtAll,SAtAll:integer; HRemaining,MRemaining,SRemaining:integer; HEllapsed,MEllapsed,SEllapsed:integer; begin FSecondsAtAll:=FTime.qbass_gettime(fstream); kRemaining:=(TimeScrollBar.Max-TimeScrollBar.Position)/TimeScrollBar.Max; kEllapsed:=TimeScrollBar.Position/TimeScrollBar.Max; FRemainingSeconds:=round(kRemaining*FSecondsAtAll); FEllapsedSeconds:=round(kEllapsed*FSecondsAtAll); //Рассчет всего времени HAtAll := FSecondsAtAll div 3600; SAtAll := FSecondsAtAll mod 3600; MAtAll := SAtAll div 60; MAtAll := MAtAll + (HAtAll * 60); SAtAll := (SAtAll mod 60); FAllTime:=Format('%2.2d:%2.2d:%2.2d', [HAtAll ,MAtAll, SAtAll]); // Рассчет оставшегося времени HEllapsed := FEllapsedSeconds div 3600; SEllapsed := FEllapsedSeconds mod 3600; MEllapsed := SEllapsed div 60; MEllapsed := MEllapsed + (HEllapsed * 60); SEllapsed := (SEllapsed mod 60); FEllapsedTime:=Format('%2.2d:%2.2d:%2.2d', [HEllapsed ,MEllapsed, SEllapsed]); // Рассчет прошедшего времени HRemaining := FRemainingSeconds div 3600; SRemaining := FRemainingSeconds mod 3600; MRemaining := SRemaining div 60; MRemaining := MRemaining + (HRemaining * 60); SRemaining := (SRemaining mod 60); FRemainingTime:=Format('%2.2d:%2.2d:%2.2d', [HRemaining ,MRemaining, SRemaining]); //Обновляем лабели lAllTime.Caption:=FAllTime; lRemainingTime.Caption:=FRemainingTime; lEllapsedTime.Caption:=FEllapsedTime; end; //----------------------Открытие файла------------------------------------------ procedure TMainForm.bOpenClick(Sender: TObject); var filepath:PChar; SecondsAtAll:DWORD; begin if not OpenDialog.Execute then exit; if FStream<>0 then BASS_StreamFree(fstream); filepath:=PChar(OpenDialog.FileName); Fstream:=BASS_StreamCreateFile (false, //mem, если true, тогда из проигрывание из памяти filepath, 0, 0, 0 {$IFDEF UNICODE} or BASS_UNICODE {$ENDIF} ); if FStream=0 then showmessage('Ошибка, файл не загружен') else Self.Caption:=Extractfilename(OpenDialog.FileName); //Настраиваем ScrollBar TimeScrollBar.Min:=0; TimeScrollBar.Max:=BASS_ChannelGetLength(fstream,0)-1; TimeScrollBar.Position:=0; //Настраиваем счетчик времени CountTime; //Автозапуск файла при открытии bPlay.Click; bPlay.Down:=true; end; //-------------------Пауза------------------------------------------------------ procedure TMainForm.bPauseClick(Sender: TObject); begin BASS_ChannelPause(FStream); CountTime; end; //-------------------Play------------------------------------------------------- procedure TMainForm.bPlayClick(Sender: TObject); begin if Fstream=0 then exit; BASS_ChannelPlay(Fstream,false); // Start MainTimer.Enabled:=true; end; //------------------Restart----------------------------------------------------- procedure TMainForm.bRestartClick(Sender: TObject); begin BASS_ChannelPlay(Fstream,true); // Start //FTime.Timer.Enabled:=true; MainTimer.Enabled:=true; CountTime; bPlay.Down:=true; end; //------------------------STOP-------------------------------------------------- procedure TMainForm.bStopClick(Sender: TObject); begin //Обнуляем поток и скроллбар BASS_ChannelStop(Fstream); BASS_ChannelSetPosition(fstream,0,0); TimeScrollBar.Position:=0; CountTime; end; procedure TMainForm.LoadButtonImages; begin bOpen.Glyph.Assign(FdmButtonImages.OpenImage.Picture.Bitmap); bOpen.Caption := ''; bPlay.Glyph.Assign(FdmButtonImages.PlayImage.Picture.Bitmap); bPlay.Caption := ''; bStop.Glyph.Assign(FdmButtonImages.StopImage.Picture.Bitmap); bStop.Caption := ''; bPause.Glyph.Assign(FdmButtonImages.PauseImage.Picture.Bitmap); bPause.Caption := ''; bRestart.Glyph.Assign(FdmButtonImages.RestartImage.Picture.Bitmap); bRestart.Caption := ''; bLoop.Glyph.Assign(FdmButtonImages.LoopImage.Picture.Bitmap); bLoop.Caption := ''; end; procedure TMainForm.Loop; begin if FRemainingSeconds=0 then // showmessage('ScrollBar.Max'); //if ScrollBar.Position=ScrollBar.Max then //showmessage('ScrollBar.Max'); bRestart.Click; end; procedure TMainForm.TimeScrollBarScroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer); begin if ScrollCode=scEndScroll then begin BASS_ChannelSetPosition(fstream,TimeScrollBar.Position,0); FTrack:=false; CountTime; end else FTrack:=true; end; procedure TMainForm.VolumeScrollBarScroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer); var Volume:single; begin Volume:=(1-(VolumeScrollBar.Position/VolumeScrollBar.Max)); lVolume.Caption:=RoundTo(Volume*100,-2).ToString+'%'; BASS_SetVolume(Volume); end; procedure TMainForm.MainTimerTimer(Sender: TObject); begin CountTime; lAllTime.Caption:=FAllTime; lRemainingTime.Caption:=FRemainingTime; lEllapsedTime.Caption:=FEllapsedTime; if ftrack=false then TimeScrollBar.Position:=BASS_ChannelGetPosition(fstream,0); //Проверка Loop if FEnableLoop then Loop; end; procedure TMainForm.bLoopClick(Sender: TObject); begin if FEnableLoop then FEnableLoop:=false else FEnableLoop:=true; end; end. |
Дополнительный модуль для расчета всего времени трека в секундах
|
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 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 |
unit uTime; //Рассчитывает всё время трека //Переводит число секунд в нужный формат interface uses System.SysUtils, System.Classes,bass, Vcl.ExtCtrls; type TDMTime = class(TDataModule) private { Private declarations } public // Получение тотального времени трека function qbass_gettime(const Channel: DWORD): DWORD; //Общее число секунд function qbass_formattime(const Sec: Integer; //Разбиение на mm:ss const IsURL: boolean): string; { Public declarations } end; var DMTime: TDMTime; implementation {%CLASSGROUP 'Vcl.Controls.TControl'} {$R *.dfm} //-----Получает всё время трека в секундах-------------------------------------- function TDMTime.qbass_gettime(const Channel: DWORD): DWORD; var pPos: Cardinal; AllTime: Cardinal; begin Result := 0; pPos := BASS_ChannelGetLength(Channel, BASS_POS_BYTE); if (pPos > 0) then begin Alltime := Trunc(BASS_ChannelBytes2Seconds(Channel, pPos)); Result := Alltime; end; end; //---Переводит секунды в формат * RESULT: " 99:99" | "999:99" * | " Radio" * // Эта функция не понадобилась function TDMTime.qbass_formattime(const Sec: Integer; const IsURL: boolean): string; (******************************************* * RESULT: " 99:99" | "999:99" * | " Radio" * *******************************************) const time = ' 00:00'; radio = ' Radio'; null = ' '; var H, M, S: Integer; Return: string; begin if Sec = -1 then Return := null else if Sec < 0 then Return := time else if IsURL then Return := radio else begin H := Sec div 3600; S := Sec mod 3600; M := S div 60; M := M + (H * 60); S := (S mod 60); if M > 99 then Return := Format('%2.2d:%2.2d:%2.2d', [H ,M, S]) else Return := Format('%2.2d:%2.2d:%2.2d', [H, M, S]); end; Result := Return; end; end. |
Модуль загрузки картинок из ресурсов в память
|
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 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 |
unit uDMButtonImages; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,BASS, Vcl.StdCtrls, Vcl.ExtCtrls; type TDMButtonImages = class(TDataModule) procedure DataModuleCreate(Sender: TObject); private FOpenImage:TImage; FPlayImage:TImage; FStopImage:TImage; FPauseImage:TImage; FRestartImage:TImage; FLoopImage:TImage; { Private declarations } public property OpenImage:TImage read FOpenImage write FOpenImage; property PlayImage:TImage read FPlayImage write FPlayImage; property StopImage:TImage read FStopImage write FStopImage; property PauseImage:TImage read FPauseImage write FPauseImage; property RestartImage:TImage read FRestartImage write FRestartImage; property LoopImage:TImage read FLoopImage write FLoopImage; { Public declarations } end; var DMButtonImages: TDMButtonImages; implementation {%CLASSGROUP 'Vcl.Controls.TControl'} {$R *.dfm} procedure TDMButtonImages.DataModuleCreate(Sender: TObject); var rs:TResourceStream; twic:twicimage; begin twic:=twicimage.Create; FOpenImage:=TImage.Create(Self); FPlayImage:=TImage.Create(Self); FStopImage:=TImage.Create(Self); FPauseImage:=TImage.Create(Self); FRestartImage:=TImage.Create(Self); FLoopImage:=TImage.Create(Self); if FindResource(0,'fileopen_id',PChar(RT_RCDATA))<>0 then begin rs:=TResourceStream.Create(0,'fileopen_id',PChar(RT_RCDATA)); twic.LoadFromStream(rs); FOpenImage.Picture.Bitmap.Assign(twic); FreeAndNil(rs); end; if FindResource(0,'play_id',PChar(RT_RCDATA))<>0 then begin rs:=TResourceStream.Create(0,'play_id',PChar(RT_RCDATA)); twic.LoadFromStream(rs); FPlayImage.Picture.Bitmap.Assign(twic); FreeAndNil(rs); end; if FindResource(0,'stop_id',PChar(RT_RCDATA))<>0 then begin rs:=TResourceStream.Create(0,'stop_id',PChar(RT_RCDATA)); twic.LoadFromStream(rs); FStopImage.Picture.Bitmap.Assign(twic); FreeAndNil(rs); end; if FindResource(0,'pause_id',PChar(RT_RCDATA))<>0 then begin rs:=TResourceStream.Create(0,'pause_id',PChar(RT_RCDATA)); twic.LoadFromStream(rs); FPauseImage.Picture.Bitmap.Assign(twic); FreeAndNil(rs); end; if FindResource(0,'restart_id',PChar(RT_RCDATA))<>0 then begin rs:=TResourceStream.Create(0,'restart_id',PChar(RT_RCDATA)); twic.LoadFromStream(rs); FRestartImage.Picture.Bitmap.Assign(twic); FreeAndNil(rs); end; if FindResource(0,'loop_id',PChar(RT_RCDATA))<>0 then begin rs:=TResourceStream.Create(0,'loop_id',PChar(RT_RCDATA)); twic.LoadFromStream(rs); FLoopImage.Picture.Bitmap.Assign(twic); FreeAndNil(rs); end; //Освобождение FreeAndNil(twic); end; end. |
Тестируем работу плеера!
