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

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

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

  • Постов

    738

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

  • Посещение

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

    100

 Тип контента 

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

    [Android] TWebBrowser не обновляется прокрутка

    в TWebBrowser

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

    Добавьте простенький JS скрипт на вашу страницу (вот для примера две функции - скролл в самый низ и скролл наверх): 

    <script>
	function ScrollToBottom() {
		window.scrollTo(0, document.body.scrollHeight);
	}
	function ScrollToTop() {
		window.scrollTo(0, 0);
	}
</script>

    И в событии браузера запускайте 

    procedure TFormMain.OnWebBrowserDidFinishLoad(ASender: TObject);
begin
  try
    FWB.EvaluateJavaScript('ScrollToTop()');
  except
  end;
end;

     

    THTTPClient - Ошибка запроса

    в RTL

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

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

    Хорошо, вот url: https://imgvip.net/

    Хотел за полчаса написать программу для автопостинга, но что-то пошло не так... :)

     

    Изначально я так и делал, через IHTTPResponse, но ошибка та же самая, No mapping for the Unicode character exists in the target multi-byte code page

    Программа вылетает на строчке с запросом, http.get(url), дальше не идёт

    Все работает без проблем, вот код: 

    unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    FHTTPClient : THTTPClient;
    function GetHTTP(const AURL : String; out AContent : String) : boolean;
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

procedure TForm1.FormCreate(Sender: TObject);
Var AContent, AURL : String;
begin
  FHTTPClient:=THTTPClient.Create;
  if GetHTTP('https://imgvip.net/', AContent) then
    //Тут работаем с полученным AContent
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  if Assigned(FHTTPClient) then
    FHTTPClient.Free;
end;

function TForm1.GetHTTP(const AURL : String; out AContent : String) : boolean;
Var AHTTPResponse : IHTTPResponse;
begin
  Result:=False;
  AHTTPResponse:=FHTTPClient.Get(AURL);
  if Assigned(AHTTPResponse) then
  begin
    if AHTTPResponse.StatusCode=200 then
      AContent:=AHTTPResponse.ContentAsString
    else
      raise Exception.Create(AHTTPResponse.StatusText);
  end
  else
    raise Exception.Create('Unknow error');
end;

end.

     

    THTTPClient - Ошибка запроса

    в RTL

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

    Вот так попробуйте, без stream (это лишняя прокладка). И узнайте точно - в какой кодировке отдает контент ваш сайт. Если это utf-8 то ничего предпринимать не нужно. 

    Var HTTPResponse : IHTTPResponse;
begin
  HTTPResponse:=FHTTPClient.Get(URL);
  if Assigned(HTTPResponse) then
    if HTTPResponse.StatusCode=200 then
      Result:= HTTPResponse.ContentAsString; //наш результат
	else
	  ErrorMsg:=HTTPResponse.StatusText;

     

    [TWebBrowser] Как отловить событие выполнения JavaScript?

    в Javascript

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

    13 часов назад, CyberStorm сказал:

    Подниму тему. За 2 года, что нибудь поменялось? Возможно ли что нибудь из tWebBrowser'a и его JavaScript'a передать управляющей программе? Хочу в своей электронной книге (посредством вывода html через tWebBrowser) добавить возможность поставить закладки, но пока не вижу никаких вариантов взаимодействия - хотелось бы уметь отлавливать хоть что нибудь...

    Вот тут https://github.com/freeonterminate/delphi/tree/master/TWebBrowser  TWebBrowserEx 

    Имеет интересный метод 

     // ↓ can taking id of bar's attribute value.
  Value := FWebBrowser.GetTagValue('bar', 'value');

    Можно в JS функции результат записать в невидимый <div id="lalala" value="результат"> и прочесть его с помощью функции.

    Delphi 10.1 FMX android данные с сервера в base64 закодирован хранится pdf как его раскодировать и сохранить на устройстве

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

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

    5 часов назад, Slym сказал:

    1. для упрощения кода работы с JSON давно можно использовать сложные пути
    ABase64:=JSON.GetValue<string>('body.nextStep.pdf');
    2.  ну нельзя так:  

    
AStreamSource.WriteBuffer(Pointer(ABase64)^, Length(ABase64) * 2);

    так безопасней AStreamSource:=TBytesStream.Create(TEncoding.UTF8.GetBytes(ABase64));

    3. И сохранять лучше сразу в TFileStream - меньше расход памяти 

    4. не забываем finally Free (их выше нету)... хоть оно и может AUTOREFCOUNT (а может и нет!), но правила хорошего тона никто не отменял

    По пункту 1 :

    Из за того что код парсинга JSON сотрудники Эмабаркадеро делали "по быстрому" (просто переделали ранее написаный код парсинга XML), то там присутствуют ошибки и конструкция

    ABase64:=JSON.GetValue<string>('body.nextStep.pdf');

    будет работать, но только при убывающей луне и на южном склоне холма ?

    Исправили проблему только в Carnival.

    По пункту 2 :

    Согласен полностью.

    По пункту 3:

    Согласен полностью.

    По пункту 4 :

    Согласен, но я показывал как топикстартеру как выполнить его задачу, а не писал учебник по идеальному программированию ? Да и компилятор все равно вставляет код очистки локальных переменных при выходе из функции, так что будем считать что я просто снизил нагрузку на процессор ?

    Delphi 10.1 FMX android данные с сервера в base64 закодирован хранится pdf как его раскодировать и сохранить на устройстве

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

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

    Накидал вам функцию (проверил - работает): 

    unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    function ExtractPDFContentBase64(const AJSONString : String; out AFileName : String) : boolean;
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

function TForm1.ExtractPDFContentBase64(const AJSONString : String; out AFileName : String) : boolean;
Var AJSONObject, AJSONObjectBody, AJSONObjectNextStep : TJSONObject;
    ACode : Integer;
    AStreamSource, AStreamDest : TMemoryStream;
    ADecodeByteCount : Integer;
    ABase64 : String;
begin
  // Выставляем результат функции в False
  Result:=False;

  // Парсим JSON строку в JSON объект
  AJSONObject:=TJSONObject(TJSONObject.ParseJSONValue(AJSONString));
  if Not Assigned(AJSONObject) then
    exit;

  // Проверям поле code на предмет содержания http code 200 (это я домыслил, можно удалить)
  if Not AJSONObject.TryGetValue('code', ACode) then
    exit;
  if ACode <> 200 then
    exit;

  // Извлекаем body
  if Not AJSONObject.TryGetValue('body', AJSONObjectBody) then
    exit;
  if Not Assigned(AJSONObjectBody) then
    exit;

  // Из body извлекаем instanceId - будем использовать как имя файла
  if Not AJSONObjectBody.TryGetValue('instanceId', AFileName) then
    exit;
  // Склеиваем полное имя файла
//  AFileName:=TPath.Combine(TPath.GetSharedDownloadsPath, AFileName + '.pdf');
  AFileName:=TPath.Combine(TPath.GetSharedDownloadsPath, AFileName + '.jpeg'); // Я тестил на картинке

  // Извлекаем nextStep
  if Not AJSONObjectBody.TryGetValue('nextStep', AJSONObjectNextStep) then
    exit;
  if Not Assigned(AJSONObjectNextStep) then
    exit;

  // Содаем поток-источник и помещаем в него base64
  AStreamSource:=TMemoryStream.Create;
  if Not AJSONObjectNextStep.TryGetValue('pdf', ABase64) then
    exit;
  AStreamSource.WriteBuffer(Pointer(ABase64)^, Length(ABase64) * 2); // Длину строки умножаем на 2, так как строка юникод
  AStreamSource.Position:=0;

  // Создаем поток-назначение
  AStreamDest:=TMemoryStream.Create;
  // Декодируем base64 из текста в потоке AStreamSource в бинарные данные в поток AStreamDest
  ADecodeByteCount:=TNetEncoding.Base64.Decode(AStreamSource, AStreamDest);
  // Проверяем сколько байт было декодировано
  if (ADecodeByteCount > 0) then
  begin
    AStreamDest.Position:=0;
    try
      // Сохраняем поток с бинарными данными в файл с ранее собранным именем
      AStreamDest.SaveToFile(AFileName);
    except
      exit;
    end;
  end;
  // Выставляем результат функции в True
  Result:=True;
end;

procedure TForm1.FormCreate(Sender: TObject);
Var AJSONString : String;
    AFileName : String;
begin
  AJSONString:=TFile.ReadAllText('d:\JSON_example.txt');
  if ExtractPDFContentBase64(AJSONString, AFileName) then
  begin
    // Что то делаем с PDF файлом AFileName
  end;
end;

end.

     

    [DELPHI FMX Android] [6.0] Не удается загрузить SSL библиотеку

    в SSL

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

    Поддерживаю мнение Равиля - в вашем случае удобнее использовать отправку через мессенждеры (телеграм в частности) или соцсети (везде есть апи для этого дела).

    Отослать емайл вы можете средствами самого андроида, не прибегая к низкоуровневой работе с smtp протоколом. К примеру вот так (код скопипастил, возможно требуется корректировка) : 

    procedure TForm1.CreateEmail(const Recipient, Subject, Content, Attachment: string);
var
  JRecipient: TJavaObjectArray<JString>;
  Intent: JIntent;
  Uri: Jnet_Uri;
  AttachmentFile: JFile;
begin
  JRecipient := TJavaObjectArray<JString>.Create(1);
  JRecipient.Items[0] := StringToJString(Recipient);

  Intent := TJIntent.Create;
  Intent.setAction(TJIntent.JavaClass.ACTION_SEND);
  Intent.setFlags(TJIntent.JavaClass.FLAG_ACTIVITY_NEW_TASK);
  Intent.putExtra(TJIntent.JavaClass.EXTRA_EMAIL, JRecipient);
  Intent.putExtra(TJIntent.JavaClass.EXTRA_SUBJECT, StringToJString(Subject));
  Intent.putExtra(TJIntent.JavaClass.EXTRA_TEXT, StringToJString(Content));

  if Attachment <> '' then
  begin
    AttachmentFile := TJFile.JavaClass.init(StringToJString(Attachment));
    Uri := TJnet_Uri.JavaClass.fromFile(AttachmentFile);
    Intent.putExtra(TJIntent.JavaClass.EXTRA_STREAM, TJParcelable.Wrap((Uri as ILocalObject).GetObjectID));
  end;

  Intent.setType(StringToJString('vnd.android.cursor.dir/email'));

  SharedActivity.startActivity(Intent);
end;

    Так же вы можете использовать различные сетевые хранилища для сбора данных (ЯндексДиск и другие), их апи позволяет довольно просто это делать по http протоколу. Можно использовать Google Docs, и  подобное. Или бесплатный хостинг и на нем на php сделать систему сбора/хранения. Возможностей куча. Нынче проблема не как реализовать, а какой вариант реализации выбрать (сам постоянно мучаюсь этим вопросом в своих проектах)

    Воспроизведение без задержки

    в TMediaPlayer

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

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

    MediaPlayerOK создается только при первом вызове.

    да, забыл добавить, что речь об Android.

    А не подскажете как раз под Android более простой метод?

    Ну вряд ли найдется  метод "более простой", я имел ввиду методы конкретной платформы, к примеру для андроида JAudioTrack или JAudioManager. Посмотрите вот тут http://www.fmxexpress.com/free-game-audio-manager-wrapper-class-in-delphi-xe6-firemonkey-for-android-ios-windows-and-osx/ может вам подойдет, или поищите (даже на этом форуме) JAudioTrack

    Воспроизведение без задержки

    в TMediaPlayer

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

    16 минут назад, Maka сказал:

    Столкнулся с небольшой проблемой

    Воспроизвожу звук стандартным Media Player'ом вот так: 

    
var 
  MediaPlayerOK: TMediaPlayer;

procedure Play_SoundOK;
begin  
  if not Assigned(MediaPlayerOK) then begin
    MediaPlayerOK := TMediaPlayer.Create(nil);    
    MediaPlayerOK.FileName := System.IOUtils.TPath.Combine(System.IOUtils.TPath.GetDocumentsPath, 'ok-3.3gp');
  end;
  MediaPlayerOK.CurrentTime := 0;
  MediaPlayerOK.Play;
end;

    Воспроизведение запускается с ощутимой задержкой (сотни мс). Если файл длинный и воспроизводится 1 раз - то это незаметно, но если это, например, звук, воспроизводящийся при нажатии какой-то объект, и это происходит часто, то это очень бросается в глаза.

    Как коллеги решают подобную проблему?

    Для начала избавьтесь от создания TMediaPlayer. Правда по приведенному коду неясно создается он каждый раз или используется первый созданный экземпляр. MediaPlayerOK и procedure Play_SoundOK потомки какой то одной формы?

    Ну и проигрывать звук лучше более простыми методами, хотя в большинстве они платформо-зависимы (к примеру sndPlaySound из Winapi.MMSystem.pas).

    Реализовать рейтинг

    в iOS

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

    Вместо рисования звезды в TPath, проще использовать соотвествующий символ юникода.

    Char($2606) // Не закрашенная звезда

    Char($2605) // Закрашенная звезда

    image.thumb.png.edc787d3a3b92b7af81ac9b974731d0d.png

    https://unicode-table.com/ru/sets/stars-symbols/

    Можно даже для еврейский магазинов сделать рейтинг ?

    Raise убивает программу для Android

    в Отладка

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

    Просто возьмите это под свой контроль - не используйте встроенный SearchBox, а создайте отдельное поле TEdit, а фильтрацию обрабатывайте руками. 

      TListViewFilterEx = record
    Category : String;
    Name : String;
    Cart : String;
  end;

procedure TFormMain.SearchBoxChangeTracking(Sender: TObject);
begin
  Setting.Filter.Name:=SearchBox.Text;
  ListViewFilterEx(ListViewAction, Setting.Filter);
  LoadVisibleListViewItem(ListViewAction);
end;

procedure TFormMain.ListViewFilterEx(AListView : TListView; AFilter : TListViewFilterEx);
begin
  AListView.Items.FilterEx:=
    function(X: TListItem): Boolean
    begin
      Result:=
        (AFilter.Category.IsEmpty or TListViewItem(X).Data['Category'].AsString.ToLower.Contains(AFilter.Category.ToLower)) And
         ((AFilter.Name.IsEmpty or TListViewItem(X).Data['Name'].AsString.ToLower.Contains(AFilter.Name.ToLower)) or
         (AFilter.Name.IsEmpty or TListViewItem(X).Data['Detail'].AsString.ToLower.Contains(AFilter.Name.ToLower)));
    end;
end;

procedure TFormMain.LoadVisibleListViewItem(const AListView : TListView; ATopItemIndex : Integer = -1);
Var LTopItemIndex, I : Integer;
begin
  if Setting.Flags.ListViewActionLoaded then
  begin
    if ATopItemIndex=-1 then
      LTopItemIndex:=GetListViewTopItemIndex(AListView)
    else
      LTopItemIndex:=ATopItemIndex;
    for I := LTopItemIndex to LTopItemIndex + LoadVisibleListViewItemCount do
      if I<=AListView.ItemCount-1 then
      begin
        AListView.Adapter.ResetView(AListView.Items.Item[I]);
      end;
  end;
end;

    Суффикс Ex в AListView.Items.FilterEx игнорируйте, используйте AListView.Items.Filter. Это я для нормального поиска (по всем полям и Data, а не только по Text) переписывал исходники ListView...

    С таким кодом возможно у вас будет больше возможностей для перехвата исключения. Ну или игнорирования поиска пока работает скролл ListView.

    IdHTTPServer и возврат параметра из формы в кодировке Windos

    в TidHTTPServer

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

    Если вы прибыли к нам из 1991 года и собираетесь использовать это приложение в прошлом тысячелетии - тогда все нормально. Если же вы наш современник - уберите из приложения и страницы все экзотические кодировки. Только UTF-8, только хардкор! 

    AResponseInfo.ContentEncoding := 'utf-8';
AResponseInfo.ContentType := 'text/html; charset=utf-8';
AResponseInfo.ContentLanguage := 'ru';
AResponseInfo.CharSet := 'utf-8';

    При формировании содержимого страницы - формируйте как есть, без перекодирования в экзотику. 

    Как получить содержимое item при событии OnDeleteItem в ListView

    в TListView

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

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

    Да, у меня данные из базы попадают в список ListView. Теперь я хочу, чтобы при удалении из ListView данные, также удалялись из базы. Скрипт для удаления из базы я написал на php. В него надо передать id для удаления из базы. Мне нужно получить id из списка ListView. Эти id попадают в поле detail из JSON массива. Как мне при событии OnDeleteItem получить значение из detail? 

    procedure TForm1.ListView1DeleteItem(Sender: TObject; AIndex: Integer);
Var AMyItemIndex : Integer;
begin
  AMyItemIndex:=(ListView1.Items.Item[AIndex] as TListViewItem).Detail.ToInteger;
  ...
end;

     

    Сборка приложений под Linux

    в Linux

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

    22 часа назад, Евгений Корепов сказал:

    У меня PASserver нормально стартует на CentOS 7, пишет что повесился на порт. Но слушает он только интерфейс 127.0.0.1, на внешние интерфейсы он даже не пытается биндить прослушку порта. Что делать и как дальше жить?

     

    Проблему решил. Сам дурак. Прописал в iptables разрешающее правило - все заработало. 

    Разрешения для приложения не вступают в силу на Android

    в Развертывание приложений

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

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

    А кстати о карнавале. Там теперь можно поверх TMapView размещать делфовские компоненты?

    Да Z-Order заявлен (общедоступная информация). Но как оно в реальности - разглашать не могу ?

    Разрешения для приложения не вступают в силу на Android

    в Развертывание приложений

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

    Вот как то так, на базе штатного примера: 

     

    Такс, я малость лопухнулся, это пример я уже под карнавал переделал, работать на токио и остальных версиях не будет. Так что я его удалил. Поищите по форуму - уже неоднократно обсуждалась тема.

    Сборка приложений под Linux

    в Linux

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

    У меня PASserver нормально стартует на CentOS 7, пишет что повесился на порт. Но слушает он только интерфейс 127.0.0.1, на внешние интерфейсы он даже не пытается биндить прослушку порта. Что делать и как дальше жить?

     

    Рабочее место для IOS разработки

    в Вопросы

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

    Установил виртуалку MacOS на свой комп Rysen - вообще без проблем, все работает вроде. Правда пришлось биос перепрошить с версии F1 на F23 (за год gigabyte наклепало не хило прошивок), и с трудом найти где включается виртуализация (So apparently to enable virtualization support, you have to enable SVM. To activate it, click on the MIT tab, then Advanced Frequency Settings and then Advanced Core settings. Even though the manual says it should be enabled by default, it wasn't on my board.). Спасибо гуглю.

    По поводу телефона - глянун авито, и охренел. В моем маленьком городке с 100к жителей, просто хренова туча объяв о продаже. Не знал что у нас столько дебилов фанатов Apple ? 

    iPhone 5s 16гб за 5500р нормально? Я в их модельном ряду полный профан. Подскажите, какие нюансы есть? Оперативки сколько там желательно и еще может что?

    Рабочее место для IOS разработки

    в Вопросы

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

    12 часов назад, ENERGY сказал:

    C AMD есть решения, но процессор должен поддерживать AMD-V. Но и с этим тоже будут проблемы, я пробовал запустить виртуалку заточенную под AMD на своем ПК, но не получилось, вываливались разные ошибки при запуске. Мне кажется даже если удастся все запустить, появятся очередные баги.  Именно поэтому я так и написал - "не пойдет", это не категоричное нет.

    С Intel у меня все запустилось с первого раза. Насколько я понял, процессор тоже должен поддерживать виртуализацию.

    Понял, приму к сведению и попробую. На моих Rysen вроде с виртуализацией проблем не возникало. Надеюсь все заработает.

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