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

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

Пользователи
  • Постов

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

  • Посещение

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

    100

Активность репутации

  1. Like
    Евгений Корепов получил реакцию от Татьяна в Андроид 9 и Интернет   
    Возможно вы отправляете запрос на http вместо https ? Запросы без шифрования теперь запрещены по умолчанию. Но это можно обойти - тут в нескольких недавних темах  это обсуждалось.
  2. Like
    Евгений Корепов получил реакцию от Ingalime в Андроид 9 и Интернет   
    Возможно вы отправляете запрос на http вместо https ? Запросы без шифрования теперь запрещены по умолчанию. Но это можно обойти - тут в нескольких недавних темах  это обсуждалось.
  3. Like
    Евгений Корепов отреагировална gonzales в [Delphi Berlin FMX Win32] Как реализовать Drag and Drop у StringGrid?   
    Отвечу сам себе. Проблема решена.
    Всего два дня поисков и вот он, случай - краеугольный камень поиска ошибок! Меня аж забомбило, когда я это откопал. Оказалось, что мой грид лежит на лайоуте, у которого hittest = false. Так вот до тех пор, пока я не перевел его в true грид отказывался принимать ondragover. Но как только layout.hittest:=true все заработало. Дальше дело техники.
  4. Like
    Евгений Корепов отреагировална #WAMACO в Как получить значения переменных пакета?   
    с помощью SQL
    select * from GLOBALS 
  5. Like
    Евгений Корепов отреагировална #WAMACO в MultiView показывается только в части окна   
    добавьте дополнительный layout (align =  contest) и на него поместите все компоненты и у MultiView parent укажите layout
  6. Like
    Евгений Корепов отреагировална qz5 в Как можно обновиться в Google Play после 1 августа   
    Хорошая новость: вместо ожидания 10.4 - выйдет версия 10.3.3 в 2019 году, в котором появится компилятор для Андроид 64-бит
    Новый роадмап найдете здесь: https://community.idera.com/developer-tools/b/blog/posts/august-2019-delphi-android-beta-plans-august-roadmap-update
  7. Like
    Евгений Корепов получил реакцию от Barbanel в Проверка наличия прав   
    Вам удалось решить проблему для камеры? Перелопатил весь интернет, но похоже Эмба не озаботилась этим вопросом. 
    Пока присобачил костыль из говна и палок - в AppEvent определяю что приложение стало не активным TApplicationEvent.WillBecomeInactive, значит вылез диалог спрашивания разрешений, После этого по событию TApplicationEvent.BecameActive (диалог завершен), проверяю что приходит от камеры в FCamera.OnSampleBufferReady - если черный-черный ничего, то можно подумать что разрешение не было дано )))))))) От этого костыля у меня кровь из глаз....
  8. Like
    Евгений Корепов отреагировална Slym в ListBoxItem.Data - под Windows все работает под Android выдает ошибку.   
    Под андроид идет опция AUTOREFCOUNT - все объекты имеют счетчик ссылок...
    любое присваивание - это +/- ссылки, даже Free не честное:
    procedure TObject.Free;
    begin
    // under ARC, this method isn't actually called since the compiler translates
    // the call to be a mere nil assignment to the instance variable, which then calls _InstClear
    {$IFNDEF AUTOREFCOUNT}
      if Self <> nil then
        Destroy;
    {$ENDIF}
    end;
    т.е. Free ничего не делает!!!  - экземпляр остается в зомбирежиме (ты его убил а оно ходит) пока счетчик до 0 не до тикает.
    TObject(TreeItem);  - пытается найти методы подсчета ссылок (Это же объект!) и не находит т.к. это не объект вовсе.
    TTreeItem = record меняем на TTreeItem = class, честно создаем и не забываем убить, хотя под AUTOREFCOUNT - оно само должно помереть если циклической ссылочности нет.
  9. Like
    Евгений Корепов отреагировална Владимир Б. в TInstructor - Step-By-Step инструкция   
    Собственно понадобился подобный компонент для FMX, но готового решения найти не смог - пришлось ваять свой.
     
    Использовать проще простого:
    var scenaries: TDictionary<TFmxObject, string>; begin scenaries := TDictionary<TFmxObject, string>.Create; scenaries.Add(btn_1, '1 Button'); scenaries.Add(btn_2, '2 Button'); scenaries.Add(btn_3, '3 Button'); scenaries.Add(rctngl, 'Rectangle'#13#10'Rectangle'#13#10'Rectangle'#13#10'Rectangle'#13#10'Rectangle'#13#10'Rectangle'#13#10'Rectangle'); scenaries.Add(pnl_1, 'Panel Panel Panel Panel Panel Panel Panel Panel Panel Panel'#13#10'Panel'); scenaries.Add(nil, 'Msg without target control!'); try instructor.LoadSteps(scenaries); finally FreeAndNil(scenaries); end;  
    Репозиторий GitHub: https://github.com/ange007/TInstructor/

  10. Like
    Евгений Корепов получил реакцию от Ingalime в Подключение Admob к iOS   
    Ответил мне автор JVEsuite, дай бог ему здоровья!

    Эпл успешно прожевал приложение и загрузил сборку.
  11. Like
    Евгений Корепов отреагировална Олег Киреев в Приложение для расчёта сцепления автомобиля и его привода v.1.1   
    Это приложение для OS Windows выполняет:
    1.Расчёт сцепления:
    -расчёт и подбор геометрических параметров нажимного и 
    ведомого дисков, муфты выключения;
    -проверка параметров по теплонагруженности пар трения;
    -расчёт всех наиболее нагруженных деталей сцепления 
    (пружины, пластины, подшипник).
    2.Расчёт пневмогидравлического привода сцелпения:
    -подбор и проверка управляющего и исполнительного 
    органов;
    -объём жидкости.
    3.Возможность вноса и редактирования исходных данных и 
    результатов в БД.
    4.Распечатку всего расчёта с исходными данными, 
    формулами, графиками, используемой литературой и 
    результатами в MS Word.
    5.Просмотр и изучение нажимного, ведомого дисков
    и муфты выключения в 3D.
    Изначально для работы в приложении необходимы 
    некоторые
    знания конструкции сцепления и теории расчёта.
     Автор: Олег Киреев-ведущий инженер-конструктор,
                  kireevoleg1966@gmail.com, +375 29 676 13 84
                  БЕЛАРУСЬ, г.Минск.
    Приму Ваши замечания и предложения.
    По совету Равиля Зарипова РАЗМЕСТИЛ на файлообменнике 12.08.2019г по этой: https://mega.dp.ua/a27WmeXKwY ссылке. На этом ресурсе обещают хранить 90 дней. Интересно услышать Ваши отзывы.




  12. Like
    Евгений Корепов отреагировална FeLDMARShaL в [iOS] Полноценная фоновая работа приложения   
    Расскажу о том как я добился нормальной фоновой работы приложения. В моем понимании нормальная фоновая работа приложения - это сохранять геокоординаты и систематически (по мере их накопления передавать на сервер). По сути у нас получился трекер. Те кто считают что iOS такое не умеет делать, и все что будет написано ниже это фейк лучше закройти эту тему. Итак начнем, по пунктам:
    1) Добавляем к проекту ключ NSLocationAlwaysAndWhenInUseUsageDescription - для новых иОС это обязательно, начиная с 11 или 12 версии уже не помню

    2) Сообщаем приложению о намерении что мы будем использовать геокоординаты в фоне (редактируем ключ UIBackgroundModes выставляя галочку напротив location)

    3) Далее  для того чтобы не поломать другие приложения которые используют геолокацию создаем специальную дерективу, которая будет сообщать о том что наше приложение будет использовать геолокацию в фоне, я ее назвал iOS_RequestAlwaysAuthorization

    4) Дальше намного сложнее, нам нужно исправить исходники самой Delphi, а именно System.iOS.Sensors. Изменять будем процедуру TiOSLocationSensor.DoStart, все что отличается от стандартного у меня в рамках описания моей директивы:
    function TiOSLocationSensor.DoStart: Boolean; var I: Integer; begin {$ifdef iOS_RequestAlwaysAuthorization} if TOSVersion.Check(8) and (FLocater <> nil) then FLocater.requestAlwaysAuthorization; {$else iOS_RequestAlwaysAuthorization} if TOSVersion.Check(8) and (FLocater <> nil) then FLocater.requestWhenInUseAuthorization; {$endif iOS_RequestAlwaysAuthorization} // check authorization if Authorized = TAuthorizationType.atUnauthorized then SensorError(SLocationServiceUnauthorized); // check if location sensor is enabled if not FLocater.locationServicesEnabled then SensorError(SLocationServiceDisabled); // start location updates if (LocationChange = TLocationChangeType.lctLarge) and CanUseSignifChangeNotifs then FLocater.startMonitoringSignificantLocationChanges else FLocater.startUpdatingLocation; // start heading updates if CanUseHeading then begin FLocater.startUpdatingHeading; end; // start monitoring regions if CanMonitorRegions then for I := 0 to Regions.Count - 1 do FLocater.startMonitoringForRegion(ConvLocationRegion(Regions[I])); Result := FLocater.locationServicesEnabled; if Result then Result := Authorized = TAuthorizationType.atAuthorized; {$ifdef iOS_RequestAlwaysAuthorization} FLocater.setAllowsBackgroundLocationUpdates(True); FLocater.setPausesLocationUpdatesAutomatically(False); {$endif iOS_RequestAlwaysAuthorization} end; Собственно усе, можно наслаждаться фоновой работой. Все это работает под Delphi 10.2.3. На телефоне iPhone 6s под управлением iOS 11. Как было сказано выше, работает как геолокация так и инет и вообще все остальные процессы внтури приложения, такие как TTimer
    Собственно вот результат данного трекера:

     
    Если приблизить то можно увидеть насколько точно и часто он обновляет координаты:

     
    И да, огромное спасибо человеку с ником Artyom Karapetyan, именно он натолкнул на мысль того как надо правильно все сделать
  13. Like
    Евгений Корепов получил реакцию от Ingalime в Версия андроид   
    "А.Ван" это что? Трудно понимать ход мыслей человека коверкающего не сложные слова. 
    Видимо имеется ввиду Android One? Я вас разочарую - получением рута и удалением софта от производителя вы не получите чистый андроид. Вы получите все  тот же андроид который установил (и возможно неким образом модифицировал) производитель устройства. Ну и конечно не будет никаких обновлений версий и ежемесячных обновлений безопасности.
    Не знаю что у вас за проблемы с уведомлениями и разрешениями на рутованных и превращенных в "А.Ван" устройствах. На Android One уведомления отлично работаю, разрешения работают согласно документации.
    Почему вы считаете что я нахваливаю Android One? Я всего лишь рекомендую. И откуда у вас сведения что телефон с Android One "не сможет"? Судя по вашей ненависти к Xiaomi и Android One, вы никогда не пробовали ни то, ни другое. Откуда тогда этот бесценный опыт? Громкие, безапелляционные заявления признак небольшого ума...
    Из всего зоопарка моих устройств, Mi A1 служит мне дольше всех, третий год. С ним я получил бесценный опыт попробовав 7, 8 и теперь уже 9 андроид. Видите, мое заявление "не один год" основывается на личном продолжительном опыте, а не на эмоциях и ненависти к чему либо.
    И не смешите про "симметричный ответ" ? На мою короткую, обоснованную и не навязчивую рекомендацию автору топика, вы расписали тут целую теорию заговора, целью которой видимо является уничтожение человечества. ?
    P.S. Кстати к седьмому классу мы успешно подготовились. Школьная форма для дочери куплена. Тетради, ручки, карандаши и линейки тоже. Удивительно как быстро растут дети, только вроде в первый класс пошла, а тут раз и уже седьмой на носу.
  14. Like
    Евгений Корепов получил реакцию от Ingalime в Версия андроид   
    Нет, дойдет, поясните пожалуйста:   Проект Android One был представлен в 2014, а Орео вышел в 2017, поэтому в строке "Build.VERSION_CODES.O" буква "О" означает Орео  -  вот для меня ход ваших мыслей неясен совсем, что это значит? Что Нибиру прилетит в четверг? ?
    Ну я рад за вас )))
    Аргументы закончились? Теперь оскорбления? Заметьте, даже готовясь к шестому классу (если честно, то к седьмому), я не позволяю себе оскорблять вас и обижать заявляя что вам не дадут выучить стишок (  Вот это было очень обидно.
  15. Like
    Евгений Корепов получил реакцию от Ingalime в Версия андроид   
    "Android One" это не печенье Орео, это 
    Источник https://ru.wikipedia.org/wiki/Android_One
    Форум присылает копии сообщений, даже если вы потом впопыхах его редактируете, все видят исходное сообщение:
    Удивительно как по моей фразе "Просто покупайте любой Xiaomi c Android One (чистый андроид)" вы определили что я печатал ее с умным видом (одновременно думая - он у меня есть, он самый лучший) ?
    Еще у меня есть HTC, Samsung, Dexp. На них я тоже тестирую приложения. И это меня не коробит, в отличие от вас. О! А еще у меня есть телефон на iOS, марки Apple. ?
    Вообщем я сочувствую вам...
    P.S. С интересом послушаю удивительную историю возникновения вашей ненависти к Xiaomi, думаю это будет захватывающе! Типа робот-пылесос Xiaomi оторвал вам ногу, или беспроводные наушники Xiaomi приказывают вам делать плохие вещи, или просто авторитетный пятиклассник сказал вам что Xiaomi гавно?
     
  16. Like
    Евгений Корепов получил реакцию от Ingalime в Версия андроид   
    Вы понимаете что такое "Android One" ? Погуглите. Вы несете какую то ересь. Утверждаете что приложение будет работать только на том устройстве, на котором вы его разрабатывали. Это бред. Если приложение работает на одном устройстве, то оно будет работать и на 99% остальных. Если у вас какая то ненависть к определенному производителю, то не вздумайте заходить на этом форуме в раздел разработки для iOS и macOS - там все запускают приложения на устройствах Apple! Ужас какой!  )))
    Вот вопрос уважаемого автора темы:
    А вот в чем вы меня обвиняете:
     
    Заметьте что кроме вас тут никто не бросается обвинениями, все уважают мнение друг друга и до последнего времени форуме была дружеская обстановка. Так что предлагаю начать сначала, просто держите своих тараканов при себе и мы подружимся )))
  17. Like
    Евгений Корепов отреагировална CyberStorm в Как можно обновиться в Google Play после 1 августа   
    У меня тоже обновления без проблем проходят! Просто как всегда загружаю .apk и заливаю новые версии, никто не жалуется и ничего не просит.
    <uses-sdk android:minSdkVersion="19" android:targetSdkVersion="28" />
  18. Like
    Евгений Корепов отреагировална sinuke в Как можно обновиться в Google Play после 1 августа   
    Да, у меня.

    Я только не знаю, с чем это связано. Запрос именно на это приложение я отправлял вчера и ответа еще не получил. Но неделю назад отправлял на другие приложения (ответ я в какой-то теме публиковал).
    Но вчера на старые мои запросы пришли письма о том, решилась ли моя проблема. И вот я там еще раз написал о том, что хотелось бы получить продление, что у делфи нет компилятора андройд-64, что будет он только осенью или зимой и что выпущу обновление в течение 2-х недель после появления компилятора. Утром пришел формальный ответ, что мол передадим в техническую группу и чуть что - сообщим
  19. Thanks
    Евгений Корепов получил реакцию от Wolfone в Работа с камерой - Rad 10.3   
    Вот кусок кода из боевого приложения, достаточно разрешения на доступ к камере, больше никаких разрешений не надо. Надеюсь вам поможет.
    FScanCamera : TCameraComponent;
    FScanManager - не обращайте внимания, это распознавание QR кодов.
    ImageCamera : TImage; - картинка на форме где отображаются кадры с камеры
    Работа начинается с ScanStart()
    {$IFDEF MOBILE} // *************************************************************** // ****** Сканирование QR кода ****** // *************************************************************** procedure TFormMain.ScanStart(); var AppEventSvc: IFMXApplicationEventService; APermissionCamera : String; begin if TPlatformServices.Current.SupportsPlatformService(IFMXApplicationEventService, IInterface(AppEventSvc)) then AppEventSvc.SetApplicationEventHandler(AppEvent); FScanFrameTake := 0; CButtonScan.Text:='Отменить сканирование'; {$IFDEF IOS} ScanStarting(); {$ENDIF IOS} {$IFDEF ANDROID} APermissionCamera := JStringToString(TJManifest_permission.JavaClass.CAMERA); PermissionsService.RequestPermissions([APermissionCamera], CameraPermissionRequestResult, ExplainReason); {$ENDIF ANDROID} end; procedure TFormMain.ScanStop(); begin if Assigned(FScanCamera) then begin if FScanCamera.Active then FScanCamera.Active:=False; FScanCamera.Free; end; { if Assigned(FScanManager) then begin FScanManager.Free; end; } FScanInProgress := false; LayoutCamera.Height:=0; CButtonScan.Text:='Сканировать QR-код'; end; {$IFDEF ANDROID} procedure TFormMain.CameraPermissionRequestResult(Sender: TObject; const APermissions: TArray<string>; const AGrantResults: TArray<TPermissionStatus>); begin if (Length(AGrantResults) = 1) and (AGrantResults[0] = TPermissionStatus.Granted) then begin ScanStarting(); end else TDialogService.ShowMessage('Сканирование QR-кода не возможно, требуемое разрешение не было дано') end; procedure TFormMain.ExplainReason(Sender: TObject; const APermissions: TArray<string>; const APostRationaleProc: TProc); begin TDialogService.ShowMessage('Приложению нужен доступ к камере для сканирования QR-кода ...', procedure(const AResult: TModalResult) begin APostRationaleProc; end) end; {$ENDIF ANDROID} procedure TFormMain.ScanStarting(); begin FScanInProgress := false; if Not Assigned(FScanManager) then FScanManager:= TScanManager.Create(TBarcodeFormat.QR_CODE, nil); if Not Assigned(FScanCamera) then FScanCamera:=TCameraComponent.Create(Self); FScanCamera.OnSampleBufferReady:=ScanCameraSampleBufferReady; FScanCamera.Quality := FMX.Media.TVideoCaptureQuality.MediumQuality; FScanCamera.Active := false; FScanCamera.Kind := FMX.Media.TCameraKind.BackCamera; FScanCamera.FocusMode := FMX.Media.TFocusMode.ContinuousAutoFocus; FScanCamera.Active := True; LayoutCamera.Height:=LayoutCamera.Width; end; { procedure TFormMain.btnStopCameraClick(Sender: TObject); begin end; } procedure TFormMain.ScanCameraSampleBufferReady(Sender: TObject; const ATime: TMediaTime); begin TThread.Synchronize(TThread.CurrentThread, GetImageCamera); end; procedure TFormMain.GetImageCamera; var scanBitmap: TBitmap; ReadResult: TReadResult; begin FScanCamera.SampleBufferToBitmap(ImageCamera.Bitmap, True); if (FScanInProgress) then exit; { This code will take every 4 frame. } Inc(FScanFrameTake); if (FScanFrameTake mod 4 <> 0) then exit; scanBitmap := TBitmap.Create(); scanBitmap.Assign(ImageCamera.Bitmap); ReadResult := nil; // There is bug in Delphi Berlin 10.1 update 2 which causes the TTask and // the TThread.Synchronize to cause exceptions. // See: https://quality.embarcadero.com/browse/RSP-16377?jql=project%20%3D%20RSP%20AND%20issuetype%20%3D%20Bug%20AND%20affectedVersion%20%3D%20%2210.1%20Berlin%20Update%202%22%20AND%20status%20%3D%20Open%20ORDER%20BY%20priority%20DESC TTask.Run( procedure begin try FScanInProgress := True; try ReadResult := FScanManager.Scan(scanBitmap); except on E: Exception do begin TThread.Synchronize(nil, procedure begin LabelAPIKey.Text := 'Ключ доступа : ' + E.Message; end); exit; end; end; TThread.Synchronize(nil, procedure begin if (ReadResult <> nil) then begin if ProcessingAPIKeyHex(ReadResult.Text) then begin ScanStop(); end; end; end); finally ReadResult.Free; scanBitmap.Free; FScanInProgress := false; end; end); end; { Make sure the camera is released if you're going away. } function TFormMain.AppEvent(AAppEvent: TApplicationEvent; AContext: TObject): Boolean; begin case AAppEvent of TApplicationEvent.WillBecomeInactive, TApplicationEvent.EnteredBackground, TApplicationEvent.WillTerminate: if Assigned(FScanCamera) then FScanCamera.Active := false; end; Result:=True; end;  
  20. Like
    Евгений Корепов получил реакцию от binkus в Работа с камерой - Rad 10.3   
    Вот кусок кода из боевого приложения, достаточно разрешения на доступ к камере, больше никаких разрешений не надо. Надеюсь вам поможет.
    FScanCamera : TCameraComponent;
    FScanManager - не обращайте внимания, это распознавание QR кодов.
    ImageCamera : TImage; - картинка на форме где отображаются кадры с камеры
    Работа начинается с ScanStart()
    {$IFDEF MOBILE} // *************************************************************** // ****** Сканирование QR кода ****** // *************************************************************** procedure TFormMain.ScanStart(); var AppEventSvc: IFMXApplicationEventService; APermissionCamera : String; begin if TPlatformServices.Current.SupportsPlatformService(IFMXApplicationEventService, IInterface(AppEventSvc)) then AppEventSvc.SetApplicationEventHandler(AppEvent); FScanFrameTake := 0; CButtonScan.Text:='Отменить сканирование'; {$IFDEF IOS} ScanStarting(); {$ENDIF IOS} {$IFDEF ANDROID} APermissionCamera := JStringToString(TJManifest_permission.JavaClass.CAMERA); PermissionsService.RequestPermissions([APermissionCamera], CameraPermissionRequestResult, ExplainReason); {$ENDIF ANDROID} end; procedure TFormMain.ScanStop(); begin if Assigned(FScanCamera) then begin if FScanCamera.Active then FScanCamera.Active:=False; FScanCamera.Free; end; { if Assigned(FScanManager) then begin FScanManager.Free; end; } FScanInProgress := false; LayoutCamera.Height:=0; CButtonScan.Text:='Сканировать QR-код'; end; {$IFDEF ANDROID} procedure TFormMain.CameraPermissionRequestResult(Sender: TObject; const APermissions: TArray<string>; const AGrantResults: TArray<TPermissionStatus>); begin if (Length(AGrantResults) = 1) and (AGrantResults[0] = TPermissionStatus.Granted) then begin ScanStarting(); end else TDialogService.ShowMessage('Сканирование QR-кода не возможно, требуемое разрешение не было дано') end; procedure TFormMain.ExplainReason(Sender: TObject; const APermissions: TArray<string>; const APostRationaleProc: TProc); begin TDialogService.ShowMessage('Приложению нужен доступ к камере для сканирования QR-кода ...', procedure(const AResult: TModalResult) begin APostRationaleProc; end) end; {$ENDIF ANDROID} procedure TFormMain.ScanStarting(); begin FScanInProgress := false; if Not Assigned(FScanManager) then FScanManager:= TScanManager.Create(TBarcodeFormat.QR_CODE, nil); if Not Assigned(FScanCamera) then FScanCamera:=TCameraComponent.Create(Self); FScanCamera.OnSampleBufferReady:=ScanCameraSampleBufferReady; FScanCamera.Quality := FMX.Media.TVideoCaptureQuality.MediumQuality; FScanCamera.Active := false; FScanCamera.Kind := FMX.Media.TCameraKind.BackCamera; FScanCamera.FocusMode := FMX.Media.TFocusMode.ContinuousAutoFocus; FScanCamera.Active := True; LayoutCamera.Height:=LayoutCamera.Width; end; { procedure TFormMain.btnStopCameraClick(Sender: TObject); begin end; } procedure TFormMain.ScanCameraSampleBufferReady(Sender: TObject; const ATime: TMediaTime); begin TThread.Synchronize(TThread.CurrentThread, GetImageCamera); end; procedure TFormMain.GetImageCamera; var scanBitmap: TBitmap; ReadResult: TReadResult; begin FScanCamera.SampleBufferToBitmap(ImageCamera.Bitmap, True); if (FScanInProgress) then exit; { This code will take every 4 frame. } Inc(FScanFrameTake); if (FScanFrameTake mod 4 <> 0) then exit; scanBitmap := TBitmap.Create(); scanBitmap.Assign(ImageCamera.Bitmap); ReadResult := nil; // There is bug in Delphi Berlin 10.1 update 2 which causes the TTask and // the TThread.Synchronize to cause exceptions. // See: https://quality.embarcadero.com/browse/RSP-16377?jql=project%20%3D%20RSP%20AND%20issuetype%20%3D%20Bug%20AND%20affectedVersion%20%3D%20%2210.1%20Berlin%20Update%202%22%20AND%20status%20%3D%20Open%20ORDER%20BY%20priority%20DESC TTask.Run( procedure begin try FScanInProgress := True; try ReadResult := FScanManager.Scan(scanBitmap); except on E: Exception do begin TThread.Synchronize(nil, procedure begin LabelAPIKey.Text := 'Ключ доступа : ' + E.Message; end); exit; end; end; TThread.Synchronize(nil, procedure begin if (ReadResult <> nil) then begin if ProcessingAPIKeyHex(ReadResult.Text) then begin ScanStop(); end; end; end); finally ReadResult.Free; scanBitmap.Free; FScanInProgress := false; end; end); end; { Make sure the camera is released if you're going away. } function TFormMain.AppEvent(AAppEvent: TApplicationEvent; AContext: TObject): Boolean; begin case AAppEvent of TApplicationEvent.WillBecomeInactive, TApplicationEvent.EnteredBackground, TApplicationEvent.WillTerminate: if Assigned(FScanCamera) then FScanCamera.Active := false; end; Result:=True; end;  
  21. Like
    Евгений Корепов отреагировална Dmitry_4501 в [РЕШЕНО]: Как отловить кнопки пульта ДУ   
    В общем. Embarcadero решились таки исправить проблему с кнопками сами и теперь приложение у меня работает нормально, все кнопки с пульта отлавливаются и коды приходят, но все же бегло просмотрел файлы и сразу же наткнулся на то, что не все кнопки были добавлены, ибо у Google коды кнопок идут от 0 до 285, а вот Embarcadero добавили только от 0 до 221, не знаю, почему не добавили все.
    Используемая версия IDE: Rio 10.3.2
  22. Haha
    Евгений Корепов получил реакцию от #WAMACO в Версия андроид   
    "Android One" это не печенье Орео, это 
    Источник https://ru.wikipedia.org/wiki/Android_One
    Форум присылает копии сообщений, даже если вы потом впопыхах его редактируете, все видят исходное сообщение:
    Удивительно как по моей фразе "Просто покупайте любой Xiaomi c Android One (чистый андроид)" вы определили что я печатал ее с умным видом (одновременно думая - он у меня есть, он самый лучший) ?
    Еще у меня есть HTC, Samsung, Dexp. На них я тоже тестирую приложения. И это меня не коробит, в отличие от вас. О! А еще у меня есть телефон на iOS, марки Apple. ?
    Вообщем я сочувствую вам...
    P.S. С интересом послушаю удивительную историю возникновения вашей ненависти к Xiaomi, думаю это будет захватывающе! Типа робот-пылесос Xiaomi оторвал вам ногу, или беспроводные наушники Xiaomi приказывают вам делать плохие вещи, или просто авторитетный пятиклассник сказал вам что Xiaomi гавно?
     
  23. Like
    Евгений Корепов отреагировална Николай_1988 в ListView нестандартное расположение ScrollBar'a   
    Всем спасибо, разобрался
    procedure UpdateListSubSection;
    var
    id, Subsection : string;
    begin
      F_General.LV_SubSection.BeginUpdate;
      if F_General.LV_SubSection.Items.Count <> 0 then
      F_General.LV_SubSection.Items.Clear;
      While not F_General.Qry.Eof do
       begin
          SubSection := F_General.Qry.FieldByName('N_subsection').AsString;
          FCanUpdate := False;
          LItem := F_General.LV_SubSection.Items.Add;
          LItem.Data['SubSection'] := SubSection;
          FCanUpdate := True;
          F_General.LV_SubSection.Adapter.ResetView(LItem);
          F_General.Qry.Next;
       end;
       F_General.LV_SubSection.EndUpdate;   
       F_General.Qry.Close;
    end;
  24. Like
    Евгений Корепов получил реакцию от Ingalime в Helper для TBitmap - асинхронная загрузка картинки из URL   
    По результатам проб и тестов - не пытыйтесь использовать мой хелпер на длинных ListView или ListView содержимое которого может неожиданно изменится - нарветесь на AV. Я не нашел простого способа проверить существование самого себя и родителей.
    По Bitmap.LoadFromFile(ImagePath+Name) - загляните в исходники Эмбаркадеро, там все делается через TBitmapSurface :
    procedure TBitmap.LoadFromFile(const AFileName: string); var Surf: TBitmapSurface; begin TMonitor.Enter(Self); try Surf := TBitmapSurface.Create; try if TBitmapCodecManager.LoadFromFile(AFileName, Surf, CanvasClass.GetAttribute(TCanvasAttribute.MaxBitmapSize)) then Assign(Surf) else raise EBitmapLoadingFailed.CreateFMT(SBitmapLoadingFailedNamed, [AFileName]); finally Surf.Free; end; finally TMonitor.Exit(Self); end; end; Добавил к хелперу 
    procedure LoadFromFileAsync(const AFilePath : String; const ASize : TControlSize = nil); overload; procedure LoadFromFileAsync(const AFilePath : String; const AListItemImage : TListItemImage); overload; constructor CreateFromFileAsync(const AFilePath : String; const AListItemImage : TListItemImage = nil); overload; Сам хелпер и и архив с демо-проектом (загружает 1000 картинок в ListView, параллельно изменяя их размер, картинки в комплекте) :
    unit BitmapAsyncLoader; interface uses System.Net.HttpClient, System.Net.URLClient, System.SysUtils, System.Types, System.Classes, System.Threading, FMX.Graphics, FMX.Surfaces, FMX.Types, FMX.ListView.Types; type TBitmapAsyncLoader = class helper for TBitmap private function ResizeBitmapSurface(const ABitmapSurface : TBitmapSurface; const AWidth, AHeight : Integer) : TBitmapSurface; procedure SynchronizeAssignFromBitmapSurface(const ABitmapSurface : TBitmapSurface; const AListItemImage : TListItemImage = nil); procedure StartHTTPThread(const AURL : String; const AWidth, AHeight : Integer; const AListItemImage : TListItemImage = nil); procedure StartLoadFromFileThread(const AFilePath : String; const AWidth, AHeight : Integer; const AListItemImage : TListItemImage = nil); public procedure LoadFromURLAsync(const AURL : String; const ASize : TControlSize = nil); overload; procedure LoadFromURLAsync(const AURL : String; const AListItemImage : TListItemImage); overload; constructor CreateFromUrlAsync(const AURL : String; const AListItemImage : TListItemImage = nil); overload; procedure LoadFromFileAsync(const AFilePath : String; const ASize : TControlSize = nil); overload; procedure LoadFromFileAsync(const AFilePath : String; const AListItemImage : TListItemImage); overload; constructor CreateFromFileAsync(const AFilePath : String; const AListItemImage : TListItemImage = nil); overload; end; implementation type THTTPClientListener = class class procedure HTTPClientValidateServerCertificate(const Sender: TObject; const ARequest: TURLRequest; const Certificate: TCertificate; var Accepted: Boolean); end; var AHTTPClient : THTTPClient; procedure TBitmapAsyncLoader.LoadFromFileAsync(const AFilePath : String; const ASize : TControlSize = nil); var AWidth, AHeight : Integer; begin if Assigned(ASize) then begin AWidth:=Round(ASize.Width); AHeight:=Round(ASize.Height); end else begin AWidth:=-1; AHeight:=-1; end; StartLoadFromFileThread(AFilePath, AWidth, AHeight); end; procedure TBitmapAsyncLoader.LoadFromFileAsync(const AFilePath : String; const AListItemImage : TListItemImage); var AWidth, AHeight : Integer; begin if Assigned(AListItemImage) then begin AWidth:=Round(AListItemImage.Width); AHeight:=Round(AListItemImage.Height); end else begin AWidth:=-1; AHeight:=-1; end; StartLoadFromFileThread(AFilePath, AWidth, AHeight, AListItemImage); end; constructor TBitmapAsyncLoader.CreateFromFileAsync(const AFilePath : String; const AListItemImage : TListItemImage = nil); begin Create; LoadFromFileAsync(AFilePath, AListItemImage); end; constructor TBitmapAsyncLoader.CreateFromUrlAsync(const AURL : String; const AListItemImage : TListItemImage = nil); begin Create; LoadFromURLAsync(AURL, AListItemImage); end; procedure TBitmapAsyncLoader.LoadFromURLAsync(const AURL : String; const AListItemImage : TListItemImage); var AWidth, AHeight : Integer; begin if Assigned(AListItemImage) then begin AWidth:=Round(AListItemImage.Width); AHeight:=Round(AListItemImage.Height); end else begin AWidth:=-1; AHeight:=-1; end; StartHTTPThread(AURL, AWidth, AHeight, AListItemImage); end; procedure TBitmapAsyncLoader.LoadFromURLAsync(const AURL : String; const ASize : TControlSize = nil); var AWidth, AHeight : Integer; begin if Assigned(ASize) then begin AWidth:=Round(ASize.Width); AHeight:=Round(ASize.Height); end else begin AWidth:=-1; AHeight:=-1; end; StartHTTPThread(AURL, AWidth, AHeight); end; function TBitmapAsyncLoader.ResizeBitmapSurface(const ABitmapSurface : TBitmapSurface; const AWidth, AHeight : Integer) : TBitmapSurface; begin if (AWidth <> -1) and (AHeight <> -1) then begin try Result:=TBitmapSurface.Create; Result.StretchFrom(ABitmapSurface, AWidth, AHeight, ABitmapSurface.PixelFormat); finally ABitmapSurface.Free; end; end else Result:=ABitmapSurface; end; procedure TBitmapAsyncLoader.SynchronizeAssignFromBitmapSurface(const ABitmapSurface : TBitmapSurface; const AListItemImage : TListItemImage = nil); begin TThread.Synchronize(Nil, procedure begin Assign(ABitmapSurface); ABitmapSurface.Free; if Assigned(AListItemImage) then AListItemImage.Invalidate; end ); end; procedure TBitmapAsyncLoader.StartHTTPThread(const AURL : String; const AWidth, AHeight : Integer; const AListItemImage : TListItemImage = nil); begin AHTTPClient.BeginGet( procedure (const ASyncResult: IAsyncResult) var AHTTPResponse : IHTTPResponse; ABitmapSurface : TBitmapSurface; begin if Not ASyncResult.IsCompleted then exit; try AHTTPResponse:=THTTPClient.EndAsyncHTTP(ASyncResult); except exit; end; if Assigned(AHTTPResponse) and (AHTTPResponse.StatusCode = 200) then begin ABitmapSurface:=TBitmapSurface.Create; if TBitmapCodecManager.LoadFromStream(AHTTPResponse.ContentStream, ABitmapSurface, CanvasClass.GetAttribute(TCanvasAttribute.MaxBitmapSize)) then begin ABitmapSurface:=ResizeBitmapSurface(ABitmapSurface, AWidth, AHeight); SynchronizeAssignFromBitmapSurface(ABitmapSurface, AListItemImage); end; end; end, AURL ); end; procedure TBitmapAsyncLoader.StartLoadFromFileThread(const AFilePath : String; const AWidth, AHeight : Integer; const AListItemImage : TListItemImage = nil); begin TTask.Run( procedure var ABitmapSurface : TBitmapSurface; begin ABitmapSurface:=TBitmapSurface.Create; if TBitmapCodecManager.LoadFromFile(AFilePath, ABitmapSurface, CanvasClass.GetAttribute(TCanvasAttribute.MaxBitmapSize)) then begin ABitmapSurface:=ResizeBitmapSurface(ABitmapSurface, AWidth, AHeight); SynchronizeAssignFromBitmapSurface(ABitmapSurface, AListItemImage); end; end ); end; class procedure THTTPClientListener.HTTPClientValidateServerCertificate(const Sender: TObject; const ARequest: TURLRequest; const Certificate: TCertificate; var Accepted: Boolean); begin Accepted:=True; end; initialization AHTTPClient:=THTTPClient.Create; AHTTPClient.OnValidateServerCertificate:=THTTPClientListener.HTTPClientValidateServerCertificate; finalization if Assigned(AHTTPClient) then AHTTPClient.DisposeOf; end.  
    BitmapAsyncLoader.7z
  25. Like
    Евгений Корепов получил реакцию от Sergionn в Helper для TBitmap - асинхронная загрузка картинки из URL   
    Окончательный вариант. Долго бился с изменением размера картинки внутри потока (к примеру что бы в ListView не грузить картинки больше чем нужно). Средствами TBitmap это оказалось сделать невозможно (именно в потоке), чтение форумов, issue Эмбаркадеро, привело к туманному выводу что проблема в архитектуре FMX.  В Токио, TBitmap стал потокобезопасным - это означает что никогда не пытайтесь использовать Bitmap в потоке, рано или поздно получите артефакты и глюки.
    Я решил проблему отказавшись от работы с TBitmap в потоке, и использовав для этого TBitmapSurface (загрузка из stream, изменение размеров).
    Что умеет хелпер:
    1. Загрузка картинки в Bitmap и подгонкой размера (размер можно и не менять - не передавайте параметр ASize)
    procedure LoadFromURLAsync(const AURL : String; const ASize : TControlSize = nil); overload;
    2. Загрузка картинки в TListItemImage ListView. После Окончания загрузки хелпер выполнит AListItemImage.Invalidate в основном потоке приложения для отрисовки картинки.
    procedure LoadFromURLAsync(const AURL : String; const AListItemImage : TListItemImage); overload;
    3. Создание картинки. Тоже самое что и предыдущие, но можно сэкономить строчку кода ABitmap:=TBitmap.Create ?
    constructor CreateFromUrlAsync(const AURL : String; const AListItemImage : TListItemImage = nil);
    По картинкам в ListView - можете на свой страх и риск грузить 100500 картинок, но лучше использовать загрузку только для видимой части (+- еще сколько то итемов). Хелпер тупо грузит картинки и не обеспечивает механизм оптимальной загрузки.
    Протестировано на Windows и Android.
    Ответы на вопросы которые мне задавали:
    Почему не создавать отдельный поток для каждой картинки, в нем создавать THTTPClient и делать запрос - пробовал этот вариант, он медленнее на порядок, даже под виндой это чертовски медленно. AHTTPClient.BeginGet и так создает отдельный поток на каждый запрос. Почему AHTTPClient глобальный для юнита - в хелпере нельзя вводить свои переменные, а создавать AHTTPClient внутри функции не выйдет - он убьется до завершения потока. И текущий вариант быстрее. Код хелпера и архив с тестовым проектом:
    unit BitmapAsyncLoader; interface uses System.Net.HttpClient, System.Net.URLClient, System.SysUtils, System.Types, System.Classes, FMX.Graphics, FMX.Surfaces, FMX.Types, FMX.ListView.Types; type TBitmapAsyncLoader = class helper for TBitmap private function ResizeBitmapSurface(const ABitmapSurface : TBitmapSurface; const AWidth, AHeight : Integer) : TBitmapSurface; procedure SynchronizeAssignFromBitmapSurface(const ABitmapSurface : TBitmapSurface; const AListItemImage : TListItemImage = nil); procedure StartHTTPThread(const AURL : String; const AWidth, AHeight : Integer; const AListItemImage : TListItemImage = nil); public procedure LoadFromURLAsync(const AURL : String; const ASize : TControlSize = nil); overload; procedure LoadFromURLAsync(const AURL : String; const AListItemImage : TListItemImage); overload; constructor CreateFromUrlAsync(const AURL : String; const AListItemImage : TListItemImage = nil); end; implementation type THTTPClientListener = class class procedure HTTPClientValidateServerCertificate(const Sender: TObject; const ARequest: TURLRequest; const Certificate: TCertificate; var Accepted: Boolean); end; var AHTTPClient : THTTPClient; constructor TBitmapAsyncLoader.CreateFromUrlAsync(const AURL : String; const AListItemImage : TListItemImage = nil); begin Create; LoadFromURLAsync(AURL, AListItemImage); end; procedure TBitmapAsyncLoader.LoadFromURLAsync(const AURL : String; const AListItemImage : TListItemImage); var AWidth, AHeight : Integer; begin if Assigned(AListItemImage) then begin AWidth:=Round(AListItemImage.Width); AHeight:=Round(AListItemImage.Height); end else begin AWidth:=-1; AHeight:=-1; end; StartHTTPThread(AURL, AWidth, AHeight, AListItemImage); end; procedure TBitmapAsyncLoader.LoadFromURLAsync(const AURL : String; const ASize : TControlSize = nil); var AWidth, AHeight : Integer; begin if Assigned(ASize) then begin AWidth:=Round(ASize.Width); AHeight:=Round(ASize.Height); end else begin AWidth:=-1; AHeight:=-1; end; StartHTTPThread(AURL, AWidth, AHeight); end; function TBitmapAsyncLoader.ResizeBitmapSurface(const ABitmapSurface : TBitmapSurface; const AWidth, AHeight : Integer) : TBitmapSurface; begin if (AWidth <> -1) and (AHeight <> -1) then begin try Result:=TBitmapSurface.Create; Result.StretchFrom(ABitmapSurface, AWidth, AHeight, ABitmapSurface.PixelFormat); finally ABitmapSurface.Free; end; end else Result:=ABitmapSurface; end; procedure TBitmapAsyncLoader.SynchronizeAssignFromBitmapSurface(const ABitmapSurface : TBitmapSurface; const AListItemImage : TListItemImage = nil); begin TThread.Synchronize(Nil, procedure begin Assign(ABitmapSurface); ABitmapSurface.Free; if Assigned(AListItemImage) then AListItemImage.Invalidate; end ); end; procedure TBitmapAsyncLoader.StartHTTPThread(const AURL : String; const AWidth, AHeight : Integer; const AListItemImage : TListItemImage = nil); begin AHTTPClient.BeginGet( procedure (const ASyncResult: IAsyncResult) var AHTTPResponse : IHTTPResponse; ABitmapSurface : TBitmapSurface; begin if Not ASyncResult.IsCompleted then exit; try AHTTPResponse:=THTTPClient.EndAsyncHTTP(ASyncResult); except exit; end; if Assigned(AHTTPResponse) and (AHTTPResponse.StatusCode = 200) then begin ABitmapSurface:=TBitmapSurface.Create; if TBitmapCodecManager.LoadFromStream(AHTTPResponse.ContentStream, ABitmapSurface, Self.CanvasClass.GetAttribute(TCanvasAttribute.MaxBitmapSize)) then begin ABitmapSurface:=ResizeBitmapSurface(ABitmapSurface, AWidth, AHeight); SynchronizeAssignFromBitmapSurface(ABitmapSurface, AListItemImage); end; end; end, AURL ); end; class procedure THTTPClientListener.HTTPClientValidateServerCertificate(const Sender: TObject; const ARequest: TURLRequest; const Certificate: TCertificate; var Accepted: Boolean); begin Accepted:=True; end; initialization AHTTPClient:=THTTPClient.Create; AHTTPClient.OnValidateServerCertificate:=THTTPClientListener.HTTPClientValidateServerCertificate; finalization if Assigned(AHTTPClient) then AHTTPClient.DisposeOf; end.  
    BitmapAsyncLoader.7z
×
×
  • Создать...