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

XoviX

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

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

  • Посещение

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

  1. Like
    XoviX отреагировална DirtyBorov в [TRESTRequest] Лучшая практика, когда нужно отправить несколько запросов через RESTRequest   
    По каким то причинам мне не удается прикрепить файл содержащий TWaitControl. Потому просто выложу его код полностью. Благо он совсем короткий. 
    Модуль универсальный. Его можно использовать не только для REST но и вообще для любых длительных операций которые нужно выполнять в потоках.
     
    Обратите внимание, что в конструктор передается TForm. Это экземпляр ГЛАВНОЙ формы приложения.  Это нужно потому что TWaitControl , будет перекрывать главную форму полупрозрачным квадратом, создавая эффект затемнения и заодно делая недоступным разные кнопки на форме.  Рекомендую создавать TWaitControl в событии OnCreate главной формы:
    TMainForm = class(TForm) private Wait: TWaitControl; end; procedure TMainForm.FormCreate(Sender: TObject); begin Application.OnException := OnException; Wait := TWaitControl.Create(Self); Wait.Title.Text := 'Ждите пожалуйста...'; end; unit Wait.Control; interface uses FMX.Forms, FMX.Objects, FMX.Types, FMX.Effects, FMX.StdCtrls, System.SysUtils, System.Classes, System.UITypes; type TWaitControl = class(TRectangle) private FWindow: TRectangle; FTitle: TLabel; FHadErrors: Boolean; FWaiting: Boolean; procedure DoErrorHandling(E: Exception; AOnError: TProc<TWaitControl, Exception>); procedure DoOnCompleted(AOnComplete: TProc<TWaitControl>); public constructor Create(MainForm: TForm); reintroduce; procedure Run(ATask: TProc<TWaitControl>; AOnComplete: TProc<TWaitControl> = nil; AOnError: TProc<TWaitControl, Exception> = nil); virtual; property Waiting: Boolean read FWaiting; property HadErrors: Boolean read FHadErrors; property Window: TRectangle read FWindow; property Title: TLabel read FTitle; end; implementation { TWaitControl } constructor TWaitControl.Create(MainForm: TForm); begin inherited Create(MainForm); Parent := MainForm; Align := TAlignLayout.Contents; Visible := False; Fill.Color := $4B000000; FWindow := TRectangle.Create(Self); FWindow.Parent := Self; FWindow.Fill.Color := $96000000; FWindow.Align := TAlignLayout.Center; FWindow.Width := 250; FWindow.Height := 65; FTitle := TLabel.Create(FWindow); FTitle.Parent := FWindow; FTitle.Align := TAlignLayout.Client; FTitle.StyledSettings := FTitle.StyledSettings - [TStyledSetting.Size, TStyledSetting.Style]; FTitle.TextSettings.Font.Size := 16; // FTitle.TextSettings.Font.Style := [TFontStyle.fsBold]; with TAniIndicator.Create(FWindow) do begin Parent := FWindow; Style := TAniIndicatorStyle.Circular; Align := TAlignLayout.Left; Margins.Left := 15; Margins.Top := 15; Margins.Right := 15; Margins.Bottom := 15; Width := Height; Enabled := True; end; with TShadowEffect.Create(FWindow) do Parent := FWindow; end; procedure TWaitControl.DoErrorHandling(E: Exception; AOnError: TProc<TWaitControl, Exception>); begin TThread.Synchronize(TThread.CurrentThread, procedure begin FWaiting := False; FHadErrors := True; Visible := False; if Assigned(AOnError) then AOnError(Self, E); end); end; procedure TWaitControl.DoOnCompleted(AOnComplete: TProc<TWaitControl>); begin TThread.Synchronize(nil, procedure begin FWaiting := False; Visible := False; if Assigned(AOnComplete) then AOnComplete(Self); end); end; procedure TWaitControl.Run; begin Visible := True; FWaiting := True; TThread.CreateAnonymousThread( procedure begin try FHadErrors := False; ATask(Self); DoOnCompleted(AOnComplete); except on E:Exception do DoErrorHandling(E, AOnError); end; // DoOnCompleted(AOnComplete); end).Start; end; end.
  2. Like
    XoviX отреагировална DirtyBorov в [TRESTRequest] Лучшая практика, когда нужно отправить несколько запросов через RESTRequest   
    Логично. Но тема не раскрыта.
    Во первых, я написал, о том что мне было НУЖЕН json, потому ответы не десереализуются в объекты. Во вторых нет необходимости использовать TJson.JsonToObject. Все гораздо проще. Как я уже писал, нужно изменить функцию Request. Например так:
    function Request<T: class>(ABody: TApiObject): T; ... function TRestAPI.Request<T>(ABody: TApiObject): T; var i: integer; begin RESTRequest.ClearBody; RESTRequest.AddBody(ABody); RESTRequest.Execute; if (RESTResponse.StatusCode <> 200) then raise Exception.CreateFmt('Оштбка сервера %d "%s"',[RESTResponse.StatusCode, RESTResponse.StatusText]); if not Assigned(RESTResponse.JSONValue) then raise Exception.Create('Ответ сервера не содержит подходящих данных'); Result := RESTResponse.JSONValue.GetValue<T>('content'); end; Теперь по поводу потоков. Все верно, но не совсем.  Поскольку TRestAPI это наследник TDataModule, то я подразумевал использование в программе единственного его экземпляра. А значит код на подобии такого - полный отстой:
    function TRestAPI.GetUserInfo(ABody: TApiInfo): TJSONValue; begin TThread.CreateAnonymousThread(procedure begin RESTClient.BaseURL := BaseURL + '?act=terminal&area=info&infoType=2&response=js'; Result := Request(ABody); end).Start; end; Почему? Потому что если из главного модуля выполнить подряд сразу два запроса - то мы получим exception. Так как потоки раздерутся из-за единственных экземпляров:
    RESTClient: TRESTClient; RESTRequest: TRESTRequest; RESTResponse: TRESTResponse;   Первое что приходит на ум: 1. Создавать динамически TRestAPI для каждого запроса 2. Создавать TRESTClient, TRESTRequest, TRESTResponse для каждого запроса.   Логично? Нет. Это вообще полное гамно плохая идея. Потому что будет много лишнего кода, а мы стремимся все сделать красиво.    Что же, мы к этому подошли, покажу как же я использовал данный код. А использовал я его конечно же в потоках. Идея очень простая и весьма удобная. Взял я ее с сайта fmxexpress.com (к сожалению не помню автора, но вы можете найти). Мне она настолько понравилась, что я теперь использую ее повсеместно. Конечно код я модернизировал под себя и адаптировал для использования на desktop. Код позволяет отправить в поток любую функцию. При этом при завершении или ошибке будет вызваны соответсвующие функции. Но весь код будет находится в одном месте (используются анонимные методы). При выполнении запроса будет выведено окно с анимацией и надписью "Ждите..." Вот пример вызова запроса: procedure TFormCashbox.RequestCardInfo(const ACardNum: string); var Json: TJSONValue; Body: TApiInfo; begin lblStatus.Text := 'Запрос информации...'; Wait.Run( procedure(AWait: TWaitControl) begin Body := TApiInfo.Create; Body.Card_num := ACardNum; Body.Hall_id := '1600'; Json := RestAPI.SendRequest(Body); end, procedure(AWait: TWaitControl) begin CurrentCard.SetState(TCardState.Used, ACardNum, Json); lblStatus.Text := 'Готов'; end, procedure (AWait: TWaitControl; AException: Exception) begin OnException(Self, AException); end ); end; Весь секрет кроется в Wait. Метод Run принимает три метода: 
    1.основной код
    2.код завершения потока
    3.код при возникновении ошибки в потоке.
     
    Сам же Wait: TWaitControl - это наследник от TRectangle. Когда выполняется метод Run, он появляется на экране и показывает надпись. Дополнительно он поверх всей формы выводит полупрозрачный фон, что создает эффект как на многих сайтах.
    Я не буду объяснять как работает TWaitControl, там все тривиально. Просто приложу готовый модуль - пользуйтесь. С помощью него вы можете сильно упростить жизнь при работе с потоками. 
  3. Like
    XoviX отреагировална Brovin Yaroslav в [Android] Как поменять цвет выделенного итема в ListBox для андроид стиля?   
    Стиль для андроида растровый, а это значит, что все элементы листбокса хранятся в растровом изображении. Поэтому для корректировки цвета выделенного итема, нужно править исходное растровое изображение частей элементов контролов.
     
    Рецепт
    1. Открываем Bitmap Style Designer и создаем стиль по умолчанию (темный или светлый) для платформы Андроид.
    2. В дереве разворачиваем узел Images и выполняем экспорт всех графических ресурсов. 

    3. Затем в любом графическом редакторе правим растровые исходники (для всех вариантов скейла экранов) фона TListBoxItem. Я поменял его на светло голубой. На картинке указано его местоположение:

    4. Возвращаемся в Bitmap Style Designer и обновляем каждый исходник (style.png, style20x.png, style15x.png, style30x.png). Для обновления, выделяем картинку в дереве, жмем кнопку Update и указываем новое изображение.

    5. После этого сохраняем полученный стиль: File->Save as...->Выбираем тип файла "FireMonkey Style".
    6. Кидаем на форму стиль бук, подключаем к форме и грузим туда наш кастомный стиль.
     
    Результат
    На скриншоте ниже показан Листбокс с выделенным итемом голубого цвета (Было, Стало):

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