Dmitry Stolyarov

Здравствуйте, поделитесь пжл у кого есть последним FireMonkeyPremiumStyles Pack ?

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

Друзья, неужели никто не поможет?

Подскажите, пытаюсь выгрузить на сервер картинку в формате потока. ничего не получается, что не так? /// ... 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!"; }

Рабочий код: 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;

А как-то нужно обрабатывать последний параметр? Поставил nil, анимация появилась, но с тормозами.

Открываю список фото в галерее с помощью: 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 не пойму.. Подскажите пжл...

Подскажите, почему может не работать на Анройде плавное переключение вкладок? Под Win все работает. TabControl1.SetActiveTabWithTransition(TabControl1.Tabs[1], TTabTransition.Slide, TTabTransitionDirection.tdReversed)

Вариант № 1 - не помогло. странно, но пример из ссылки "Helper для TBitmap - асинхронная" не работает на андроиде - после запуска картинки не отображаются в листвью.. при этом под OSX работает.. как теперь это запустить под андройдом фиг пойми.. поделитесь, пжл, рабочим кодом под Андроид загрузки картинок в листвью в отдельном потоке.

Delphi 10.3 Community Edition. Сделал без потока - все грузится. Проблема в потоке, такое ощущение что он умирает не отработав/не запустившись.

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

это код успешно работает под виндой

картинки по HTTPS, под WIN все работает, с Маком какая-то беда..

Подскажите, пжл, как прописать 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 нет...

Добрый день! можете дать пример реализации?