MMORPG Базис

[blackstrip]

Как в Delphi 11 в firemonkey проиграть в TMediaPlayer музыку/звуки из встроенных ресурсов. Чтоб работало и на Windows, и на Android

У TMediaPlayer нет метода "загрузи-ка мне вон тот файл из ресурсов".

Ответ первый - воспользоваться сторонними библиотеками, которые это умеют. Типа давно известной BASS. Ну сторонние компоненты не хочется добавлять, там определенные условия использования и т.п.

Ответ второй - создать свой модуль медиакодека и зарегистрировать его через TMediaCodecManager.RegisterMediaCodecClass под поддельное расширение файла. Собственный медиакодек будет отбрасывать расширение файла и грузить ресурс по имени файла. Описано здесь в ответах - https://stackoverflow.com/questions/362 ... m-resource . Сложновато, всю обвязку городить пусть и на основе примера...

Ответ третий - загрузить из ресурса через LoadResource и потом проигрывать через sndPlaySound, но это не будет работать под андроидом =(

Ответ четвертый - вытащить файл из ресурсов во временную папку и потом указать его плееру через MediaPlayer.FileName.

Код: Выделить всё

var
rest:TResourceStream;
fil:string;
begin
  rest := TResourceStream.Create(hInstance, 'mustit', RT_RCDATA);
  fil:=TPath.GetPublicPath+TPath.DirectorySeparatorChar+'mustit.mp3';
  rest.SaveToFile(fil);
  rest.Free;
  MediaPlayer1.FileName:=fil;
  MediaPlayer1.Play();
end;

Временная папка (или "публичная") по TPath.GetPublicPath, как пишут в помощи https://docwiki.embarcadero.com/Librari ... PublicPath , находится:
Windows XP: C:\Documents and Settings\All Users\Application Data
Windows Vista и новее: C:\ProgramData (там хорошо бы создать подпапку для вашей программы, но можно кидать и просто в эту папку как в примере наверху)
Android: /storage/emulated/0/Android/data/<application ID>/files

Все вытаскивается из ресурсов и проигрывается на ура. Главное потом не забыть удалить эти файлы (особенно если это какие-то огромные музыкальные или видео-файлы) чтоб они не занимали место у пользователя после закрытия вашей программы.

Если подумать, то кроме мелких звуков придется грузить и среднюю по размеру музыку, и огромные по размеру видеофайлы (катсцены). Хранить все это в памяти тяжеловато. Временная папка с файлом - решение получше. Видимо поэтому MediaPlayer и проигрывает только из файлов, а не из памяти.

Чтоб играть музыку и звуки одновременно - кидаем на форму несколько MediaPlayer. Заранее в них грузим через MediaPlayer.FileName:='путь и имя файла' файлы (в каждый медиаплеер свой файл). И когда нужно их проиграть вызываем для конкретного плеера перемотку назад и проигрывание:

Код: Выделить всё

MediaPlayer1.CurrentTime:=0;
MediaPlayer1.Play;

Звучащая музыка и звуки с разных плееров сами миксуются и попадают в общий аудиопоток на ваши колонки ПК/динамики телефона.

Чтоб зациклить музыку раньше было событие onNotify, которое вызывалось при смене статуса с Playing на Stopped или другой. В Firemonkey такого события что-то не видно у медиаплеера. Т.к. программа в постоянном цикле отрисовки, то в конец цикла можно добавить проверку на запуск музыки снова если она доигралась до конца:

Код: Выделить всё

if MediaPlayer1.State=TMediaState.Stopped then
begin
MediaPlayer1.CurrentTime:=0;
MediaPlayer1.Play;
end;

[blackstrip]

EXE от Delphi 11 работает на Windows XP и выше (если в PE заголовке заменить в настройках Delphi минимальную версию ОС с 6.0 на 5.1. А если заменить на 4.0, то даже в Windows 98 пытается запуститься, сначала ищет DirectX 9, его еще можно поставить, а потом спотыкается на отсутствии Unicode-функций в Windows-овских DLL-ках. Так что минимальная версия - Windows XP).

Опытным путем было установлено, что 32-битные EXE-шники, сделанные в Delphi 11, работают на Windows XP SP3. А если запустить на Windows XP SP2 - то ошибка и вылет. Установка на тот Windows пакета SP3 исправила вылет - программа заработала и на нем.

[blackstrip]

Обработка неожиданных ошибок (необработанных нормально по try...except) в Delphi 11 работает по-старому.

В начале проги пишем

Код: Выделить всё

Application.OnException:=ExceptHandle;

И отдельно прописываем процедуру ExceptHandle:

Код: Выделить всё

procedure TForm1.ExceptHandle(Sender: TObject; E: Exception);
var
mes:string;
excad:string;
f:Text;
filn:string;
begin
  excad := Format('%p',[ExceptAddr]);
  mes:='ERROR: '+E.Message+'/'+Sender.ClassName+'/'+excad;
  filn:=TPath.GetPublicPath+TPath.DirectorySeparatorChar+'basiserr.txt';
  AssignFile(f,filn);
  if FileExists(filn) then Append(f) else Rewrite(f);
  WriteLn(f,mes);
  CloseFile(f);

  showerrortext:=mes;
  showerror:=true;
end;

В ней сначала получаем адрес исключения, потом сообщение об исключении и имя класса, в котором произошло исключение. По адресу (при включенной генерации отладочного MAP файла) можно узнать по внутренностям MAP файла где конкретно произошла ошибка в исходном коде.

Выкидываем ошибку в общую папку в файл basiserr.txt (на случай если всё совсем рухнуло, или переполнилось и не хватает памяти даже на отрисовку экрана), а заодно и пробуем вывести ее на экране. Например, если нет файла mp3-музыки, указанной медиаплееру в filename, то на экране останется такая одинокая надпись об ошибке и останется только закрыть игру.

[blackstrip]

Delphi 11 официально не поддерживает Windows XP, но созданные в Delphi 11 проги работают на нем (как выше писалось) если подправить минимальную версию ОС в PE-заголовке на 5.1:


Если в Firemonkey рисовать на TPlane3D размером ровно с окно (в basis это по умолчанию 320x320 пикселей), проекцию камеры формы сделать не камерой, а просто вперед куда смотрим при разработке формы (UsingDesignCamera выставить в True), то можно рисовать попиксельно как на обычном рисунке.

В Windows 10 все отрисовывается хорошо:


В Windows XP все отрисовывается странно - в правой нижней части окна пиксели сбиты:


Затекстурим TPlane3D такой шахматной текстурой чтобы посмотреть что происходит с отрисовкой:


Видим вот такое:


TPlane3D как просто 3D объект состоит из двух треугольников, первый треугольник рисуется хорошо (но, кстати, сдвинут на один пиксель по горизонтали и вертикали от верхнего-левого угла формы), а правый вообще плохо. Текстура сбивается и рисуется страшно.

Загрузим текстуру с клетками 2x2 пикселя:


Видим вот такое:


Искажения те же. Посмотрим теперь что происходит с минилиниями. Закрасим разноцветными горизонтальными и вертикальными линиями крупные клетки на текстуре:


Вот что стало с линиями:


На исходной текстуре клетки кончались белой линией. В окошке этих белых линий (горизонтальных снизу и вертикальных справа) не видно, они срезались.

Увеличиваем окно на 1 пиксель по горизонтали и вертикали, ClientWidth и ClientHeight делаем равными 321. И все сразу выправляется как надо. Белые линии справа и внизу в клетках становятся видны, искажения пропадают:


Итог: в Windows XP картинка сдвинута на один пиксель вправо и вниз. Верхний горизонтальный и левый вертикальный ряды точек повторяют соседние (вторые ряды). Delphi пытается масштабировать картинку 320x320 пикселей до оставшегося места 319x319, и текстура искажается.

Чтобы влезло все - надо увеличить область отрисовки на один пиксель - в данном случае, с 320 до 321. Тогда в TImage3D будет растр из двух ненужных рядов пикселей (сверху и слева), а потом наша картинка 320x320 пикселей.

На рендере стартового экрана после этого увеличения окна тоже все рисуется без искажений:


На всякий случай, тест в Windows 7 - там и при 320x320 (без увеличения) все рисуется без искажений:


Вставляем код исправления в Form.Create при загрузке игры - увеличиваем окно для Windows XP (версия у него 5.1, пропишем меньше 6, т.е. младше висты):

Код: Выделить всё

if TOSVersion.Platform=pfWindows then
begin
  if TOSVersion.Major<6 then
  begin
  Form1.ClientWidth:=321;
  Form1.ClientHeight:=321;
  end;
end;

Теперь отрисовка идет одинаково корректно и в Windows XP, и в Windows 10, и в Windows 7.

Билд с возможностью выбора языка кликом на планету, с шипением ракеты при нажатии на любое место на экране (проверка микширования звука и музыки), с выводом ошибок, с корректной отрисовкой в Windows XP (увеличенное на один пиксель окно):
Win32: http://blackstrip.ru/tmp/basisd11/basis.exe
Android: http://blackstrip.ru/tmp/basisd11/basis.apk

На андроиде имя пакета изменено с com.embarcadero.basis на com.bss.basis, поэтому ставится рядом с предыдущей версией, а не обновляет ее (будет как отдельная вторая прога). Поэтому старую версию вручную удалить надо.

[blackstrip]

Как узнать язык системы в Firemonkey

Что под Android, что под Windows - после первого запуска игры нужно узнать язык системы и автоматически выставить его в игре (чтоб не было что англичанину выдается русский интерфейс).

Простая функция, узнающая язык системы. Если не удалось узнать, то выставляем просто en (английский). Если удалось - то в результате будет пара букв, обозначающая язык системы.

Код: Выделить всё

function TForm1.GetCurrentLocale():string;
var
LocServ: IFMXLocaleService;
begin
  if TPlatformServices.Current.SupportsPlatformService(IFMXLocaleService,IInterface(LocServ)) then result := LocServ.GetCurrentLangID() else result:='en';
end;

В игре всего два языка интерфейса - русский (0) и английский (1). Для россиян, украинцев и белорусов ставим русский, а для остальных английский с помощью этого кода:

Код: Выделить всё

lang:=GetCurrentLocale();
if (lang='ru') or (lang='uk') or (lang='be') then Lg.CurLang:=0 else Lg.CurLang:=1;

При последующих запусках после первого запуска надо уже грузить из сохраненных настроек язык, который был при последнем выходе из игры.

[blackstrip]

Временная папка (или "публичная") по TPath.GetPublicPath, как пишут в помощи https://docwiki.embarcadero.com/Librari ... PublicPath , находится:
Windows XP: C:\Documents and Settings\All Users\Application Data
Windows Vista и новее: C:\ProgramData (там хорошо бы создать подпапку для вашей программы, но можно кидать и просто в эту папку как в примере наверху)
Android: /storage/emulated/0/Android/data/<application ID>/files

Храним файлы цивилизованно в публичной папке

Если посмотреть в папку C:\Program Data на Windows 10, то увидим что каждая программа создает там подпапку для себя (например, "Blizzard Entertainment", "Microsoft"). Basis пока что клал файлы прямо в ее корень и подпапки своей не имел.

В Android же /storage/emulated/0/Android/data/<application ID>/files это собственная папка программы и можно класть файлы в ее корень, что basis и делает.

Функция, создающая подпапку фирмы-производителя программ (BSS), и внутри нее папку программы (Basis) в публичной папке Windows (если этих папок там нет) и возвращающая путь к этой папке программы со слэшем на конце (C:\ProgramData\BSS\Basis\). А для Android просто возвращающая путь к папке программы со слэшем на конце (/storage/emulated/0/Android/data/<application ID>/files/).

Т.к. basis для двух платформ - Windows и Android, то будем проверять Windows ли у нас - и если нет, то будем считать это андроидом. Если писать программу для большего числа платформ, то нужно отдельно проверять if TOSVersion.Platform=pfWindows then ... else if TOSVersion.Platform=pfAndroid then ... else if TOSVersion.Platform=pf<другая платформа> then... и т.д.

Код: Выделить всё

function TForm1.GetPublicFolder():string;
var
toppath:string;
winpath:string;
begin
  toppath:=TPath.GetPublicPath+TPath.DirectorySeparatorChar;
  if TOSVersion.Platform=pfWindows then
  begin
    //windows
    winpath:=toppath+'BSS';
    if not TDirectory.Exists(winpath,false) then TDirectory.CreateDirectory(winpath);
    winpath:=winpath+TPath.DirectorySeparatorChar+'Basis';
    if not TDirectory.Exists(winpath,false) then TDirectory.CreateDirectory(winpath);
    result:=winpath+TPath.DirectorySeparatorChar;
  end
  else
  begin
    //android
    result:=toppath;
  end;
end;

В начале программы сохраняем эту папку в переменную

Код: Выделить всё

pubfold:=GetPublicFolder();

Теперь пользуемся ею везде, например, для распаковки музыки из ресурсов:

Код: Выделить всё

rest := TResourceStream.Create(hInstance, 'mustit', RT_RCDATA);
fil:=pubfold+'mustit.mp3';
rest.SaveToFile(fil);
rest.Free;

[blackstrip]

При последующих запусках после первого запуска надо уже грузить из сохраненных настроек язык, который был при последнем выходе из игры.

Сохраняем настройки в публичной папке

При выходе из игры (в событии запроса на закрытие главной формы Form3DCloseQuery) записываем вызов сохранения настроек SaveSettings()

В самой процедуре SaveSettings записываем открытие файла settings.txt с перезаписью и запись всех настроек по очереди. Пока что это две настройки - язык интерфейса и логин, а потом можно будет туда добавить все другие настройки игры:

Код: Выделить всё

procedure TForm1.SaveSettings();
var
f:Text;
s:string;
begin
  AssignFile(f,pubfold+'settings.txt');
  Rewrite(f);
  //CurLang
  s:=IntToStr(Lg.CurLang);
  WriteLn(f,s);
  //login
  s:=login;
  WriteLn(f,s);
  CloseFile(f);
end;

Загружаем настройки из публичной папки

При запуске игры в Form3DCreate после стартовой инициализации (например, выбора языка интерфейса по текущему языку системы и др.) записываем вызов загрузки настроек из файла settings.txt LoadSettings()

В процедуре LoadSettings записываем открытие файла settings.txt для чтения и загрузку всех настроек в той же очередности что и в SaveSettings с проверкой корректности загружаемых значений (мало ли кто подкрутит settings.txt - чтоб игра не вылетала с ошибками после загрузки кривых или битых настроек):

Код: Выделить всё

procedure TForm1.LoadSettings();
var
f:Text;
s:string;
begin
  if not FileExists(pubfold+'settings.txt') then exit;
  AssignFile(f,pubfold+'settings.txt');
  Reset(f);
  try
    //CurLang
    ReadLn(f,s);
    Lg.CurLang:=StrToInt(s);
    if (Lg.CurLang<0) or (Lg.CurLang>1) then Lg.CurLang:=1;    
    //login
    ReadLn(f,s);
    login:=s;
    CloseFile(f);
  except
    CloseFile(f);
  end;
end;