Перейти к содержанию
  • Регистрация

Dmitry Stolyarov

Пользователи
  • Публикаций

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

  • Посещение

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

    2

Dmitry Stolyarov стал победителем дня 22 августа 2018

Dmitry Stolyarov имел наиболее популярный контент!

Информация о Dmitry Stolyarov

  • Звание
    Продвинутый пользователь

Посетители профиля

Блок последних пользователей отключён и не показывается другим пользователям.

  1. Вариант № 1 - не помогло. странно, но пример из ссылки "Helper для TBitmap - асинхронная" не работает на андроиде - после запуска картинки не отображаются в листвью.. при этом под OSX работает.. как теперь это запустить под андройдом фиг пойми.. поделитесь, пжл, рабочим кодом под Андроид загрузки картинок в листвью в отдельном потоке.
  2. Delphi 10.3 Community Edition. Сделал без потока - все грузится. Проблема в потоке, такое ощущение что он умирает не отработав/не запустившись.
  3. на маке работает загрузка в битмап если делать это не в отдельном потоке, а вот с потоком какая-то беда...
  4. это код успешно работает под виндой
  5. картинки по HTTPS, под WIN все работает, с Маком какая-то беда..
  6. Подскажите, пжл, как прописать 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 нет...
  7. Добрый день! можете дать пример реализации?
  8. Dmitry Stolyarov

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

    Помогите с помощью 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"}}]}
  9. а как это сделать c XSuperJSON?
  10. вроде работает, но за код php не уверен, что так правильно..
  11. Dmitry Stolyarov

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

    Подскажите, пжл, правильно ли принимаю на сервере 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 ?>
  12. В ранее приложенном проекте код как у Евгений (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;
  13. собрал в отдельный проект с указанным кодом и в итоге совсем картинки не грузятся... Projects.rar
×
×
  • Создать...