Alisson R Oliveira

В Delphi для усиления звука записи можно воспользоваться классом TAudioCaptureDevice и его свойством Volume. Это свойство позволяет установить уровень громкости для записи звука. Чем выше значение Volume, тем громче будет записанный звук.
Вот пример, как можно использовать свойство Volume:
 
uses FMX.AudioCapture, System.SysUtils; procedure RecordAudio(const AFileName: string; const AVolume: Single); var AudioCapture: TAudioCaptureDevice; begin AudioCapture := TAudioCaptureDevice.Create(nil); try AudioCapture.FileName := AFileName; AudioCapture.PauseLength := 0; AudioCapture.Volume := AVolume; // Установка уровня громкости AudioCapture.Active := True; Sleep(5000); // Запись в течение 5 секунд AudioCapture.Active := False; finally AudioCapture.Free; end; end; procedure TForm1.Button1Click(Sender: TObject); begin // Задайте путь и имя файла, в который будет сохранен звук // Укажите значение громкости от 0 до 1 (например, 0.5 для половины максимальной громкости) RecordAudio('/sdcard/MyRecording.wav', 0.8); ShowMessage('Запись завершена.'); end; В этом примере в процедуре RecordAudio добавлен дополнительный параметр AVolume, который позволяет задать уровень громкости записи. Значение AVolume должно быть в диапазоне от 0 до 1, где 0 соответствует минимальной громкости, а 1 - максимальной.
Вы можете экспериментировать с различными значениями AVolume, чтобы найти наиболее подходящий уровень усиления звука для вашего приложения и устройства.

Может это поможет
function CalcTextSize(text: string; Font: TFont; Size: single = 0): TSizeF; var TextLayout: TTextLayout; begin TextLayout := TTextLayoutManager.DefaultTextLayout.Create; try TextLayout.BeginUpdate; try TextLayout.text := text; TextLayout.MaxSize := TPointF.Create(9999, 9999); TextLayout.Font.Assign(Font); if not SameValue(0, Size) then begin TextLayout.Font.Size := Size; end; TextLayout.WordWrap := False; TextLayout.Trimming := TTextTrimming.None; TextLayout.HorizontalAlign := TTextAlign.Leading; TextLayout.VerticalAlign := TTextAlign.Leading; finally TextLayout.EndUpdate; end; Result.Width := TextLayout.Width; Result.Height := TextLayout.Height; finally TextLayout.DisposeOf; TextLayout := nil; end; end;  

все-таки вернусь к логической загадке ARC
1. если вы все ссылки на объект обнулили, то вызывать его деструктор не требуется, его вызовут за вас
2. если не все обнулили, но вызвали деструктор, значит имеем нехилую вероятность того, что кто-то, у кого осталась ссылка, обратится по ней к объекту. тогда мы имеем гарантированный AV
3. Тогда зачем все эти варианты с DisposeOF ???
 
У меня вся программа на фреймах построена, и ничего, создаются удаляются. При этом отлаживаюсь я в Win64, а потом запускаю на Andoird. И все работает штатно в обоих случаях. 
Единственное отличие, я обычно не указываю владельца (Owner). Т.е.  F:=TMyFrame.Create(NIL)
После использования сам убираю за собой
F.Parent:=NIL;
FreeAndNil(F)
и все норм. 

В некоторых фреймах еще большинство компонентов в динамике создается и пересоздается. и тоже никаких явных вызовов деструктора.
Так что лучше все-таки следовать архитектуре, а не раскладывать костылики...

Как изменить качество (Quality) изображения? Написал такую функцию, но она не работает
procedure ChangeQuality( SrcBitmap: TBitmap; var DstBitmap: TBitmap; AQuality: Integer ); var   Stream: TStream;   Surface: TBitmapSurface;   SaveParam: TBitmapCodecSaveParams; begin    if Assigned( DstBitmap ) then    begin       //DstBitmap.SetSize( SrcBitmap.Width, SrcBitmap.Height );       Stream := TMemoryStream.Create;       Surface := TBitmapSurface.Create;       try         Surface.Assign( SrcBitmap );         SaveParam.Quality := AQuality; // AQuality = 65         TBitmapCodecManager.SaveToStream( Stream, Surface, '.jpg', @SaveParam );         Stream.Position := 0;         DstBitmap.LoadFromStream( Stream );       finally         Surface.Free;         Stream.Free;       end;    end; end;

https://github.com/Spelt/ModernListView

как-то так
uses System.RegularExpressions; ... const AHREF = '<a href="([^"]*)"[^>]*>([^<]*)</a>'; var Match: TMatch; s: String; begin Match := TRegEx.Match(ваша HTML строка, AHREF); while Match.Success do begin // здесь что-то делаем //<a href"...>...</a> в Match.Value //Match.Groups[1] - адрес ссылки //Match.Groups[2] - отображаемый текст ссылки Match := Match.NextMatch; end; end  

Разобрался, надо добавить  пермишин) Всем большое спасибо 

1. В Сервисе можно исползовать компонент LocationSensor?
2. Почему мой программа толко один раз получить координату в сервисе а потом не получается? 
Заранее благодарю за ответ!

Спасибо вам большое. И правда, перемудрил, вот так работает:
 

Введение
Появление экранов повышенной плотность физических точек, привело с одной стороны к проблеме адаптации графического интерфейса под разные разрешения экранов при их одинаковых физических размерах, с другой к увеличению четкости и качества картинки.
 
Например, если раньше на iPhone 3 при размере экрана 3,5 дюйма позволял отобразить 320х480 точек, то на устройстве iPhone 4 при таком же физическом размере экрана, экран мог уже отображать 640х960 точек. Это хорошо видно на увеличенном изображении обычного экрана и ретина экрана на рисунке ниже (слева - не ретина, справа - ретина (2х)). Справа количество физических точек ровно в четыре раза больше, чем слева:

 
Для разработчика это могло означать, что интерфейс привязанный к разрешению 320х480 на Retina экране будет занимать только четверть экрана. Естественно, что использование разрешения экрана в физических координатах не удобно с этой точки зрения. Именно по этому появились логические координаты, которые гарантируют, что тот же пользовательский интерфейс для iPhone 3, будет иметь такие же размеры (физические) и на экране с ретиной.
 
FireMonkey работает в логических координатах. Это означает, что на iPhone 3 - 4 мы работаем с логическим разрешением 320x480 точек. Однако, при отображении интерфейса на iPhone 4 c (с двойной плотностью пикселей по сравнению с iPhone 3), интерфейс автоматически масштабируется на физическое разрешение 640х960 с коэффициентом масштабирования равным 2. 
 
Практика
Теперь посмотрим, как получить всю эту информацию. Вся информация об экране (логический размер и коэффициент масштабирования) находится в сервисе IFMXScreenService. 
Чтобы получить физическое разрешение экрана, нужно логический размер умножить на коэффициент масштабирования.
 
Код ниже показывает, как получить доступ к этому сервису и извлечь требуемые параметры:
var ScreenService: IFMXScreenService; LogicScreenSize: TPoint; ScreenScale: Single; begin // Запрашиваем сервис экрана, для получения информации о размере и текущем коэффициенте масштабирования if TPlatformServices.Current.SupportsPlatformService(IFMXScreenService, IInterface(ScreenService)) then begin LogicScreenSize := ScreenService.GetScreenSize.Round; ScreenScale := ScreenService.GetScreenScale; LabelLogicScreenSize.Text := Format('Логический размер: %d, %d', [LogicScreenSize.X, LogicScreenSize.Y]); LabelPhysicScreenSize.Text := Format('Физический размер: %f, %f', [LogicScreenSize.X * ScreenScale, LogicScreenSize.Y * ScreenScale]); LabelScreenScale.Text := Format('Коэффициент масштабирования: %f',[ScreenService.GetScreenScale]); end; end; Результат кода приведен на снимке экранов ниже для iPad устройств с ретиной экраном и без:

У большинства пользователей, если не у всех, эти параметры, касаемо адреса, будут занулены.
Без интернета и API (того же гугла) этот вопрос не решить.
 

Поменялась логика работы грида. Теперь он самостоятельно отрисовывает ячейки и не создает для каждой ячейки отдельный контрол. Поэтому старый способ работать не будет.
 
Новый вариант решения - это самостоятельно нарисовать ячейку грида:
uses FMX.TextLayout, System.UIConsts; procedure TForm2.Grid1DrawColumnCell(Sender: TObject; const Canvas: TCanvas; const Column: TColumn; const Bounds: TRectF; const Row: Integer; const Value: TValue; const State: TGridDrawStates); const HorzTextMargin = 2; VertTextMargin = 1; var TextLayout : TTextLayout; TextRect: TRectF; begin // Здесь определяем какую ячейку будем перерисовывать if (Column = StringColumn1) and (Row = 1) then begin TextRect := Bounds; TextRect.Left := TextRect.Left + 1; TextRect.Bottom := TextRect.Bottom -1; TextRect.Inflate(-HorzTextMargin, -VertTextMargin); Canvas.FillRect(TextRect, 0, 0, AllCorners, 1); TextLayout := TTextLayoutManager.DefaultTextLayout.Create; try TextLayout.BeginUpdate; try TextLayout.WordWrap := False; TextLayout.Opacity := Column.AbsoluteOpacity; TextLayout.HorizontalAlign := StringGrid1.TextSettings.HorzAlign; TextLayout.VerticalAlign := StringGrid1.TextSettings.VertAlign; TextLayout.Trimming := TTextTrimming.Character; TextLayout.TopLeft := TextRect.TopLeft; TextLayout.Text := Value.ToString; TextLayout.MaxSize := PointF(TextRect.Width, TextRect.Height); { Пользовательские настройки отрисовки } TextLayout.Font.Family := 'Times New Roman'; TextLayout.Font.Style := [ TFontStyle.fsBold ]; TextLayout.Font.Size := 14; TextLayout.Color := claBlueViolet; finally TextLayout.EndUpdate; end; TextLayout.RenderLayout(Canvas); finally TextLayout.Free; end; end; end;

Нужно:
Повесить обработчик события на ручную отрисовку ячеек: TGrid.OnDrawColumnCell: В обработчике в зависимости от требуемой строки или данных, нарисовать задний фон ячейки Затем поверх выполнить обычное отображение содержимого ячейки  type TOpenColumn = class (TColumn); procedure TForm8.StringGrid1DrawColumnCell(Sender: TObject; const Canvas: TCanvas; const Column: TColumn; const Bounds: TRectF; const Row: Integer; const Value: TValue; const State: TGridDrawStates); begin if Row mod 2 = 0 then begin // Выполняем закраску заднего фона Canvas.Fill.Color := TAlphaColorRec.Aliceblue; Canvas.FillRect(Bounds, 0, 0, AllCorners, 1); // Рисуем поверх обычное отображение содержимого ячейки TOpenColumn(Column).DefaultDrawCell(Canvas, Bounds, Row, Value, State); end; end; Для этого примера, у меня получилось так:

Доброго времени суток! в твоем коде делфя ругается на эту строчку
"  MergeBitmap(aFrames[Index].Bitmap, aDisplay, aFrames[Index].Bitmap.Bounds, aFrames[Index].FPos.X, aFrames[Index].FPos.Y);"
а конкретно на" aFrames[Index].Bitmap.Bounds"
подскажи что не так плз...чет не могу разобраться

Ссылка: http://yaroslavbrovin.ru/new-approach-of-development-of-firemonkey-control-control-model-presentation-part-2-tedit-with-autocomplete-ru/ Автор: Ярослав Бровин 2 часть статьи о новом подходе разработки визуальных компонентов в FireMonkey. Содерит практическую часть по созданию своего представления. В качестве примера, добавляется функция автозавершения ввода для стандатного компонента TEdit.

var Player: JMediaPlayer; Единожды создаете плеер и готовите файл:
Player:=TJMediaPlayer.Create; Player.setDataSource(StringToJString('Путь_к_файлу')); Player.prepare; И, когда потребуется, запускаете воспроизведение
Player.start; В uses нужно добавить что-то из этого:
FMX.Helpers.Android, Androidapi.Helpers, Androidapi.JNI.GraphicsContentViewText, Androidapi.JNI.Media, Androidapi.JNI.JavaTypes, Androidapi.JNI.AdMob, Androidapi.JNI.App, Androidapi.JNIBridge, FMX.Advertising, FMX.Platform.Android, Androidapi.JNI.Embarcadero Не помню уже, что именно. Ненужные уберите

Накидал вам функцию (проверил - работает):
unit Unit1; interface uses System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, System.JSON, System.NetEncoding, System.IOUtils; type TForm1 = class(TForm) procedure FormCreate(Sender: TObject); private { Private declarations } public { Public declarations } function ExtractPDFContentBase64(const AJSONString : String; out AFileName : String) : boolean; end; var Form1: TForm1; implementation {$R *.fmx} function TForm1.ExtractPDFContentBase64(const AJSONString : String; out AFileName : String) : boolean; Var AJSONObject, AJSONObjectBody, AJSONObjectNextStep : TJSONObject; ACode : Integer; AStreamSource, AStreamDest : TMemoryStream; ADecodeByteCount : Integer; ABase64 : String; begin // Выставляем результат функции в False Result:=False; // Парсим JSON строку в JSON объект AJSONObject:=TJSONObject(TJSONObject.ParseJSONValue(AJSONString)); if Not Assigned(AJSONObject) then exit; // Проверям поле code на предмет содержания http code 200 (это я домыслил, можно удалить) if Not AJSONObject.TryGetValue('code', ACode) then exit; if ACode <> 200 then exit; // Извлекаем body if Not AJSONObject.TryGetValue('body', AJSONObjectBody) then exit; if Not Assigned(AJSONObjectBody) then exit; // Из body извлекаем instanceId - будем использовать как имя файла if Not AJSONObjectBody.TryGetValue('instanceId', AFileName) then exit; // Склеиваем полное имя файла // AFileName:=TPath.Combine(TPath.GetSharedDownloadsPath, AFileName + '.pdf'); AFileName:=TPath.Combine(TPath.GetSharedDownloadsPath, AFileName + '.jpeg'); // Я тестил на картинке // Извлекаем nextStep if Not AJSONObjectBody.TryGetValue('nextStep', AJSONObjectNextStep) then exit; if Not Assigned(AJSONObjectNextStep) then exit; // Содаем поток-источник и помещаем в него base64 AStreamSource:=TMemoryStream.Create; if Not AJSONObjectNextStep.TryGetValue('pdf', ABase64) then exit; AStreamSource.WriteBuffer(Pointer(ABase64)^, Length(ABase64) * 2); // Длину строки умножаем на 2, так как строка юникод AStreamSource.Position:=0; // Создаем поток-назначение AStreamDest:=TMemoryStream.Create; // Декодируем base64 из текста в потоке AStreamSource в бинарные данные в поток AStreamDest ADecodeByteCount:=TNetEncoding.Base64.Decode(AStreamSource, AStreamDest); // Проверяем сколько байт было декодировано if (ADecodeByteCount > 0) then begin AStreamDest.Position:=0; try // Сохраняем поток с бинарными данными в файл с ранее собранным именем AStreamDest.SaveToFile(AFileName); except exit; end; end; // Выставляем результат функции в True Result:=True; end; procedure TForm1.FormCreate(Sender: TObject); Var AJSONString : String; AFileName : String; begin AJSONString:=TFile.ReadAllText('d:\JSON_example.txt'); if ExtractPDFContentBase64(AJSONString, AFileName) then begin // Что то делаем с PDF файлом AFileName end; end; end.  

Большое спасибо, что, копируя файл, delphi перестала жаловаться. Поздравляем за работу.

Привет Всем!
Много тем на форуме про раскраску TListView, нашел в интернете решение и доработал его
Вот что получилось
   
LV_Helper.zip                                                                  ColorListView.zip
Доступно для Seattle
ListView1.SetColorItemSelected(TAlphaColorRec.Orangered); //выделенный ListView1.SetColorItemFill(TAlphaColorRec.Gray); // обычный цвет Item ListView1.SetColorItemFillAlt(TAlphaColorRec.Lightgrey); // альтернативный цвет Item ListView1.SetColorBackground(TAlphaColorRec.Black); // цвет самого TListView ListView1.SetColorItemSeparator(TAlphaColorRec.Lightgray); // Линия разделения Item'ов ListView1.SetColorText(TAlphaColorRec.Red); // Обычный текст ListView1.SetColorTextSelected(TAlphaColorRec.White); // выделенный текст ListView1.SetColorTextDetail(TAlphaColorRec.Yellow); // текст доп. инфы ListView1.SetColorTextHeader(TAlphaColorRec.Green); // текст заголовка ListView1.SetColorTextHeaderShadow(TAlphaColorRec.Lightgray); // тень текста   ListView1.SetColorButtonText(TAlphaColorRec.Orange); // цвет текста кнопки   ListView1.SetColorButtonTextPressed(TAlphaColorRec.Orangered); // цвет нажатой кнопки добавлено в Berlin
ListView1.SetColorPullRefresh(TAlphaColorRec.Orange); ListView1.SetColorPullRefreshIndicator(TAlphaColorRec.Orangered); ListView1.SetColorStretchGlow(TAlphaColorRec.Lime); ModernListView.rar

Вот пример того, как писать и читать BLOB
procedure SaveToFireDACBlob; var MemStream: TMemoryStream; begin FireDAC.Connected := True; MemStream := TMemoryStream.Create; try Image1.Bitmap.SaveToStream(MemStream); MemStream.Seek(0,0); FDQueryInsert.ParamByName('Media').LoadFromStream(MemStream,ftBlob); FDQueryInsert.ParamByName('MType').AsString := '0'; FDQueryInsert.ExecSQL(); except on e: Exception do begin ShowMessage(e.Message); end; end; MemStream.Free; FireDAC.Connected := False; end; procedure LoadFromFireDACBlob; var BlobStream: TStream; begin FireDAC.Connected := True; try FDQuerySelect.Open; FDQuerySelect.First; while(not FDQuerySelect.EOF)do begin // access a stream from a blob like this BlobStream := FDQuerySelect.CreateBlobStream(FDQuerySelect.FieldByName('Media'),TBlobStreamMode.bmRead); // access a string from a field like this if (FDQuerySelect.FieldByName('MType').AsString='0') then begin // load your blob stream data into a control ImageViewer.Bitmap.LoadFromStream(BlobStream); end; BlobStream.Free; FDQuerySelect.Next; end; except on e: Exception do begin //ShowMessage(e.Message); end; end; FireDAC.Connected := False; end; {источник http://www.fmxexpress.com/read-and-write-a-blob-field-using-firedac-with-firemonkey-on-android-and-ios/} Касательно работы с изменением качества/размера, считаю что необходимо использовать TBitmapSurface  (unit FMX.Surfaces)

У изображения нужно настроить на какие жесты он реагирует. Кинь на форму TGestureManager, потом настрой поля как показано ниже в коде.
OnClick - срабатывает при касании объекта, срабатывает и в виндовс и на мобильных устройствах.
OnTap - срабатывает несколько интеллектуальнее, причем только на мобильных устройствах (в виндовс не срабатывает).
Упрощенно, он срабатывает только если ты коротко тапнул на контрол, если ты нажал на контрол и повел пальцем, скроля контент или скроля родительский ScrollBox, OnTap НЕ сработает.
// инициализация Image.Touch.GestureManager := gestManager;     Image.Touch.InteractiveGestures := [TInteractiveGesture.LongTap];     Image.OnGesture := FormGesture; .. // обработка жеста procedure TfrmMain.FormGesture(Sender: TObject; const EventInfo: TGestureEventInfo; var Handled: Boolean); begin     case EventInfo.GestureID of     igiLongTap :         begin             DoSomething();         end; end; end;  

Ставим TListBox.AllowDrag = True для источника итемов. С которого будем перетаскивать итемы в другой. В обработчике TListBox.OnDragOver у приемника пишем:
procedure TForm1.ListBox1DragOver(Sender: TObject; const Data: TDragObject; const Point: TPointF; var Operation: TDragOperation); begin Operation := TDragOperation.Copy;// или Move end; Пишем обработчик TListBox.OnDragDrop для списка приемника:
procedure TForm1.ListBoxDestinationDragDrop(Sender: TObject; const Data: TDragObject; const Point: TPointF); begin if Data.Source is TFmxObject then TFmxObject(Data.Source).Parent := ListBoxDestination; end; Запускаем и смотрим.

Решил вот так, если вдруг кому надо
procedure TForm1.SortGroup; var i, j: integer; elementscount: byte; begin elementscount := Form1.RoomsScrollBox.Content.Children.Count; for i := 1 to elementscount do for j := 0 to elementscount - 1 do begin if (Form1.RoomsScrollBox.Content.Children.Items[j] as TEssence).SortIndex = i then begin (Form1.RoomsScrollBox.Content.Children.Items[j] as TEssence).Position.Y := 10000; break; end; end; end; соответственно элементы с самым низким индексом будут наверху. Единственное ограничение, что индексы элементов должны быть подряд, без пропусков. Это не очень удобно, надо будет переделать

Добрый день!
Использую Ваш пример... и столкнулся с такой же траблой.. (в последнем приложенном файле та же трабла..)
Подскажите, пжл, куда копать..
procedure TForm1.FormCreate(Sender: TObject);
var
  sUrl: string;
  i: integer;
  item:TListViewItem;
begin
 with qLess do
  try
    if qLess.Active then Close;
    Open;
    while not eof do
     begin
      with ListView1 do
       begin
        Item:=listview1.Items.Add;
        Item.Text := qLessLESS_NAME.AsString;
        Item.Detail:= qLessLESS_DESC.AsString;
        Item.Data['URL'] := qLessIMG_URL.AsString;
        Item.Data['loading'] := 0; // даём знать, что можно загрузить картинку
       end;
       next;
     end;
  except
   //
  end;
 end;

procedure TForm1.ListView1Paint(Sender: TObject; Canvas: TCanvas;
  const ARect: TRectF);
var i:integer;
begin
  for i := 0 to ListView1.Items.Count-1 do
  begin
    if (i >= 0) and (i < ListView1.Items.Count) then
    begin
     if  ListView1.Items.Bitmap.Image<>NIL then
      if (ListView1.Items.Data['loading'].AsInteger = 0) then
      begin
        ListView1.Items.Data['loading']:= 1;
        ListView1.Items.Bitmap.LoadFromUrlToListViewItem(ListView1.Items.Data['URL'].AsString, ListView1);
      end;
    end;
  end;
end;
{ TBitmapHelper }
procedure TBitmapHelper.LoadFromUrlToListViewItem(AUrl: string;
  AListView: TListView);
var thread: TThread;
begin
  thread := TThread.CreateAnonymousThread(
  procedure
  var
  NetHTTPClient: TNetHTTPClient;
  Result: TMemoryStream;
  begin
    Result := TMemoryStream.Create;
    NetHTTPClient := TNetHTTPClient.Create(nil);
    try
      try
        NetHTTPClient.Get(AUrl, Result);
        TThread.Synchronize(TThread.CurrentThread,
        procedure()
        var
        tempBitMap: TBitmap;
        begin
          tempBitMap := TBitmap.Create;
          tempBitMap.LoadFromStream(Result);
          if not tempBitMap.IsEmpty then
          begin
            self.Assign(tempBitMap);
            AListView.Paint;
          end;
        end);
        except
        Result.Free;
      end;
      finally
      NetHTTPClient.Free;
    end;
  end);
  thread.FreeOnTerminate := true;
  thread.start;
end;

Пример моего кода:
interface type TMyForm = class(TForm) { ... } procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); {$IFDEF ANDROID} procedure ImageFileMessageListener(const Sender: TObject; const M: TMessage); {$ENDIF} {$IFDEF IOS} procedure ImageFileFinish(Image: TBitmap); {$ENDIF} procedure ImageFromLibraryClick(Sender: TObject); { ... } private { ... } procedure ApplyImage(Image: TBitmap); { ... } end; implementation procedure TMyForm.FormCreate(Sender: TObject); begin {$IF DEFINED(ANDROID)} TMessageManager.DefaultManager.SubscribeToMessage(TMessageDidFinishTakingImageFromLibrary, ImageFileMessageListener); {$ENDIF} end; procedure TMyForm.FormDestroy(Sender: TObject); begin {$IF DEFINED(ANDROID)} TMessageManager.DefaultManager.Unsubscribe(TMessageDidFinishTakingImageFromLibrary, ImageFileMessageListener, True); {$ENDIF} end; {$IFDEF ANDROID} procedure TMyForm.ImageFileMessageListener(const Sender: TObject; const M: TMessage); begin try if M is TMessageDidFinishTakingImageFromLibrary then ApplyImage(TMessageDidFinishTakingImageFromLibrary(M).Value); except { code for exception handle } end; end; {$ENDIF} {$IFDEF IOS} procedure TMyForm.ImageFileFinish(Image: TBitmap); begin try ApplyImage(Image); except { code for exception handle } end; end; {$ENDIF} procedure TMyForm.ImageFromLibraryClick(Sender: TObject); {$IF DEFINED(ANDROID) OR DEFINED(IOS)} var LImageService: IFMXTakenImageService; LImageParams: TParamsPhotoQuery; {$ENDIF} begin if TPlatformServices.Current.SupportsPlatformService(IFMXTakenImageService, IInterface(LImageService)) then begin LImageParams.RequiredResolution := TSize.Create(1024, 1024); LImageParams.Editable := False; LImageParams.NeedSaveToAlbum := False; // под Android обработчик OnDidFinishTaking указывать нельзя, т.к. это может привести к рестарту программы // см. http://docwiki.embarcadero.com/Libraries/Berlin/en/FMX.MediaLibrary.TMessageDidFinishTakingImageFromLibrary LImageParams.OnDidFinishTaking := {$IFDEF IOS}ImageFileFinish{$ELSE}nil{$ENDIF}; LImageParams.OnDidCancelTaking := nil; LImageService.TakeImageFromLibrary({$IFDEF IOS}ImageFile{$ELSE}nil{$ENDIF}, LImageParams); end else raise Exception.Create('No image library access'); end; procedure TMyForm.ApplyImage(Image: TBitmap); begin { code for received image } end;