Перейти к содержанию
Fire Monkey от А до Я
  • 0

Локальная рация, Android, пример


Alex7wrt

Вопрос

Сделал простой пример приложения рации в локальной сети под Android. Реализация через UDP. 

Буду рад, если кому окажется полезным.

Для начала/окончания сеанса связи нужно нажать на окружность

Screenshot_2017-11-18-21-12-26-443_com.embarcadero.Project5.thumb.png.1c7b66db773caff541a943b8a7b09d9b.pngScreenshot_2017-11-18-21-12-31-104_com.embarcadero.Project5.thumb.png.7cb018ff8c34cbad623f730535e672e5.png

Для проверки нужно 2 телефона

unit Unit5;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
  FMX.Controls.Presentation, FMX.StdCtrls, IdUDPServer, IdBaseComponent,
  IdComponent, IdUDPBase, IdUDPClient, IdGlobal, IdSocketHandle, Androidapi.JNI.Media,
  Androidapi.JNI.JavaTypes, Androidapi.JNIBridge, AndroidApi.JNI, AndroidApi.Helpers,
  FMX.Objects, System.Math;

type
  TForm1 = class(TForm)
    Circle: TCircle;
    procedure ServerUDPRead(AThread: TIdUDPListenerThread; const AData: TIdBytes; ABinding: TIdSocketHandle);
    procedure FormCreate(Sender: TObject);
    procedure CircleTap(Sender: TObject; const Point: TPointF);
  end;

  TSendThread = class(TThread)
    protected
    procedure Execute;  override;
  end;

var
  Form1: TForm1;
  SendThread: TSendThread;
  Server: TIdUDPServer;
  audioRecord: JaudioRecord;
  audiotrack: JAudioTrack;
  recording: boolean;
  buffer_Size, port,ch_in, ch_out, format, freq, source: integer;

implementation

{$R *.fmx}

procedure TSendThread.Execute;
var buffer: TJavaArray<Byte>;
begin
    buffer := TJavaArray<Byte>.create(buffer_size);
    while recording do begin
        audioRecord.read(buffer,0,buffer_size);
        Server.Broadcast(TIDBytes(TJavaArrayToTBytes(buffer)),port);
    end;
    buffer.Free;
end;

procedure TForm1.CircleTap(Sender: TObject; const Point: TPointF);
begin
    recording:= not recording;
    if recording then begin
        Circle.Fill.Color:=TAlphaColors.Red;
        Server.OnUDPRead:=nil;
        audiorecord.startRecording;
        SendThread:=TSendThread.Create;
    end
    else begin
        Circle.Fill.Color:=TAlphaColors.Gray;
        audiorecord.stop;
        Server.OnUDPRead:=ServerUDPRead;
    end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
    buffer_size:=2048; freq:=8000; port:=5555;
    Server:=TIdUdpServer.Create(Form1);
    with Server do begin
        BufferSize:=buffer_size;
        DefaultPort:=port;
        BroadCastEnabled:=true;
        Active:=true;
        OnUDPRead:=ServerUDPRead;
    end;

    Circle.Width:=min(Screen.Width,Screen.Height)*0.7;
    Circle.Height:=Circle.Width;

    ch_in:=TJAudioFormat.JavaClass.CHANNEL_IN_MONO;
    ch_out:=TJAudioFormat.JavaClass.CHANNEL_OUT_MONO;
    format:=TJAudioFormat.JavaClass.ENCODING_PCM_16BIT;
    source:=TJMediaRecorder_AudioSource.JavaClass.MIC;

    audioRecord := TJAudioRecord.JavaClass.init(source, freq, ch_in, format, buffer_size);
    audiotrack:=TJAudioTrack.JavaClass.init(3, freq, ch_out, format, buffer_size,1);
end;

procedure TForm1.ServerUDPRead(AThread: TIdUDPListenerThread; const AData: TIdBytes; ABinding: TIdSocketHandle);
begin
    audiotrack.write(TBytesToTJavaArray(TBytes(AData)),0,Length(AData));
    audiotrack.play;
end;

end.

 

radio.zip

Изменено пользователем Alex7wrt
Ссылка на комментарий

Рекомендуемые сообщения

  • 0

Думаю, что можно. Просто для моих целей достаточно общения в пределах одной сети.

Единственное, что пока по моей оценке где-то 5% пакетов теряется. Пока не понял почему так.

Ссылка на комментарий
  • 0
12 минуты назад, Alex7wrt сказал:

Думаю, что можно. Просто для моих целей достаточно общения в пределах одной сети.

Единственное, что пока по моей оценке где-то 5% пакетов теряется. Пока не понял почему так.

Ну так UDP же

Ссылка на комментарий
  • 0
18 часов назад, Alex7wrt сказал:

Думаю, что можно. Просто для моих целей достаточно общения в пределах одной сети.

Единственное, что пока по моей оценке где-то 5% пакетов теряется. Пока не понял почему так.

Блестящая работа! Простой и красивый код!

Потеря пакетов обусловлена (скорее всего) статичным buffer_size, на разных устройствах он может быть разным и правильнее его размер получать вот так

  buffer_size:= TJAudioTrack.JavaClass.getMinBufferSize(PSampleRateHz,
                                            TJAudioFormat.JavaClass.CHANNEL_OUT_MONO,
                                            TJAudioFormat.JavaClass.ENCODING_PCM_16BIT);
  if (buffer_size = TJAudioTrack.JavaClass.ERROR) then
    Exit;
  if (buffer_size = TJAudioTrack.JavaClass.ERROR_BAD_VALUE) then
    Exit;

Еще конечно бы двойную буферизацию для записи/воспроизведения

Так же можно сразу запустить проигрывание audiotrack.play в FormCreate, реальные звуки будут проигрываться и так:

procedure TForm1.ServerUDPRead(AThread: TIdUDPListenerThread; const AData: TIdBytes; ABinding: TIdSocketHandle);
begin
    audiotrack.write(TBytesToTJavaArray(TBytes(AData)),0,Length(AData));
end;

 

Ссылка на комментарий
  • 0
В 18.11.2017 в 22:01, Alex7wrt сказал:

procedure TForm1.FormCreate(Sender: TObject); begin buffer_size:=2048; freq:=8000; port:=5555; Server:=TIdUdpServer.Create(Form1); with Server do begin BufferSize:=buffersize; DefaultPort:=port; BroadCastEnabled:=true; Active:=true; OnUDPRead:=ServerUDPRead; end;

with Server do begin BufferSize:=buffersize  ???

 

with Server do begin BufferSize:=buffer_size

Ссылка на комментарий

Присоединяйтесь к обсуждению

Вы можете написать сейчас и зарегистрироваться позже. Если у вас есть аккаунт, авторизуйтесь, чтобы опубликовать от имени своего аккаунта.

Гость
Ответить на вопрос...

×   Вставлено с форматированием.   Вставить как обычный текст

  Разрешено использовать не более 75 эмодзи.

×   Ваша ссылка была автоматически встроена.   Отображать как обычную ссылку

×   Ваш предыдущий контент был восстановлен.   Очистить редактор

×   Вы не можете вставлять изображения напрямую. Загружайте или вставляйте изображения по ссылке.

  • Последние посетители   0 пользователей онлайн

    • Ни одного зарегистрированного пользователя не просматривает данную страницу
×
×
  • Создать...