AngryOwl

Сделал простой пример приложения рации в локальной сети под 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

Я бы поменял их местами.
Несколько странно сперва уничтожать объект, а потом обращаться к его полям и методам...

Передавать Frame надо по ссылке, вот так:
FreeFrame(var Frame: TFrame);

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

Наткнулся тут на изящную штуку для приложения с PUSH уведомлениями на Android и Ios. Один объект, все сам делает.
Внедрил в одно боевое приложение с 100+ тысячами установок, полет нормальный.
Описание тут https://delphiworlds.com/2017/04/firebase-cloud-messaging-android-ios/
Исходный код с примером на гитхабе https://github.com/DelphiWorlds/PushClient
Использование максимально простое:
uses DW.PushClient; .... private FPushClient: TPushClient; procedure PushClientChangeHandler(Sender: TObject; AChange: TPushService.TChanges); procedure PushClientReceiveNotificationHandler(Sender: TObject; const ANotification: TPushServiceNotification); .... procedure TFormMain.InitPushService; begin FPushClient := TPushClient.Create; FPushClient.GCMAppID := ConstGCMAppID; FPushClient.ServerKey := ''; FPushClient.BundleID := ''; FPushClient.UseSandbox := Debug; // Change this to False for production use! FPushClient.OnChange := PushClientChangeHandler; FPushClient.OnReceiveNotification := PushClientReceiveNotificationHandler; try FPushClient.Active := True; except SendError('FPushClient.Active Exception'); end; end; procedure TFormMain.PushClientChangeHandler(Sender: TObject; AChange: TPushService.TChanges); begin if TPushService.TChange.DeviceToken in AChange then begin HDevicePushParams.DeviceID:=FPushClient.DeviceID; HDevicePushParams.DeviceToken:=FPushClient.DeviceToken; GetHTTP(CommandRegisterFCM); // Memo1.Lines.Add('DeviceID = ' + FPushClient.DeviceID); // Memo1.Lines.Add('DeviceToken = ' + FPushClient.DeviceToken); end; end; procedure TFormMain.PushClientReceiveNotificationHandler(Sender: TObject; const ANotification: TPushServiceNotification); begin // ShowMessage(ANotification.DataObject.ToString... end; Правда руки не дошли разобраться для чего ему 
  FPushClient.ServerKey := '';
  FPushClient.BundleID := '';
Но и без этого работает.
 

Ну вот! Я же говорил как-то - жаль нельзя поставить "Мне нравится" несколько раз!
Кто-то тут плачется все время, "вдруг Delphi умрет" ... "Delphi уже мертв" ... "FMX не сегодня завтра умрет" ...
Я программирую на Pascal с 91го года. Начинал c Turbo Pascal 5.0. И с тех пор мне пытаются втереть "погромизды" - что Pascal/Delphi давно умер ... Тоже самое касается среды RAD Studio.
Так вот благодаря таким людям как Ярослав, Андрей, Равиль и многим многим другим, он не только не умер. Он еще и, в большинстве случаев!, даст форы многим другим языкам и IDE.
Так-что еще раз спасибо за решение проблемы! (скажите мне - в каких средах или языках их (проблем) нет! ))))

Отредактировать стиль. Например, добавив новый для "прозрачного" TMemo.
Что-то типа такого:
  object TLayout     StyleName = 'memofreestyle'     EnableDragHighlight = False     Position.X = 280.000000000000000000     Position.Y = 249.000000000000000000     Size.Width = 290.000000000000000000     Size.Height = 175.000000000000000000     Size.PlatformDefault = False     Visible = False     TabOrder = 97     object TActiveStyleObject       StyleName = 'background'       Align = Contents       EnableDragHighlight = False       Size.Width = 290.000000000000000000       Size.Height = 175.000000000000000000       Size.PlatformDefault = False       ActiveTrigger = Focused       ActiveLink = <         item           CapInsets.Left = 7.000000000000000000           CapInsets.Top = 7.000000000000000000           CapInsets.Right = 7.000000000000000000           CapInsets.Bottom = 7.000000000000000000           SourceRect.Left = 238.000000000000000000           SourceRect.Top = 86.000000000000000000           SourceRect.Right = 318.000000000000000000           SourceRect.Bottom = 113.000000000000000000         end>       SourceLink = <>       object TRectangle         StyleName = 'Rectangle1'         Align = Contents         EnableDragHighlight = False         Fill.Color = x32000000         HitTest = False         Sides = []         Size.Width = 290.000000000000000000         Size.Height = 175.000000000000000000         Size.PlatformDefault = False         Stroke.Color = xC8282828         Visible = False       end       object TLayout         StyleName = 'content'         Align = Client         EnableDragHighlight = False         Size.Width = 290.000000000000000000         Size.Height = 175.000000000000000000         Size.PlatformDefault = False       end     end     object TBrushObject       StyleName = 'foreground'     end     object TBrushObject       StyleName = 'selection'       Brush.Color = x7F67A8D3     end     object TFontObject       StyleName = 'font'     end   end

Темный текст на светлом

Отмечу, что сталкивался с такой проблемой - То работает запуск приложения на смартфоне, то не работает, то странности возникают еще при деплоее на смартфон... В общем скажу просто - проблема была в кабеле. Самое интересное, что при подключении смартфон "виделся", и вроде бы все ок, но постоянные глюки при запуске приложения привели к одному решению - смена кабеля и все заработало.
Не скажу, что это панацея, но я в своей практике уже трижды сталкивался с подобным. Кабель может работать на подзарядке, и даже при работе с устройством в плане чтения и записи фалов, через проводник, но будет "глючить" при более "тонкой" работе.

Golovanyuk, такое случается, когда кабель не достаточно хорошего качества/расшатан разъем/кастомная прошивка + недостаточно прав на телефоне. Если приложение первый раз запускается - то проблема не в настройках IDE.
Попробуйте сделать следующее:
Подключите телефон по USB Перейдите в папку platform-tools, лежит в Android SDK. У меня например такой путь: F:\18.0\PlatformSDKs\android-sdk-windows\platform-tools. Откройте окно команд (зажимаете "Shift" + правая кнопка мыши -> "Открыть окно команд").  Выполните "adb devices" - отобразиться список подключенных устройств. Выполните "adb shell su 0 setenforce 0" - на телефоне может появится окно запроса прав.

Подобный вопрос уже задавался тут, но ответа так не последовало.
А вопрос достаточно актуальный, так как решения не удалось найти.
Как отловить событие изменения размера клавиатуры, когда после первого отображения клавиатуры и попытки набора текста появляется некий дополнительный прямоугольник с подсказками по набору текста?
Последовательность следующая:
1. без клавиатуры
2. появляется клавиатура при получении фокуса компонентом ввода текста (все ОК)
3. при первом же введенном символе появляется дополнительная область клавиатуры с предлагаемыми вариантами набора текста (баг - клавиатура перекрывает поле ввода)
4. при последующих вызовах клавиатуры (все ок)

Добрый вечер. Скоро будет полностью подготовлен.

Мне помогло следующее:
TThread.Synchronize(nil, procedure begin memoChatMessage.Text := ' '; memoChatMessage.SelectAll; memoChatMessage.DeleteSelection; end);  

Вот тут скорее всего как раз про это 
 

Типы координат
В FIreMonkey различают три вида координат:
Локальные - это координаты в системе координат контрола.  Абсолютные - это координаты в системе координат клиентской части формы. Экранные - это координаты в системе координат экрана. Соответственно, если речь идет о форме, то позиция формы задается в экранных координатах.
Если речь идет о контролах, то в локальных координатах своего родительского контрола.
 
Конвертация
Локальные -> Абсолютные
TControl.LocalToAbsolute(TPointF): TPointF Абсолютные -> Локальные
TControl.AbsoluteToLocal(TPointF): TPointF Абсолютные -> Экранные
TControl.Scene.LocalToScreen(TPointF): TPointF; Экранные -> Локальные
TControl.Scene.ScreenToLocal(TPointF): TPointF;

Добрый день.
Andrey Yefimov в своем блоге подробно описал получение событий жизненного цикла приложения, в том числе и потерю активности.
http://delphifmandroid.blogspot.com/2013/10/blog-post.html
function TForm1.HandleAppEvent(AAppEvent: TApplicationEvent; AContext: TObject): Boolean; begin case AAppEvent of TApplicationEvent.BecameActive: Log('Became Active'); TApplicationEvent.EnteredBackground: Log('Entered Background'); TApplicationEvent.WillBecomeForeground: Log('Will Become Foreground'); end; Result := True; end; procedure TForm1.FormCreate(Sender: TObject); var aFMXApplicationEventService: iFMXApplicationEventService; begin ............ if TPlatformServices.Current.SupportsPlatformService(IFMXApplicationEventService, IInterface(aFMXApplicationEventService)) then aFMXApplicationEventService.SetApplicationEventHandler(HandleAppEvent); ............ end;

В общем можно сделать, конечно, установку шрифта в инсталлере программы. И это будет оптимальным решением.
Но можно обойтись и без него.
Не буду расписывать детали, просто закину приложение и фрагменты кода. Думаю разберетесь. Естественно изменив на свои шрифты и т.п.
Все нижеперечисленное - в файл проекта DPR, перед Application.Initialize;
const CKey = '\Software\Microsoft\Windows NT\CurrentVersion\Fonts'; CFontFileName = 'spherelive.ttf'; CFontName = 'spherelive (TrueType)'; procedure ExecuteWait(const sProgramm: string; const sParams: string = ''; fHide: Boolean = false); var ShExecInfo: TShellExecuteInfo; begin FillChar(ShExecInfo, sizeof(ShExecInfo), 0); with ShExecInfo do begin cbSize := sizeof(ShExecInfo); fMask := SEE_MASK_NOCLOSEPROCESS; lpFile := PChar(sProgramm); lpParameters := PChar(sParams); lpVerb := 'open'; if (not fHide) then nShow := SW_SHOW else nShow := SW_HIDE end; try if (ShellExecuteEx(@ShExecInfo) and (ShExecInfo.hProcess <> 0)) then try WaitForSingleObject(ShExecInfo.hProcess, INFINITE) finally CloseHandle(ShExecInfo.hProcess); end; except On E : Exception do ShowMessage('font install Exception: ' + E.Message); end; end; if not IsFontRegistered(TPath.Combine(ExtractFilePath(ParamStr(0)), CFontFileName), CFontName) then if FileExists(TPath.Combine(ExtractFilePath(ParamStr(0)), 'RegFontC.exe')) then ExecuteWait(TPath.Combine(ExtractFilePath(ParamStr(0)), 'RegFontC.exe')); Application.Initialize; Где будет лежать файл со шрифтом - это уже ваше дело. Можно его куда угодно поместить. Хоть в ресурсы, хоть файлом просто, хоть с инета скачать.
P.S. Ну и конечно - это все именно под винду...
RegFont.zip

Вот вариант, его можно применять в любом месте (обычно в OnCreateForm), не обязательно в DPR. 
Флаг можно добавлять и удалять.     
Для обычного запрета выключать экран нужен только лишь флаг FLAG_KEEP_SCREEN_ON, остальные не нужны.
 
Для Tokyo и возможно поздних версий, CallInUIThread не нужен.
{$IFDEF ANDROID}   procedure TurnOnAndKeepScreenAndroid(aEnable: boolean);   var     vFlags: integer;   begin     vFlags := TJWindowManager_LayoutParams.JavaClass.FLAG_TURN_SCREEN_ON or         TJWindowManager_LayoutParams.JavaClass.FLAG_DISMISS_KEYGUARD or         TJWindowManager_LayoutParams.JavaClass.FLAG_SHOW_WHEN_LOCKED or         TJWindowManager_LayoutParams.JavaClass.FLAG_KEEP_SCREEN_ON;     if aEnable then     begin       CallInUIThread (   // uses FMX.Helpers.Android       procedure       begin         TAndroidHelper.Activity.getWindow.setFlags (vFlags, vFlags);       end );     end     else       CallInUIThread (       procedure       begin         TAndroidHelper.Activity.getWindow.clearFlags (vFlags);       end );   end;   {$ENDIF}
 

Дело в том, что TComboBox лишь контейнер, вам нужно обращаться именно к списку элементов в ListBox. Чтобы запретить перевод можно поступить так:
var i, count : integer; begin count := cbbFiles.Count - 1; for i := 0 to count do cbbFiles.ListBox.ListItems[i].AutoTranslate := False; end;  

Ура! Я победил проблему. Причем с помощью почти забытой мной процедуры FindFirst ;-) Код работает корректно под Windows и Android. Файл не передергивается, антивирус спокоен.
function TFileManager.GetFileSize(APath : String) : String; Var AFileSizeByte : Int64;     AFileSizeFloat : Double;     SearchRec : TSearchRec;     FileAttrs: Integer; begin   FileAttrs :=faArchive;   FileAttrs := FileAttrs + faAnyFile;   Result:='unknow';   AFileSizeByte:=0;   try     FindFirst(APath,FileAttrs,SearchRec);     AFileSizeByte:=SearchRec.Size;     FindClose(SearchRec);   except       Exit;   end;   if AFileSizeByte<1024 then   begin     Result:=Format('%d',[AFileSizeByte])+' Byte';     Exit;   end;   if AFileSizeByte<1048576 then   begin     AFileSizeFloat:=AFileSizeByte/1024;     Result:=Format('%6.3f',[AFileSizeFloat])+' KByte';     Exit;   end;   if AFileSizeByte<1073741824 then   begin     AFileSizeFloat:=AFileSizeByte/1048576;     Result:=Format('%6.3f',[AFileSizeFloat])+' MByte';     Exit;   end;   AFileSizeFloat:=AFileSizeByte/1073741824;   Result:=Format('%6.3f',[AFileSizeFloat])+' GByte'; end;

function FileSize(const aFilePath: string): Int64; var   vSR : TSearchRec; begin   if FindFirst(aFilePath, faAnyFile, vSR ) = 0 then   begin     Result := vSR.Size;     FindClose(vSR);   end   else      Result := -1; end; Мультиплатформенный вариант без открытия файла (размер берется из файловой системы).

Добрый день!
Думаю что "суть" здесь ни при чем. Я думал, при создании примера, об ошибке, возникшей у Вас, а не о деталях того как "раскрывается"...
Однако, если я правильно Вас понял, то Вам просто нужно заменить код процедуры в примере который я приложил к предыдущему комментарию.
 
код процедуры
procedure TForm2.ListBox1ItemClick(const Sender: TCustomListBox; const Item: TListBoxItem); заменить на
procedure TForm2.ListBox1ItemClick(const Sender: TCustomListBox; const Item: TListBoxItem); var   i, j : Integer; begin   for i := 0 to TCustomListBox(Sender).Items.Count - 1 do     if TListBoxItem(TCustomListBox(Sender).ListItems[i]) <> Item then     begin       if TListBoxItem(TCustomListBox(Sender).ListItems[i]).Height <> 0 then         TListBoxItem(TCustomListBox(Sender).ListItems[i]).AnimateFloat('Height', 0, 0.3);     end else     if TListBoxItem(Item).Height = 32 then       TListBoxItem(Item).AnimateFloat('Height', TListBoxItem(Item).HelpContext, 0.3)       else       for j := 0 to TCustomListBox(Sender).Items.Count - 1 do         if TListBoxItem(TCustomListBox(Sender).ListItems[j]).Height <> 32 then           TListBoxItem(TCustomListBox(Sender).ListItems[j]).AnimateFloat('Height', 32, 0.3); end; И будет Вам счастье...
А уж с "высотами" - играйтесь сами, как Вам  требуется.
 
P.S. И, кстати, поймите правильно - разбираться детально в том, что Вам нужно, Вам придется самому. Я лишь показал пример как это работает (без ошибок вроде) и, практически, так как Вам надо и в двух вариантах. А условия того как что должно "сворачиваться" и "раскрываться" поставьте сами. Мне кажется все достаточно просто и прозрачно.

Я поступил проще - на Токио пока даже и не пробовал переходить... Берлин работает, как работает - устраивает. Пока Токио не допилят, пока об этом все не напишут, и пока не появится как минимум первый апдейт - даже и пробовать не буду.
Политика Embarcadero мне понятна. Искренне надеюсь, что им хватит ума и бюджета на то, чтобы развивать продукт. Оставался и остаюсь приверженцем Delphi, и во многих случаях ему просто нет объективной замены/альтернативы. Но кидаться "в омут" (на каждую новую версию) - желания нет.

// uses FMX.Platform var LocaleService: IFMXLocaleService; ... if TPlatformServices.Current.SupportsPlatformService(IFMXLocaleService, IInterface(LocaleService)) then     Result := LocaleService.GetCurrentLangID; ...