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

Евгений Корепов

Пользователи
 Профиль  Обзор контента

  • Постов

    738

  • Зарегистрирован

  • Посещение

  • Победитель дней

    100

 Тип контента 

Сообщения, опубликованные Евгений Корепов

    Android MySQL+UniDac+3G

    в MySQL

    Опубликовано

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

    В некоторых проектах использую передачу JSON по HTTPS, с контрольными суммами блоков данных и автоинкрементными счетчиками переданных/принятых блоков. Конечно на стороне сервера приходится держать прокладку, но зато работает стабильно.

    Проблемы с отрисовкой

    в Графика

    Опубликовано · Изменено пользователем Евгений Корепов
    Нашел ошибку в коде, исправил.

    Накидал примерный проект для корректной работы с потоками. Создаем поток, в который с помощью очереди закидываем задания и в таймере получаем результат выполнения. Вместо изжившего себя TIdHTTP, использовал THTTPClient (вдруг вам понадобится, к примеру, запускать это приложение на 6 андроиде и обращаться по https - Indy такое уже не сможет).

    Код юнита с потоком: 

    unit UnitGetHttpThread;

interface

uses
  classes,
  SysUtils,
  System.Generics.Collections,
  System.SyncObjs,
  System.Net.HttpClient;

type
  THTTPRec=record
    Command : String;
    Query : String;
    ErrorMsg : String;
    ErrorCode : Integer;
    Page : String;
    Stream : TMemoryStream;
    ItemImageIndex : Integer;
  end;

  THTTPThread=class(TThread)
  private
    FQueueRequest: TThreadedQueue<THTTPRec>;
    FQueueResult: TThreadedQueue<THTTPRec>;
    FHTTPRec: THTTPRec;
    function GetHTTP(AHTTPRec: THTTPRec) : THTTPRec;
  protected
    HTTPClient: THTTPClient;
    procedure Execute; override;
  public
    constructor Create(AQueueRequest, AQueueResult : TThreadedQueue<THTTPRec>);
    destructor Destroy; override;
  end;

implementation

constructor THTTPThread.Create(AQueueRequest, AQueueResult : TThreadedQueue<THTTPRec>);
begin
  FreeOnTerminate:=False;
  FQueueRequest:=AQueueRequest;
  FQueueResult:=AQueueResult;
  HTTPClient:=THTTPClient.Create;
  Inherited Create(FALSE);
end;

destructor THTTPThread.Destroy;
begin
  HTTPClient.Free;
  inherited Destroy;
end;

procedure THTTPThread.Execute;
begin
  while Not Terminated do
    if FQueueRequest.PopItem(FHTTPRec) = TWaitResult.wrSignaled Then
    begin
      if FHTTPRec.Command.Equals('stop') then
      begin
        FHTTPRec.ErrorCode:=200;
        FHTTPRec.ErrorMsg:='Ok';
        FQueueResult.PushItem(FHTTPRec);
        Continue;
      end;
      FHTTPRec.ErrorCode:=0;
      FHTTPRec.ErrorMsg:='';
      FHTTPRec:=GetHTTP(FHTTPRec);
      if Not FHTTPRec.Command.Equals('error') then
        FQueueResult.PushItem(FHTTPRec);
    end;
end;

function THTTPThread.GetHTTP(AHTTPRec: THTTPRec) : THTTPRec;
Var HTTPResponse: IHTTPResponse;
begin
  try
    if AHTTPRec.Command.Equals('image') then
    begin
      HTTPResponse:=HTTPClient.Get(AHTTPRec.Query,AHTTPRec.Stream);
      AHTTPRec.ErrorCode:=HTTPResponse.StatusCode;
      AHTTPRec.ErrorMsg:=HTTPResponse.StatusText;
    end
    Else
    begin
      HTTPResponse:=HTTPClient.Get(AHTTPRec.Query);
      AHTTPRec.Page:=HTTPResponse.ContentAsString;
      AHTTPRec.ErrorCode:=HTTPResponse.StatusCode;
      AHTTPRec.ErrorMsg:=HTTPResponse.StatusText;
    end;
  except
    AHTTPRec.ErrorCode:=-1;
    AHTTPRec.ErrorMsg:='ErrorGetURL';
  end;
  Result:=AHTTPRec;
end;

end.

    Код основной формы (основного потока): 

    unit UnitFormMain;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
  System.Generics.Collections,
  UnitGetHttpThread, FMX.Layouts, FMX.ListBox,
  System.JSON;

type
  TFormMain = class(TForm)
    MainContentDownloadBaseListBox: TListBox;
    Timer: TTimer;
    procedure TimerTimer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    FQueueRequest: TThreadedQueue<THTTPRec>;
    FQueueResult: TThreadedQueue<THTTPRec>;
    HTTPThread : THTTPThread;
  public
    { Public declarations }
    procedure GetHTTP(ACommand : String; AListItemIndex : Integer; BaseID : String);
    procedure FillListBoxImage(AHTTPRec : THTTPRec);
    procedure FillListBoxItem(AHTTPRec : THTTPRec);
  end;

var
  FormMain: TFormMain;

implementation

{$R *.fmx}

procedure TFormMain.FormCreate(Sender: TObject);
begin
  Timer.Interval:=10;
  FQueueRequest:=TThreadedQueue<THTTPRec>.Create(50, 1000, 10);
  FQueueResult:=TThreadedQueue<THTTPRec>.Create(50, 1000, 10);
  HTTPThread:=THTTPThread.Create(FQueueRequest,FQueueResult);

  GetHTTP('json', -1, ''); // запускаем карусель
end;

procedure TFormMain.TimerTimer(Sender: TObject);
Var FHTTPRec : THTTPRec;
begin
  while FQueueResult.PopItem(FHTTPRec) = TWaitResult.wrSignaled do
  begin
    if FHTTPRec.ErrorCode=200 then
    begin
      if FHTTPRec.Command.Equals('json') then
        FillListBoxItem(FHTTPRec);
      if FHTTPRec.Command.Equals('image') then
        FillListBoxImage(FHTTPRec);
      if FHTTPRec.Command.Equals('stop') then
      begin
        Timer.Enabled:=False;
//        AniIndicator.Visible:=False;
//        AniIndicator.Enabled:=False;
      end;
    end
    Else
    begin
      Timer.Enabled:=False;
//      AniIndicator.Visible:=False;
//      AniIndicator.Enabled:=False;
//      LabelTitle.Text:='Не удалось получить данные, проверьте подключение к Интернет.';
    end;
  end;
end;

procedure TFormMain.FillListBoxItem(AHTTPRec : THTTPRec);
Var JSON : TJSONObject;
    I : Integer;
    BaseName, BaseCaption, BaseCategory, BaseID, BaseData: String;
    Item, ItemRadio: TListBoxItem;
begin
    JSON := TJSONObject.ParseJSONValue(AHTTPRec.Page) as TJSONObject;
    if Not Assigned(JSON) then
      Exit;
    for I:=0 To JSON.Count-1 do
    Begin
      BaseData := JSON.Pairs[i].ToString;
      BaseData := BaseData.Substring(pos('"', BaseData));
      BaseName := BaseData.Remove(pos('"', BaseData) - 1);
      BaseData := BaseData.Substring(pos('"', BaseData));
      BaseData := BaseData.Substring(pos(':', BaseData));
{      JSON1 := TJSONObject.ParseJSONValue(BaseData) as TJSONObject;
      BaseCaption := JSON1.Values['caption'].Value;
      BaseCategory := JSON1.Values['category'].Value;
      BaseID := JSON1.Values['id'].Value;  }
      if MainContentDownloadBaseListBox.Items.IndexOf(BaseID) = -1 then
      Begin
        Item := TListBoxItem.Create(Self);
        Item.Height := 120;
        Item.StyleLookup := 'ListBoxItemDownloadBaseStyle';
        Item.Text := BaseID;
        Item.StylesData['name'] := BaseName;
        Item.StylesData['caption'] := BaseCaption;
        Item.StylesData['category'] := BaseCategory;
GetHTTP('image', Item.Index, BaseID); // отсылаем в поток запрос на скачивание картинки
        MainContentDownloadBaseListBox.AddObject(Item);
      End;
    End;
  GetHTTP('stop', -1, '');
end;

procedure TFormMain.FillListBoxImage(AHTTPRec : THTTPRec);
begin
  MainContentDownloadBaseListBox.ListItems[AHTTPRec.ItemImageIndex].ItemData.Bitmap.LoadFromStream(AHTTPRec.Stream);
end;

procedure TFormMain.GetHTTP(ACommand : String; AListItemIndex : Integer; BaseID : String);
Var FHTTPRec : THTTPRec;
begin
  FHTTPRec.Page:='';
  Timer.Enabled:=True;
  if ACommand='stop' then
  begin
    FHTTPRec.Command:='stop';
    FQueueRequest.PushItem(FHTTPRec);
  end;
  if ACommand='json' then
  begin
    FHTTPRec.Command:=ACommand;
    FHTTPRec.Query:='https://ссылка получения json';
    FQueueRequest.PushItem(FHTTPRec);
  end;
  if ACommand='image' then
  begin
    FHTTPRec.Command:=ACommand;
    FHTTPRec.Query:='https://ссылка получения картинки'+BaseID;
    FHTTPRec.ItemImageIndex:=AListItemIndex;
    FHTTPRec.Stream:=TMemoryStream.Create;
    FQueueRequest.PushItem(FHTTPRec);
  end;
end;
      
end.

    Одним потоком забираем все что нужно из сети - и json данные и картинки, ну и все что еще прикрутите.

    Ошибка "Bitmap size too big"

    в TImage

    Опубликовано

    1 час назад, tromani сказал:

    хм... ну очевидно что медленность работы вызвана  

    
ABitmapSurfaceResize.StretchFrom(ABitmapSurface,mxW,mxH);

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

     

    Я конечно не знаю как у вас происходит но меня очень напрягает когда 2-3% скачавших приложение ставят оценку 1 потому что что-то не заработало или они не разобрались как работает

     

     

    В исходниках уже проделывается все что есть в вашем коде, посмотрите внимательно. У меня ошибка появляется в моем коде 

    Else
    if Assigned(ABitmap) then
      ABitmap.Assign(ABitmapSurface);

    т.е. когда вроде как не требуется уменьшать изображение, т.е. ошибка появляется где то в этом коде исходников: 

    begin
    SetSize(Source.Width, Source.Height);
    if Map(TMapAccess.Write, BitmapData) then
    try
      for I := 0 to TBitmapSurface(Source).Height - 1 do
        Move(TBitmapSurface(Source).Scanline[I]^, BitmapData.GetScanline(I)^, BitmapData.BytesPerLine);
    finally
      Unmap(BitmapData);
    end;
  end;

     

    Ошибка "Bitmap size too big"

    в TImage

    Опубликовано

    Посмотрел исходники, оказывается там все это уже есть: 

    unit FMX.Graphics;

procedure TBitmap.AssignFromSurface(const Source: TBitmapSurface);
var
  BitmapData: TBitmapData;
  MaxSize: Integer;
  ResampledSurface: TBitmapSurface;
  I: Integer;
  SourceRect: TRectF;
begin
  MaxSize := CanvasClass.GetAttribute(TCanvasAttribute.MaxBitmapSize);
  if (Source.Width > MaxSize) or (Source.Height > MaxSize) then
  begin
    SourceRect := TRectF.Create(0, 0, Source.Width, Source.Height);
    SourceRect.Fit(TRectF.Create(0, 0, MaxSize, MaxSize));
    ResampledSurface := TBitmapSurface.Create;
    try
      ResampledSurface.StretchFrom(Source, Trunc(SourceRect.Width), Trunc(SourceRect.Height), PixelFormat);
      AssignFromSurface(ResampledSurface);
    finally
      ResampledSurface.Free;
    end;
  end
  else
  begin
    SetSize(Source.Width, Source.Height);
    if Map(TMapAccess.Write, BitmapData) then
    try
      for I := 0 to TBitmapSurface(Source).Height - 1 do
        Move(TBitmapSurface(Source).Scanline[I]^, BitmapData.GetScanline(I)^, BitmapData.BytesPerLine);
    finally
      Unmap(BitmapData);
    end;
  end;
end;

    Так что весь мой код не имеет смысла. В процедуре можно ограничится следующим кодом: 

    procedure TFormMain.CheckAndLoadFromStream(const AStream : TStream; const ABitmap : TBitmap);
Var ABitmapSurface : TBitmapSurface;
begin
  ABitmapSurface:=TBitmapSurface.Create;
  AStream.Position:=0;
  TBitmapCodecManager.LoadFromStream(AStream,ABitmapSurface);
  if Assigned(ABitmap) then
    ABitmap.Assign(ABitmapSurface);
  FreeAndNil(ABitmapSurface);
end;

    Ну и изредка глючить он будет по прежнему...

    Ошибка "Bitmap size too big"

    в TImage

    Опубликовано

    К сожалению этот код выполняется неимоверно долго. На моём HTC One, загрузка с локального хранилища 30 картинок 250х250 производится за 15-20 секунд. Прямая операция Assigned(ABitmap) происходит фактически мгновенно. Так что ради полутора процентов пользователей, замедлять работу приложения на два порядка я не готов.

    Berlin жутко тормозит

    в XE10.1 Berlin

    Опубликовано

    Посмотрите через штатный Монитор ресурсов Windows работу с диском во время тормозов. У меня была подобная проблема на XE8 - оказалось что конфликтует с КриптоПРО, дергает какую то dll и любое действие растягивается на сорок минут. С техподдержкой эмбаркадеры неделю потратили на выяснение. Начали с запуска "bds.exe -rtest", закончили запуском специального приложения для подробного мониторинга IDE.

    Exception в System

    в Отладка

    Опубликовано

    2 часа назад, krapotkin сказал:

    HTTP создаю каждый раз заново, тут без вариантов

    драйвера попробую, спасибо

    Может тогда наоборот, попробовать использовать один экземпляр HTTP на весь сеанс работы? Чем черт не шутит, вдруг метод инженерного тыка сработает.

    Exception в System

    в Отладка

    Опубликовано · Изменено пользователем Евгений Корепов

    На счет драйверов на телефон посмотрите эти http://4pda.ru/forum/index.php?showtopic=612373&st=1580 (спойлер Инструменты), или ищите китайского прародителя. У меня 2 DEXP для тестов, к обоим, с трудом, но нашел драйвера.

    И попробуйте HTTPClient создавать перед каждым обращением в качестве теста. Ну и после запроса к серверу сразу грохать. У меня в одном проекте было подозрение что HTTPClient валится после пары  сотен запросов, то ли утечка памяти, то ли еще что, разбираться не стал, в реальности количество обращений к серверу было гораздо меньше.

     

    P.S. Вот этот способ использовал для установки драйверов (они не подписаны) http://4pda.ru/forum/index.php?showtopic=612373&st=1580#entry37324657

    Двойной запрос NetHTTPClient

    в RTL

    Опубликовано

    3 часа назад, Rusland сказал:

    Да, я уже попробовал ставить False - безрезультатно ^^^

    Вообще работать должно так - идет обращение на сервер, сервер отлупливает и сообщает давай авторизацию, TNetHTTPClient обрабатывает овет в OnAuthEvent и посылает второй запрос с авторизацией. Хотя могу и ошибаться, всегда использую THTTPClient, с TNetHTTPClient не баловался.

    Сообщения чата в виде сообщений в iphone.

    в Работа с текстом

    Опубликовано

    При нажатие на кнопку и не должно ничего происходить. Вы сами обрабатываете событие: 

    ...
TFormMain = class(TForm)
  procedure ChatBoxURLButton(PURL: string); 
...
ChatBox.OnURLButtonClick:=ChatBoxURLButton; // При создании ChatBox
...
procedure TFormMain.ChatBoxURLButton(PURL: string);
begin
  OpenURL(PURL); // Открываем url мультиплатформенной процедурой
end;

// К примеру такой:
procedure TFormMain.OpenURL(const AUrl: string);
{$IFDEF ANDROID}
var Uri: Jnet_Uri;
    OpenLinkIntent: JIntent;
{$ENDIF ANDROID}
begin
{$IFDEF MSWINDOWS}
  ShellExecute(0, 'open', PChar(AUrl), nil, nil, SW_SHOWNORMAL);
{$ENDIF MSWINDOWS}
{$IFDEF ANDROID}
  Uri := StrToJURI(AUrl);
  OpenLinkIntent := TJIntent.JavaClass.init(TJIntent.JavaClass.ACTION_VIEW, Uri);
  SharedActivity.startActivity(OpenLinkIntent);
{$ENDIF ANDROID}
end;

     

    Сообщения чата в виде сообщений в iphone.

    в Работа с текстом

    Опубликовано

    В 17.05.2016 в 16:46, Rusland сказал:

    Евгений Корепов, а как пользоваться этим чатом?

    Вот, например, я подцепил к проекту unit ChatBox и пытаюсь добавить сообщения. 

    
  public
    { Public declarations }
    chat:TChatBox;
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

procedure TForm1.Button1Click(Sender: TObject);
begin
  chat.AddMessage(1,'22:15','Автор1','сообщение',TMessagePos.msgLeft);
  chat.AddMessage(2,'22:16','Автор2','сообщение2',TMessagePos.msgRight);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  chat:=TChatBox.Create(Layout1);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  chat.Destroy;
end;

    но ничего не происходит. 

    procedure TForm1.FormCreate(Sender: TObject); 
begin 
  chat:=TChatBox.Create(Layout1); 
  Chat.Align:=TAlignLayout.Client;
  Chat.MsgWidthPercentage:=66;
  Chat.CalloutLength:=10;
  Chat.CalloutXRadius:=5;
  Chat.CalloutYRadius:=5;
  Chat.MessageFontSize:=14;
  Layout1.AddObject(Chat);
end;

    Как то так...

    Генерация QR-кода на Android

    в Прочие вопросы

    Опубликовано

    Можно пойти другим путем. Рисовать не на TImage, а использовать шрифты. 

    На http://fontello.com/ сделал шрифт из двух символов - черный квадрат и белый квадрат. Рисовальщик из меня никудышний, не разобрался как увеличить высоту символов в SVG иконке. Шрифт подключил к проекту, отображаю на Memo, у которого установлен мой шрифт.

    Код такой: 

    procedure TfmMainQRShare.Update;
var Row, Column, I : Integer;
    S : String;
    ChBlack, ChWhite : String;
begin
  Memo.BeginUpdate;
  Memo.Lines.Clear;
  ChBlack:=Char($e802);
  ChWhite:=Char($e803);
  QRCode.Free;
  QRCode := TDelphiZXingQRCode.Create;
  try
    QRCode.Data := edtText.Text;
    QRCode.Encoding := TQRCodeEncoding(cmbEncoding.ItemIndex);
    QRCode.QuietZone := StrToIntDef(edtQuietZone.Text, 2);
    for Row := 0 to QRCode.Rows - 1 do
    begin
      S:='';
      for Column := 0 to QRCode.Columns - 1 do
      begin
        if (QRCode.IsBlack[Row, Column]) then
          S:=S+ChBlack
        else
          S:=S+ChWhite;
      end;
      Memo.Lines.Add(S);
    end;
  finally
  end;
  Memo.EndUpdate;
end;

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

    Screenshot_2016-04-29-17-29-03.png

    Как вытащить список из JSON со значениями

    в JSON

    Опубликовано · Изменено пользователем Евгений Корепов

    1 час назад, MikeWuzHere сказал:

    А можно как-то фильтровать данные с помощью этой штуки? т.е. у каждого number есть параметр type, как вывести нумберы только 1ых на пример тайпов? Заранее благодарю, а так же звЫните за море тупых вопросов, я только начал программировать и меня грузят такими задачами, к которым я близко не был готов :unsure:

    А еще: что такое : Имя массива и откуда его выдернуть? Все остальное вроде прикрутил, но при нажатии на кнопку выскакивает ошибка адресс вайолэйшн  

    
  with xJS.A['data'] do // имя массива

    Вот получение данных с type=1: 

    function TFormMain.ParseJSONArray(AJSONString : String) : TStringList; // для удобства функция возвращает TStringList, так будет проще закинуть результат в Memo
Var AJSONArray : TJSONArray;
    AJSONValue : TJSONValue;
    I : Integer;
begin
  Result:=TStringList.Create; // Создаем результат фозвращаемый функцией
  AJSONArray:=TJSONArray(TJSONObject.ParseJSONValue(AJSONString)); // Зная что на входе TJSONArray парсим его, пропуская парсинг TJSONObject
  if Not Assigned(AJSONArray) then // Если парсинг удался, то AJSONArray<>Nil
    Exit;
  for I := 0 to AJSONArray.Count-1 do // Работаем как с обычным массивом
  begin
    if AJSONArray.Items[I].TryGetValue('type',AJSONValue) Then // Получаем type
      if Not AJSONValue.Value.Equals('1') then // если type<>1 переходим на следующую итерацию (код ниже пропускается)
        Continue;
     if AJSONArray.Items[I].TryGetValue('number',AJSONValue) Then //Здесь используем полезную функцию TryGetValue, защищая себя от некорректных или отсутствующих 'number'
        Result.Add(AJSONValue.Value); // Если успешно, то добавляем полученную строку в результирующий StringList
  end;
end;

    "адресс вайолэйшн" потому что код с  XSuperObject не безопасный, будет работать до первой ошибки в входных данных, далее крах приложения.

    Как вытащить список из JSON со значениями

    в JSON

    Опубликовано

    6 часов назад, ZuBy сказал:

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

    Мой код на две строчки короче ;-) Плюс в нем есть проверки на не штатные ситуации. На счет читаемости тоже поспорю: "SO(aJSON), A['data'], O[j], S['number']" - не самый лучший пример читаемости, называть глобальную функцию SO и использовать использовать именования типа A, B, C, D было модно в конце 80-х, начале 90-х. Видимо разработчик такой же древний как и я ;-) Когда пишешь код на Fortran и набиваешь его на перфокартах для EC-1045, каждый символ на счету. Теперь же я могу заглянуть в свой год 10-ти летней давности и понять что он делает не анализируя содержимое функций или назначение переменных.

    Как вытащить список из JSON со значениями

    в JSON

    Опубликовано · Изменено пользователем Евгений Корепов

    Для работы с JSON в Delphi есть все что нужно - штатная библиотека System.JSON. Быстрая и удобная, работать с ней одно удовольствие. Вот накидал проект, ваш JSON загружаю из файла. 

    unit UnitFormMain;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
  System.IOUtils, FMX.Controls.Presentation, FMX.ScrollBox, FMX.Memo,
  System.JSON;

type
  TFormMain = class(TForm)
    Memo: TMemo;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    function ParseJSONArray(AJSONString : String) : TStringList;
  end;

var
  FormMain: TFormMain;

implementation

{$R *.fmx}

procedure TFormMain.FormCreate(Sender: TObject);
Var AJSONString : String;
begin
  AJSONString:=TFile.ReadAllText('D:\Embarcadero\Projects\Test\test062 JSON Array\input.json'); // Загружаем JSON в строку
  Memo.Lines.Assign(ParseJSONArray(AJSONString)); // Вызываем функцию парсинга, если все удачно - Memo заполнится значениями, если нет - останется пустым.
end;

function TFormMain.ParseJSONArray(AJSONString : String) : TStringList; // для удобства функция возвращает TStringList, так будет проще закинуть результат в Memo
Var AJSONArray : TJSONArray;
    AJSONValue : TJSONValue;
    I : Integer;
begin
  Result:=TStringList.Create; // Создаем результат фозвращаемый функцией
  AJSONArray:=TJSONArray(TJSONObject.ParseJSONValue(AJSONString)); // Зная что на входе TJSONArray парсим его, пропуская парсинг TJSONObject
  if Not Assigned(AJSONArray) then // Если парсинг удался, то AJSONArray<>Nil
    Exit;
  for I := 0 to AJSONArray.Count-1 do // Работаем как с обычным массивом
    if AJSONArray.Items[I].TryGetValue('number',AJSONValue) Then //Здесь используем полезную функцию TryGetValue, защищая себя от некорректных или отсутствующих 'number'
      Result.Add(AJSONValue.Value); // Если успешно, то добавляем полученную строку в результирующий StringList
end;

end.

    P.S. работает под всеми платформами. Скорость для такого небольшого файла JSON можно принять за мгновенную даже на стареньких телефонах. Мне вот тут один сервис отдавал JSON размером в 6 мегабайт. Онлайн парсер http://pro.jsonlint.com/ которым удобно смотреть структуру зависал наглухо. А в Delphi все отлично и быстро работало

    RAD 11 на подходе?

    в Информация о версиях RAD Studio

    Опубликовано

    Обновили продукты в онлайн магазине. http://store.embarcadero.ru/catalog/rubric/24

    Итого чтобы обновить мою Delphi XE8 до "Delphi 10.1 Berlin Professional"+"Mobile Add-On Pack к Delphi 10.1 Berlin Professional" нужно заплатить 85038,22 рублей. Кажется наем фрилансеров для реализации моих хотелок обойдется дешевле. К торрент версии душа не лежит. Буду и дальше сидеть на XE8, подожду "Delphi 10.8 Bangladesh Professional" с компилятором для Linux и Intel Atom, полноценными сервисами InAppBilling, полной реализацией работы с сенсорами и надеюсь множеством других доделок.

×
×
  • Создать...