unit uOBS_Doc_Player;
interface
uses
System.SysUtils, System.Classes, Web.HTTPApp, FMX.Types,
FMX.Controls3D, FMX.Objects3D, FMX.Controls, FMX.Forms, FMX.StdCtrls,
FMX.Edit, FMX.ListBox, uPlayerThread, bass_simple;
type
TOBS_Doc_Player = class(TWebModule)
procedure WebModule1DefaultHandlerAction(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure TrackBar1Change(Sender: TObject);
procedure WebModuleCreate(Sender: TObject);
procedure WebModuleDestroy(Sender: TObject);
private
{ Private declarations }
function gethtml(): string;
procedure AddToListBox(Text: String);
procedure DelFromListBox(Text: String);
procedure add(const aTitle: string);
procedure del(const aTitle: string);
{ Private declarations }
public
{ Public declarations }
end;
var
OBS_Doc_Player: TComponentClass = TOBS_Doc_Player;
Button1: TButton;
Button2: TButton;
ProgressBar1: TProgressBar;
TrackBar1: TTrackBar;
ListBox1: TListBox;
b: TBassSimple;
player: TPlayerThread;
mVolume: Integer;
isplay: string;
mySoundPath: string;
implementation
{%CLASSGROUP 'FMX.Controls.TControl'}
{$R *.dfm}
{ TOBS_Doc_Player }
function GetPathToTestExe: string; // вернет папку romaming
begin
Result := GetEnvironmentVariable('APPDATA');
if Result <> '' then
Result := IncludeTrailingPathDelimiter(Result);
end;
procedure TOBS_Doc_Player.add(const aTitle: string);
begin
AddToListBox(aTitle);
end;
procedure TOBS_Doc_Player.AddToListBox(Text: String);
begin
if ListBox1.Items.IndexOf(Text) = -1 then
ListBox1.Items.add(Text);
end;
procedure TOBS_Doc_Player.Button1Click(Sender: TObject);
begin
b.Pause;
if isplay = '0' then
isplay := '1'
else
isplay := '0'
end;
procedure TOBS_Doc_Player.Button2Click(Sender: TObject);
begin
player.Skip;
end;
procedure TOBS_Doc_Player.del(const aTitle: string);
begin
DelFromListBox(aTitle);
end;
procedure TOBS_Doc_Player.DelFromListBox(Text: String);
var
i: Integer;
begin
Application.ProcessMessages;
i := ListBox1.Items.IndexOf(Text);
if i <> -1 then
if i <= ListBox1.Items.Count - 1 then
ListBox1.Items.Delete(i);
Application.ProcessMessages;
end;
function TOBS_Doc_Player.gethtml: string;
var
s: string;
i: Integer;
playIcon: string;
begin
// Определяем иконку в зависимости от состояния
if isplay = '1' then
playIcon := 'fa-pause'
else
playIcon := 'fa-play';
// Собираем элементы ListBox в строку
s := '';
for i := 0 to ListBox1.Items.Count - 1 do
s := s + '' + ListBox1.Items[i] + '';
// Генерация HTML-страницы с обновленными значениями
Result := '' + 'Web Radio' +
''
+ '' +
'' + '' +
'' + '' +
'' +
'' + '
' +
'' + '' +
'' + '
' +
'' +
'' + '' +
'';
end;
procedure TOBS_Doc_Player.TrackBar1Change(Sender: TObject);
begin
mVolume := Round(TrackBar1.Value);
b.Volume := mVolume;
end;
procedure TOBS_Doc_Player.WebModule1DefaultHandlerAction(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
VolumeStr: string;
VolumeValue, i: Integer;
begin
if Request.PathInfo = '/getSongs' then
begin
// Возвращаем список песен в формате JSON
var
songList: string := '[';
for i := 0 to ListBox1.Items.Count - 1 do
begin
songList := songList + '"' + ListBox1.Items[i] + '"';
if i < ListBox1.Items.Count - 1 then
songList := songList + ',';
end;
songList := songList + ']';
Response.Content := songList; // Отправляем JSON
Response.ContentType := 'application/json;charset=utf8';
Handled := True;
Exit;
end;
if Request.PathInfo = '/setVolume' then
begin
// Получаем значение из параметра 'value'
VolumeStr := Request.QueryFields.Values['value'];
// Пробуем преобразовать в целое число
if TryStrToInt(VolumeStr, VolumeValue) then
begin
// Если удалось преобразовать, обновляем переменную mVolume
mVolume := VolumeValue;
// Обновляем звук на сервере (если нужно, например, через библиотеку bass)
b.Volume := mVolume;
// Возвращаем обновленное состояние на страницу
Response.Content := gethtml;
end
else
begin
// Если не удалось преобразовать, возвращаем ошибку
Response.Content := 'Invalid volume value';
end;
Handled := True; // Запрос обработан
Exit;
end;
if Request.PathInfo = '/button1' then
begin
Button1Click(Sender); // Вызов процедуры для кнопки 1
Response.Content := gethtml;
Handled := True; // Указываем, что запрос был обработан
Exit;
end;
if Request.PathInfo = '/button2' then
begin
Button2Click(Sender); // Вызов процедуры для кнопки 2
Response.Content := gethtml;
Handled := True; // Указываем, что запрос был обработан
Exit;
end;
Response.Content := gethtml;
Handled := True;
end;
procedure TOBS_Doc_Player.WebModuleCreate(Sender: TObject);
begin
mySoundPath := GetPathToTestExe + 'TTW_Bot\ytSongs';
b := TBassSimple.Create(0);
player := TPlayerThread.Create(b, mySoundPath);
player.OnAddAd := add;
player.OnSkip := del;
mVolume := 0;
ListBox1 := TListBox.Create(self);
player.Start;
isplay := '1';
end;
procedure TOBS_Doc_Player.WebModuleDestroy(Sender: TObject);
begin
player.Free;
b.Free;
ListBox1.Free;
end;
end.