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

Лидеры

  1. Alex7wrt

    Alex7wrt

    Пользователи


    • Баллы

      3

    • Постов

      508


  2. enatechno

    enatechno

    Пользователи


    • Баллы

      2

    • Постов

      181


  3. krapotkin

    krapotkin

    Пользователи


    • Баллы

      1

    • Постов

      2 185


  4. Fedor K

    Fedor K

    Пользователи


    • Баллы

      1

    • Постов

      55


Популярный контент

Показан контент с высокой репутацией 19.11.2017 во всех областях

  1. Сделал простой пример приложения рации в локальной сети под Android. Реализация через UDP. Буду рад, если кому окажется полезным. Для начала/окончания сеанса связи нужно нажать на окружность Для проверки нужно 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
    3 балла
  2. 2 балла
  3. Посмотрел ваш пример, все зависания и вылеты с ошибками связаны с обращением к пустым объектам, попыткой обработать все в одном обработчике. Исправить клиент дело не благодарное, поэтому сделал пример по работе с TCP сокетом с возможностью автоподключения (тык). Проверил на нескольких устройствах, полет нормальный. Основные замечания: Не используйте FormActivate событие, тем более на мобильной платформе. Его обработка замораживает приложение. В примере посмотрите вариант обхода. TIniFile нет смысла использовать каждый раз для считывания настроек. 1 раз считали при старте приложения и больше к файлу не обращаемся. Хранить настройки в компонентах (edSettingHost.Text и т.п.). Создание свойства отнимет максимум минуту, а выгоду даст существенную. TCP сокет соединения следуют принимать как асинхронные, а не как запрос-ответ. Это предусматривает получение команды сервером, какое-то выполнение и лишь потом отправка на клиент. Поэтому попробуйте отказаться от использования GetFromServer. Сервер только запускал для проверки клиента, пару раз ловил outofmemory и access violation, закрыться тоже не захотел по-хорошему. Поэтому желательно его тоже довести до ума.
    1 балл
  4. procedure RunProgram(cmdStr:string; Wait:Boolean; ShowWindow:Word); var si:TStartupInfo; pi:TProcessInformation; s:string; begin FillChar(si, SizeOf(si), 0); si.cb := SizeOf(si); si.dwFlags:=STARTF_USESHOWWINDOW; si.wShowWindow := ShowWindow; s:=cmdStr; UniqueString(s); getlasterror; if not CreateProcess(nil, PChar(S), NIL, NIL, False, 0, NIL, NIL, si, pi) then showMessageFmt('Ошибка %d. %s',[getlasterror,SysErrorMessage(getlasterror)]); if wait then WaitForSingleObject(pi.hProcess, INFINITE); CloseHandle(pi.hProcess); CloseHandle(pi.hThread); end;
    1 балл
Эта таблица лидеров рассчитана в Москва/GMT+03:00
×
×
  • Создать...