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

Лидеры

  1. DirtyBorov

    DirtyBorov

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


    • Баллы

      2

    • Постов

      71


  2. xenon54

    xenon54

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


    • Баллы

      1

    • Постов

      385


  3. haword

    haword

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


    • Баллы

      1

    • Постов

      535


  4. Adm123

    Adm123

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


    • Баллы

      1

    • Постов

      25


Популярный контент

Показан контент с высокой репутацией 18.04.2015 во всех областях

  1. Воткнув сюда такую колбасу кода, ты отпугиваешь тех кто потенциально мог бы помочь тебе. Постарайся минимизировать свой код, не нужна полная форма с сайта, сделай простейшую форму и простейший запрос и если не будет работать, то пости что там у тебя, а с такой колбасой даже глаза не хотят смотреть. Не потому что лень, а потому что много времени нужно чтобы вникать в то, во что вникать для того чтобы помочь ненужно.
    1 балл
  2. ты настройки компонента совсем не делаешь как же он передаст данные то. поищи в инете примеры POST запроса. на вскиду попробуй добавь строки до вызова POST fMain.IdHTTP1.Request.BasicAuthentication:=true; (может и false) fMain.IdHTTP1.Request.ContentType:='application/x-www-form-urlencoded';
    1 балл
  3. Adm123

    Плавная прокрутка

    Интересная вышла штука... На том самом пустом проекте если сделать несколько итемов Selectable= false, то начинаются тормоза и скачки, если пытаться проматывать список, "ухватив" его за неSelectable-итем. Если мотать, ухватив за итем с Selectable= true, то все в порядке... В рабочем же проекте у меня все итемы не отмечаемые... Собственно, сделать их отмечаемыми мне ничто не мешает, НО... некрасиво, когда при промотке или нечаянном клике итем выделяется. Отсюда следующий вопрос. Можно ли как то подавить визуальный эффнкт выделения итема?
    1 балл
  4. По каким то причинам мне не удается прикрепить файл содержащий 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.
    1 балл
  5. Логично. Но тема не раскрыта. Во первых, я написал, о том что мне было НУЖЕН 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, там все тривиально. Просто приложу готовый модуль - пользуйтесь. С помощью него вы можете сильно упростить жизнь при работе с потоками.
    1 балл
Эта таблица лидеров рассчитана в Москва/GMT+03:00
×
×
  • Создать...