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

Dmitry Stolyarov

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

  • Постов

    69

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

  • Посещение

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

    3

 Тип контента 

Сообщения, опубликованные Dmitry Stolyarov

    Обновление клиента по событию

    в Базы данных и REST

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

    Есть клиентское приложение на Win, сервер на MySQL, связка через json+php.

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

    Подскажите, как лучше реализовать?

    HTTP отправка Image на сервер в формате stream

    в REST

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

    Подскажите, пытаюсь выгрузить на сервер картинку в формате потока.

    ничего не получается, что не так? 

    ///
...
 mStream := TMemoryStream.Create;
 bitmaptmp.SaveToStream(mStream);
 mStream.Position := 0;
 SendImgStream(Url, mStream);
///

function TfmMain.SendImgStream(const Url: string; const FileName: TStream): Boolean;
var
 lHttp: THTTPClient;
 lSendData: TMultipartFormData;
 lResponse: IHTTPResponse;
begin
 Result := false;
 lHttp := THTTPClient.Create;
 lSendData := TMultipartFormData.Create;
 with lHttp do
  try
   try 
    lSendData.AddStream('userfile', FileName);
    lResponse := lHttp.Post(Url, lSendData);
    Result := lResponse.StatusCode = 200;
   except
    on E: exception do
     ShowMessage('Ошибка сети: '+E.Message);
   end;
  finally
    FreeAndNil(lHttp);
    FreeAndNil(lSendData);
  end;

end;

    на сервере: 

    $dir = 'files/ID_'.$pIDPartner.'/ImgFromLesson';
if(!file_exists($dir)) 
 mkdir($dir, 0777, true);

$newfilename = md5(strtotime('now')).'_'.md5($_FILES['FileField']['tmp_name']).'jpg';

if (move_uploaded_file($_FILES["userfile"]["name"], $dir."/". $newfilename)) {
  // mysqli_query($DBLink, $query);
} else {
    print "There some errors!";
}

     

    Получить фото из галереи через Intent

    в Android

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

    Рабочий код: 

    procedure TForm1.HandleActivityMessage(const Sender: TObject;
  const M: TMessage);
var
 RequestCode, ResultCode: Integer;
 Intent: JIntent;
 uri : Jnet_Uri;
 bitmap: JBitmap;
 surface: TBitmapSurface;
begin
  if not(M is TMessageResultNotification) then exit;
  TMessageManager.DefaultManager.Unsubscribe(TMessageResultNotification, FMessageSubscriptionID);
  FMessageSubscriptionID := 0;

  RequestCode:=TMessageResultNotification(M).RequestCode;
  ResultCode:=TMessageResultNotification(M).ResultCode;
  Intent:=TMessageResultNotification(M).Value;

  if (ResultCode = TJActivity.JavaClass.RESULT_OK) and Assigned(Intent) then
   begin
    try
      uri:=Intent.getData;
      bitmap := TJImages_Media.JavaClass.getBitmap(SharedActivity.getContentResolver, uri);
      surface := TBitmapsurface.Create;
      JBitMapToSurface(bitmap,surface);
      Image1.Bitmap.Assign(surface);
    finally
        surface.Free;
    end;
  end;

     

    Получить фото из галереи через Intent

    в Android

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

    Открываю список фото в галерее с помощью: 

    procedure TForm1.Button1Click(Sender: TObject);
var
  chooserIntent, Intent: JIntent;
  ResultInt:integer;
begin
  intent := TJIntent.Create;
  intent.setAction(TJIntent.JavaClass.ACTION_GET_CONTENT);
  intent.setType(StringToJString('image/* video/*'));
  chooserIntent := TJIntent.JavaClass.createChooser(Intent, StrToJCharSequence('Choose media file'));
  TAndroidHelper.Activity.startActivityForResult(chooserIntent, ResultInt);

end;

    А как получить выбранную фотографию, например в Image1 не пойму.. Подскажите пжл...

    не работает в Андроид TTabTransition.Slide

    в Переключение вкладок

    Опубликовано · Изменено пользователем Dmitry Stolyarov

    Подскажите, почему может не работать на Анройде  плавное переключение вкладок? Под Win все работает.

    TabControl1.SetActiveTabWithTransition(TabControl1.Tabs[1], TTabTransition.Slide,  TTabTransitionDirection.tdReversed)

    Где указать ownerBitmap := true (ImageListItemBottomDetail)

    в TListView

    Опубликовано · Изменено пользователем Dmitry Stolyarov

    Вариант № 1 - не помогло. 

    странно, но пример из ссылки "Helper для TBitmap - асинхронная" не работает на андроиде - после запуска картинки не отображаются в листвью.. 

    при этом под OSX работает.. как теперь это запустить под андройдом фиг пойми..

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

     

    Где указать ownerBitmap := true (ImageListItemBottomDetail)

    в TListView

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

    Подскажите, пжл, как прописать  ownerBitmap := true  при режиме LV - ImageListItemBottomDetail ? 

    проблема в том, что картинке по URL на MacOS не грузятся совсем.. под Win все работает.

    как я понял из форума причина в ownerBitmap , но как его прописать не понимаю... 

    procedure TfmMain.lvSostavUpdateObjects(const Sender: TObject;
  const AItem: TListViewItem);
begin
if FlvSostavUpdating then
  exit;
 //LV в режиме редактирования списка
 if FlvSostavStateEdit then
  begin
   if (AItem.Purpose <> TListItemPurpose.Header)and (AItem.Objects.AccessoryObject <> nil) then
    begin
     AItem.Accessory:= TAccessoryType.Checkmark;
     AItem.Objects.AccessoryObject.Visible := FChecked.Contains(AItem.Tag);
    end
  end else AItem.Accessory:= TAccessoryType.Detail;
end;

procedure TfmMain.lvSostavUpdatingObjects(const Sender: TObject;
  const AItem: TListViewItem; var AHandled: Boolean);
begin
if FlvSostavUpdating then
  exit;
 //LV в режиме редактирования списка
 if (AItem.Data['sign_Loaded'].AsInteger = 0)and(AItem.Purpose <> TListItemPurpose.Header) then
  begin
   AItem.Data['sign_Loaded'] := 1;
   LoadBitmapFromURL(AItem.Data['sign_URL'].AsString, AItem, AItem.Bitmap, rcImg);
  end;
end;

    Картинки загружаю по URL в отдельном потоке 

    procedure TfmMain.LoadBitmapFromURL(const AURL: string; const AItem: TListViewItem; aBitmap: TBitmap; aSourceBmp: TRectangle);
var
  K: Integer; // Анонимная процедура захватывает локальную переменную, а не обращается к AItem, которой уже может не быть в момент _окончания_ скачивания фотки
  FHTTPClient : THTTPClient;
  ResourceStream: TResourceStream;
begin
 if Not Assigned(AItem) then
  Exit;
 if AItem.Data['ImageState'].AsInteger <> lvStudentsItemImageEmpty then
  Exit;
  if AURL.IsEmpty then
  begin
   AItem.Data['ImageState'] := lvStudentsItemImageLoading;
   ResourceStream := TResourceStream.Create(hInstance, 'PngImage_1', RT_RCDATA);
   ResourceStream.Position := 0;
   aSourceBmp.Fill.Bitmap.Bitmap.LoadFromStream(ResourceStream);
   FreeAndNil(ResourceStream);
   if not aSourceBmp.Fill.Bitmap.Bitmap.IsEmpty then
    begin
     aBitmap.SetSize(aSourceBmp.Fill.Bitmap.Bitmap.Width, aSourceBmp.Fill.Bitmap.Bitmap.Height);
     aBitmap.Assign(aSourceBmp.MakeScreenshot);
     AItem.Data['ImageState'] := lvStudentsItemImageLoaded;
    end;
   exit;
  end;


 AItem.Data['ImageState'] := lvStudentsItemImageLoading;
 K := AItem.Index;// Запоминаем индекс в локальную K, которая уйдёт в анонимку (время жизни K > времени жизни анонимки)
 FHTTPClient := THTTPClient.Create;
 FAsyncResultList.Items[K] := FHTTPClient.BeginGet(
  procedure (const ASyncResult: IAsyncResult)
   var
    AHTTPResponse: IHTTPResponse;
   begin
    if ASyncResult.IsCancelled then
     Exit;
    try
     AHTTPResponse := THTTPClient.EndAsyncHTTP(ASyncResult);
     if Not Assigned(AHTTPResponse) then
      Exit;
     if AHTTPResponse.StatusCode <> 200 then
      Exit;
    except
     Exit;
    end;

    TThread.Synchronize(Nil,
     procedure
      begin
       if FlvSostavUpdating or ASyncResult.IsCancelled then // Выходим, так как внутри анонимной процедуры AItem - не сброшены в nil, хотя их уже может и не быть
        Exit;
       if Not Assigned(AItem) then
        Exit;

       aSourceBmp.Fill.Bitmap.Bitmap.LoadFromStream(AHTTPResponse.ContentStream);
       if not aSourceBmp.Fill.Bitmap.Bitmap.IsEmpty then
        begin
         aBitmap.SetSize(aSourceBmp.Fill.Bitmap.Bitmap.Width, aSourceBmp.Fill.Bitmap.Bitmap.Height);
         aBitmap.Assign(aSourceBmp.MakeScreenshot);

         AItem.Data['ImageState'] := lvStudentsItemImageLoaded;
         FAsyncResultList.Items[K]:= nil;
        end
      end
      );
   end, AURL
   );

end;

    Под WIN все грузится, под MacOS нет...

     

    [ListBox] загрузка картинок

    в TListBox

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

    В 04.01.2017 в 12:33, AlexG сказал:

    А самое оптимальное решение - загрузка изображений в "контейнер", в фоновом режиме, а при окончании загрузки, по событию, - отрисовка уже в самом итеме

    Добрый день!

    можете дать пример реализации?

    Поиск в JSON через ISuperObject

    в JSON

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

    Помогите с помощью ISuperObject добраться до "phone_number":"79261060000" и user_id":57548 . То есть нужно найти и вернуть  user_id":57548  по "phone_number":"79261060000" . 

    {"ok":true,"result":[
{"update_id":789128,"message":{"message_id":6,"from":{"id":57548,"is_bot":false,"first_name":"\u0414\u0438\u043c\u0430","username":"smarik","language_code":"ru"},"chat":{"id":57548,"first_name":"\u0414\u0438\u043c\u0430","username":"smarik","type":"private"},"date":1560429,"text":"Sendcontact"}},
{"update_id":78129,"message":{"message_id":7,"from":{"id":57548,"is_bot":false,"first_name":"\u0414\u0438\u043c\u0430","username":"smarik","language_code":"ru"},"chat":{"id":57548,"first_name":"\u0414\u0438\u043c\u0430","username":"smarik","type":"private"},"date":156628,"contact":{"phone_number":"79261060000","first_name":"\u0414\u0438\u043c\u0430","user_id":57548}}},{"update_id":7886830,
"message":{"message_id":11,"from":{"id":57348,"is_bot":false,"first_name":"\u0414\u0438\u043c\u0430","username":"smarik","language_code":"ru"},"chat":{"id":578,"first_name":"\u0414\u0438\u043c\u0430","username":"smarik","type":"private"},"date":1560911,"text":"\u041f\u043f"}}]}

     

    Разбор JSON с мультизапросом

    в JSON

    Опубликовано · Изменено пользователем Dmitry Stolyarov

    В 16.05.2019 в 22:06, Евгений Корепов сказал:

    Мимо проходил. Вот вам код на php (собираем все данные в один массив и энкодим в json) 

    
$QueryArray = array(
	"SELECT ... FROM `...`;",
	"SELECT ... FROM `...`;",
	"SELECT ... FROM `...`;",
	"SELECT ... FROM `...`;",
);

$Index = 0;
$ResultArray = array();
foreach ($QueryArray as $query) {
	if ($mysqli_result = mysqli_query($DBLink, $query)) 	
 		while ($row = mysqli_fetch_array($mysqli_result, MYSQLI_ASSOC)) 	
			$ResultArray[$Index][] = $row;
	$Index++;
}
$ResultJSON = json_encode($ResultArray, JSON_PRETTY_PRINT | JSON_UNESCAPED_UNICODE);
echo $ResultJSON;

    Евгений, если использовать этот код, то как обратиться к массивам в делфи? у меня выборка из 4х таблиц, массивы в json не именованные.   

    пример: 

    
[
    [
        {
            "statusactivity_id": "1",
            "statusactivity_name": "Запись на мастер-класс"
        },
        {
            "statusactivity_id": "2",
            "statusactivity_name": "Мастер-класс пройден"
        },
        {
            "statusactivity_id": "3",
            "statusactivity_name": "Активный"
        },
        {
            "statusactivity_id": "4",
            "statusactivity_name": "Пауза"
        },
        {
            "statusactivity_id": "5",
            "statusactivity_name": "Отказ"
        }
    ],
    [
        {
            "cities_id": "1",
            "cities_idpartner": "2",
            "cities_name": "Москва"
        },
        {
            "cities_id": "2",
            "cities_idpartner": "2",
            "cities_name": "Новосиб"
        },
        {
            "cities_id": "4",
            "cities_idpartner": "2",
            "cities_name": "Владик"
        }
    ],

     

     

    Передача и прием JSON в PHP

    в JSON

    Опубликовано · Изменено пользователем Dmitry Stolyarov

    Подскажите, пжл, правильно ли принимаю на сервере JSON  или нет.

    код вроде рабочий, но сомнения есть (т.к. опыта с PHP нет) 

    формирую json и передаю его на сервер: 

    procedure TfmNewGroup.Button1Click(Sender: TObject);
var
  JSON: ISuperObject;
  Arr: ISuperArray;
  str: string;
begin
  JSON:=TSuperObject.Create();
  JSON.I['lessongrid_idpartner'] := 2;
  JSON.I['lessongrid_type'] := cbDirect.ListItems[cbDirect.ItemIndex].Tag;
  JSON.I['lessongrid_idpointcity'] := cbPoint.ListItems[cbPoint.ItemIndex].Tag;;
  JSON.I['lessongrid_iddircourses'] := cbDirCourse.ListItems[cbDirCourse.ItemIndex].Tag;
  JSON.I['lessongrid_idteacher'] := cbTeacher.ListItems[cbTeacher.ItemIndex].Tag;

  Arr:=TSuperArray.Create();
  Arr.Add(FormatDateTime('t',tedSun.Time));
  Arr.Add(FormatDateTime('t',tedM.Time));
  Arr.Add(FormatDateTime('t',tedT.Time));
  Arr.Add(FormatDateTime('t',tedW.Time));
  Arr.Add(FormatDateTime('t',tedTh.Time));
  Arr.Add(FormatDateTime('t',tedF.Time));
  Arr.Add(FormatDateTime('t',tedS.Time));
  JSON.A['schedule']:=arr;

  str:=JSON.AsJSON();
  PostURL('http://is.sitename.ru/Ins.php',str);

end;

function PostURL(const aurl, json: string): string;
var
  HTTPClient : THTTPClient;
  HttpResponse: IHttpResponse;
  JsonToSend: TStringStream;
begin
 result:= '';
 HTTPClient:= THTTPClient.Create;
 JsonToSend := TStringStream.Create(Json);
 with HTTPClient do
  try
    try
     if (Head('https://google.com').StatusCode < 400) then
      HttpResponse := Post(aurl,JsonToSend);
     Result := HttpResponse.ContentAsString();
    except
      on E: exception do
       ShowMessage('Ошибка сети: '+E.Message);
    end;
  finally
    FreeAndNil(HTTPClient);
    FreeAndNil(JsonToSend);
  end;
end;

    сформированный json: 

    {"lessongrid_idpartner":2,"lessongrid_type":0,"lessongrid_idpointcity":1,"lessongrid_iddircourses":1,"lessongrid_idteacher":1,"schedule":["0:00","5:00","0:00","0:00","0:00","0:00","0:00"]}

     

    на сервере принимаю: 

    <?php
$s  = file_get_contents("php://input", "r");
$obj=json_decode($s);
echo $obj->schedule[2]; //так обращаюсь к массиву
echo $obj->lessongrid_type; // так обращаюсь к конкретному параметру в JSon
?>

     

    Отображение картинок в ListView

    в TListView

    Опубликовано · Изменено пользователем Dmitry Stolyarov

    В ранее приложенном проекте код как у Евгений (KeeperWorld). 

    В итоге я сделал так: 

    procedure TForm1.Button2Click(Sender: TObject);
var
 xJS, xObj: ISuperObject;
 vItemList, iHeader: TListViewItem;
 aJSON, URL: string;
 j: integer;
begin
...
 with xJS.A['data'] do 
  begin
   for j := 0 to length - 1 do
    begin
     xObj := O[j];
    vItemList:= aLV.Items.Add;
    with vItemList do
     begin
      Text := ...;
      Data['sign_URL'] := 'http://is.kidscoders.ru/'+xObj.S['students_photo'];
      Data['sign_Loaded'] := 0;
     end;
    end;
  end;
end;

procedure TForm1.LoadBitmapFromURL(const AURL: string; aBitmap: TBitmap);
var
  thread: TThread;
begin
  thread := TThread.CreateAnonymousThread(
    procedure
    var
      HTTP: THTTPClient;
      HttpResponse: IHttpResponse;
      Result: TMemoryStream;
      ResourceStream: TResourceStream;
    begin
      Result := TMemoryStream.Create;
      HTTP := THTTPClient.Create;
      try
        try
          HttpResponse:= HTTP.Get(AURL, Result);
          if (HTTPResponse.StatusCode <> 200) then //если нет изображения на сервере, то default img
           begin
            ResourceStream := TResourceStream.Create(hInstance, 'PngImage_1', RT_RCDATA);
            ResourceStream.Position := 0;
            Result.LoadFromStream(ResourceStream);
            FreeAndNil(ResourceStream);
           end;
          TThread.Synchronize(TThread.CurrentThread,
            procedure
            var
              aSourceBmp: TBitmap;
            begin
              aSourceBmp := TBitmap.Create;
              aSourceBmp.LoadFromStream(Result);
              if not aSourceBmp.IsEmpty then
              begin
                aBitmap.SetSize(aSourceBmp.Width, aSourceBmp.Height);
                aBitmap.CopyFromBitmap(aSourceBmp);
              end;
              FreeAndNil(aSourceBmp);
            end);
        except
           FreeAndNil(Result);
        end;
      finally
        FreeAndNil(Result);
        FreeAndNil(HTTP);
      end;
    end);
  thread.FreeOnTerminate := true;
  thread.start;

end;

procedure TForm1.aLVUpdatingObjects(const Sender: TObject;
  const AItem: TListViewItem; var AHandled: Boolean);
begin
if AItem.Data['sign_Loaded'].AsInteger = 0 then
 begin
  AItem.Data['sign_Loaded'] := 1;
  LoadBitmapFromURL(AItem.Data['sign_URL'].AsString, AItem.Bitmap);
 end;
end;

     

    Отображение картинок в ListView

    в TListView

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

    В 08.03.2019 в 20:42, Евгений (KeeperWorld) сказал:

    Да там всё Евгений Корепов сделал уже. Я только три копейки своих добавил... :)

    Вот конечный код: 

    
unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, System.Net.HttpClient, System.Generics.Collections,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.ListView.Types, FMX.ListView.Appearances, FMX.ListView.Adapters.Base,
  FMX.Controls.Presentation, FMX.StdCtrls, FMX.Layouts, FMX.ListView;

const
  ListViewItemImageEmpty = -1;
  ListViewItemImageLoading = 0;
  ListViewItemImageLoaded = 1;

type
  TForm1 = class(TForm)
    ListView1: TListView;
    Layout1: TLayout;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure ListView1UpdatingObjects(const Sender: TObject; const AItem: TListViewItem; var AHandled: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FListViewUpdating : Boolean;
    FHTTPClient : THTTPClient;
    FAsyncResultList : TList<IAsyncResult>;
    procedure LoadImage(const AItem: TListViewItem; const AListItemImage : TListItemImage);
    procedure ClearListViewAndCancelAsynchronousRequests();
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

procedure TForm1.FormCreate(Sender: TObject);
begin
  listview1.ItemIndex := 0;
  listview1.ItemAppearance.ItemAppearance := 'Custom';
  listview1.ItemAppearanceObjects.ItemObjects.Accessory.Visible := False;

  FHTTPClient := THTTPClient.Create;
  FAsyncResultList := TList<IAsyncResult>.Create;
  FListViewUpdating := False;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  ClearListViewAndCancelAsynchronousRequests();
  FListViewUpdating := True;
  FreeAndNil(FAsyncResultList);
  if Assigned(FHTTPClient) then
    FHTTPClient.Free;
end;

procedure TForm1.ClearListViewAndCancelAsynchronousRequests();
var
  I: Integer;
begin
  FListViewUpdating := True; // Запрещаем продолжать загружать фотки (если ещё не успели загрузиться все)
  while FAsyncResultList.Count > 0 do  // Дожидаемся окончания выполнения всех IAsyncResult.Cancel, несмотря на асинхронность
  begin
    for I := FAsyncResultList.Count - 1 downto 0 do
      if Assigned(FAsyncResultList.Items) and (not FAsyncResultList.Items.IsCompleted) then
        FAsyncResultList.Items.Cancel
      else
        FAsyncResultList.Delete(I); // Заодно удаляем отработанные элементы
  end;
  ListView1.Items.Clear;
  FListViewUpdating := False;
end;

procedure TForm1.Button1Click(Sender: TObject);
var 
  I: Integer;
  Item: TListViewItem;
  ARandom: Integer;
begin
  ClearListViewAndCancelAsynchronousRequests();
  //Формирование нового списка
  for I := 1 to 10000 do
  begin
    FAsyncResultList.Add(nil);
    FListViewUpdating := True;
    Item := listview1.Items.Add;
    Item.Height := 45;
    Randomize;
    ARandom := Random(6);
    case ARandom of
      0 : Item.data['ImageURL'] := 'http://fire-monkey.ru/uploads/monthly_2017_06/me.thumb.jpg.966ddc17d5602ee14feb43479c1f6963.jpg';
      1 : Item.data['ImageURL'] := 'http://fire-monkey.ru/uploads/monthly_2018_05/B-IpGQmVgTM.thumb.jpg.2ebeb0bd766ab7cf19f10195d6ea2be9.jpg';
      2 : Item.data['ImageURL'] := 'http://fire-monkey.ru/uploads/monthly_2016_04/10.png.b9ab371e8fd38172fee96bcf75fb6699.thumb.png.b0685259b03bfff540903913845532a5.png';
      3 : Item.data['ImageURL'] := 'https://secure.gravatar.com/avatar/9942c50b1641a921c52d4b389bd718d6?d=http://fire-monkey.ru/uploads/monthly_2017_12/K_member_87.png';
      4 : Item.data['ImageURL'] := 'http://fire-monkey.ru/uploads/monthly_2016_11/photo-1529.png.7267be10b59f950b7c5bb3f34a60901e.thumb.png.22027ae85266216220310ed694d57628.png';
      5 : Item.data['ImageURL'] := 'http://fire-monkey.ru/uploads/profile/photo-thumb-115.jpg';
    end;
    Item.Data['ImageState'] := ListViewItemImageEmpty;
    FListViewUpdating := False;
    Item.Adapter.ResetView(Item);
  end;
end;

procedure TForm1.LoadImage(const AItem: TListViewItem; const AListItemImage : TListItemImage);
var
  K: Integer; // Анонимная процедура захватывает локальную переменную, а не обращается к AItem, которой уже может не быть в момент _окончания_ скачивания фотки
  AAsyncResult: IAsyncResult;
begin
  if Not Assigned(AItem) or Not Assigned(AListItemImage) then
    Exit;
  if AItem.Data['ImageState'].AsInteger <> ListViewItemImageEmpty then
    Exit;
  if AItem.Data['ImageURL'].AsString.IsEmpty then
    Exit;
  AItem.Data['ImageState'] := ListViewItemImageLoading;
  K := AItem.Index; // Запоминаем индекс в локальную K, которая уйдёт в анонимку (время жизни K > времени жизни анонимки)
  FAsyncResultList.Items[K] := FHTTPClient.BeginGet(
    procedure (const ASyncResult: IAsyncResult)
    var
      AHTTPResponse: IHTTPResponse;
    begin
      if ASyncResult.IsCancelled then
        Exit;
      try
        AHTTPResponse := THTTPClient.EndAsyncHTTP(ASyncResult);
        if Not Assigned(AHTTPResponse) then
          Exit;
        if AHTTPResponse.StatusCode <> 200 then
          Exit;
      except
        Exit;
      end;

      TThread.Synchronize(Nil,
        procedure
        begin
          if FListViewUpdating or ASyncResult.IsCancelled then // Выходим, так как внутри анонимной процедуры AItem или AListItemImage - не сброшены в nil, хотя их уже может и не быть
            Exit;
          if Not Assigned(AItem) or Not Assigned(AListItemImage) then
            Exit;
          AListItemImage.BeginUpdate;
          AListItemImage.Bitmap := TBitmap.Create;
          AListItemImage.Bitmap.LoadFromStream(AHTTPResponse.ContentStream);
          AListItemImage.EndUpdate;
          AItem.Data['ImageState'] := ListViewItemImageLoaded;
          FAsyncResultList.Items[K] := nil; 
        end
      );
    end,
    AItem.Data['ImageURL'].AsString
  );
end;

procedure TForm1.ListView1UpdatingObjects(const Sender: TObject; const AItem: TListViewItem; var AHandled: Boolean);

  function SetupImageObject(const AName: String; AWidth, AHeight, X , Y: Single; AAlign, AVertAlign: TListItemAlign): TListItemImage;
  var
    LIT: TListItemText;
  begin
    Result := TListItemImage(AItem.View.FindDrawable(AName));
    if Result = Nil then
    begin
      // Создаём картинку
      Result := TListItemImage.Create(AItem);
      Result.Name := AName;
      Result.Bitmap := nil;
      Result.OwnsBitmap := True;
      // Создаём надпись
      LIT := TListItemText.Create(AItem);
      LIT.Name := 'LIT-' + AItem.Index.ToString;
      LIT.Width := 100;
      LIT.Height := 22;
      LIT.PlaceOffset.X := X + AWidth + 10;
      LIT.PlaceOffset.Y := Y;
      LIT.Text := LIT.Name;
      LIT.Visible := True;
    end;
    Result.Width := AWidth;
    Result.Height := AHeight;
    Result.PlaceOffset.X := X;
    Result.PlaceOffset.Y := Y;
    Result.Align := AAlign;
    Result.VertAlign := AVertAlign;
    Result.ScalingMode := TImageScalingMode.StretchWithAspect;
    Result.Visible := True;
  end;

Var 
  AListItemImage: TListItemImage;
begin
  if FListViewUpdating then
    Exit;
  AListItemImage := SetupImageObject('s_image', 35, 35, 0 , 0, TListitemalign.Leading, TListItemAlign.Center);
  LoadImage(AItem, AListItemImage);
  AHandled := True;
end;

end.

      

    FAsyncResultList.Items[K] := FHTTPClient.BeginGet(...

    странно, на этой строчке получаю ошибку "arguments out of range"

    Разбор JSON с мультизапросом

    в JSON

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

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

    вы просто без разделителей склеиваете три разных JSON-массива

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

    
function GetValuesAsJson($query) {
  .....
}

    тогда будет например 

    
'{"Arr1":'. GetValuesAsJson($query1). ',  "Arr2":'.GetValuesAsJson($query2).', "Arr3":'.GetValuesAsJson($query3).'}'

    ну и разбор полученного объекта например с помощью XSuperObject. Примеры есть на офсайте https://github.com/onryldz/x-superobject

    krapotkin, спасибо!

    Публикую, может кому-то пригодится..

    на стороне PHP: 

     $query1 = "SELECT ... FROM `...`;";
 $query2 = "SELECT ... FROM `...`;";
 $query3 = "SELECT ... FROM `...`;";
 $query4 = "SELECT ... FROM `...`;";

function GetValuesAsJson($query, $Link) 
{
 if ($DBResult = mysqli_query($Link, $query)) {
  $ResultArray = array();	
  $Index = 0;
    while ($row = mysqli_fetch_array($DBResult, MYSQLI_ASSOC))
    {
	 $ResultArray[$Index] = $row;
	 $Index++;	
	  }
  $ResultJSON = json_encode($ResultArray, JSON_PRETTY_PRINT | JSON_UNESCAPED_UNICODE);
	return $ResultJSON;
	mysqli_free_result($DBResult);
    }
};

echo '{"Arr1":'. GetValuesAsJson($query1, $DBLink).',  "Arr2":'.GetValuesAsJson($query2, $DBLink).',  "Arr3":'.GetValuesAsJson($query3, $DBLink).',  "Arr4":'.GetValuesAsJson($query4, $DBLink).'}';

mysqli_close($DBLink);

    на стороне delphi: 

    xJS := SO(aJSON); 
  with xJS.A['Arr1'] do // имя массива
  begin
    for j := 0 to length - 1 do
    begin
      xObj := O[j];
      Memo1.Lines.Add(xObj.S['cities_name']); // собираем нужные данные
...
   end;

     

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