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

Slym

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

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

  • Посещение

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

    39

Сообщения, опубликованные Slym

  1. Procedure TServerConnectionTH.RecieveData();
    // сюда приходя данные со сканера
    //Data - это данные в виже TBytes
    //str - строка со считанным штрихкодом
    var
      Intent: JIntent;
      str:String;
    begin
      str:=TEncoding.UTF8.GetString(Data);
      Form1.DisplayR.Lines.Add(Str);
      Form1.DisplayR.GoToTextEnd;
      Intent := TJIntent.Create;
      Intent.setAction(StringToJString('com.google.android.c2dm.intent.RECEIVE'));
      Intent.putExtra(StringToJString('text'),StringToJString('1')); 
      Intent.putExtra(StringToJString('title'),StringToJString('1C')); 
      Intent.putExtra(StringToJString('data'),StringToJString(str)); 
      TAndroidHelper.Context.sendBroadcast(Intent);
    end;

     

  2. procedure TForm1.LoadImage(const AItem: TListViewItem; const AListItemImage : TListItemImage);
    Var AAsyncResult : IAsyncResult;
    begin
      if Not Assigned(AItem) or Not Assigned(AListItemImage) then
        exit;
      if AItem.Data['ImageState'].AsInteger <> ListViewItemImageEmpy then
        exit;
      if AItem.Data['ImageURL'].AsString.IsEmpty then
        exit;
      AItem.Data['ImageState']:=ListViewItemImageLoading;
    
      if not assigned(FHTTPClient) then exit;
    
      TMonitor.Enter(listview1);
      try
        AItem.TagObject:=
        FHTTPClient.BeginGet(
          procedure (const ASyncResult: IAsyncResult)
          Var AHTTPResponse : IHTTPResponse;
          begin
            if assigned(AItem.TagObject) then
            begin
              TMonitor.Enter(listview1);
              try
                AItem.TagObject:=nil;
              finally
                TMonitor.exit(listview1);
              end;
            end;
            if ASyncResult.IsCancelled then exit;
    
            AHTTPResponse:=THTTPClient.EndAsyncHTTP(ASyncResult);
            if AHTTPResponse.StatusCode <> 200 then
              exit;
            TThread.Queue(nil,
              procedure
              begin
                if Not Assigned(AItem) or Not Assigned(AListItemImage) then
                  exit;
                AListItemImage.BeginUpdate;
                AListItemImage.Bitmap:=TBitmap.Create;
                AListItemImage.Bitmap.LoadFromStream(AHTTPResponse.ContentStream);
                AListItemImage.EndUpdate;
                AItem.Data['ImageState']:=ListViewItemImageLoaded;
              end);
          end,
          AItem.Data['ImageURL'].AsString) as TBaseAsyncResult;
      finally
        TMonitor.Exit(listview1);
      end;
    end;
    
    procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
    var
      i:integer;
      IResult:IAsyncResult;
    begin
      TMonitor.Enter(listview1);
      try
        for i:=0 to listview1.Items.Count-1 do
          if assigned(listview1.Items[i].TagObject) then
            (listview1.Items[i].TagObject as TBaseAsyncResult).Cancel;
      finally
        TMonitor.Exit(listview1);
      end;
    
      TMonitor.Enter(listview1);
      try
        for i:=0 to listview1.Items.Count-1 do
          if assigned(listview1.Items[i].TagObject) then
          begin
            IResult:=TBaseAsyncResult(listview1.Items[i].TagObject) as IAsyncResult;
            TMonitor.Exit(listview1);
            try
              THTTPClient.EndAsyncHTTP(IResult);
            except
            end;
            TMonitor.Enter(listview1);
          end;
      finally
        TMonitor.Exit(listview1);
      end;
    end;

     

  3. В 01.02.2019 в 14:42, Евгений Корепов сказал:

    К сожалению логика асинхронности HTTPClient упускает одну важную вещь - идентификацию полученного результата

    Логика асинхронности принимает на вход анонимную процедуру для обработки результата, анонимная процедура захватывает переменные в зоне своего определения, а там хоть итем, хоть индекс, хоть блэкджек с простихоспаде чем попало...

  4. умрет потому что используется TThread.CreateAnonymousThread, 500 потоков это не шутка...
    переделать на TTask. TTask плодит ограниченное кол-во потоков.
    или вовсе отказаться от собственных потоков и отдать на откуп асинхронному запросу THTTPClient
    1 экземпляр THTTPClient может одновременно обслуживать несколько асинхронных запросов (4-8)
    HTTPClient.BeginGet
     

  5. Боролись как-то с артефактами отображения (мы их прозвали "крокодилами" из-за сходства на первом скриншоте с этим багом)...
    Могли отображаться также левые спрайты, или обрезки скролившихся контролов...
    Коллега выяснил что не надо трогать Form.Fill, из-за переключения в недрах FMX нативной и не нативной канвы: если нужен фон - брось Rect по контенту и в нем делай заливку...

  6. 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 (а может и нет!), но правила хорошего тона никто не отменял

  7. 1 час назад, Barbanel сказал:

    Я пользовался здравой логикой: поменьше анимаций, и поменьше объектов в стиле.

    я на  подсознательном уровне понимаю что анимашки вшитые в TButtonStyleTextObject - в моем проекте это лишний CPU и mem...
    но все встроенные стили активно ими пользуются... и трудно мотивировать что "не как у всех" будет быстрее...
    тут мне говорили что вырезать из 
    TBitmapLinks чуть ли не быстрее чем менять Fill.Color в ColorAnimation - но я то не дурак, чтоб на слово верить, да и чушь это полная чтоб Bitmap выиграл у Fill.Color
    попробую тест накидать...

  8. Мда... один я беспокоюсь за производительность кода...
    еще вброс:
    то быстрее и менее накладно по ресурсам на мобильной платформе (при условии статичности цвета шрифта, все цвета одинаковы, и без использования Shadow): 
    TButtonStyleTextObject или TLabel / TText

  9. Как реализовать "притягивание" скрола, т.е. скрол останавливается не где угодно, а в определенных местах, например по середине контрола находящегося в середине скрола по типу TScrollBox в стиле 'барабана' из iOS

    Другими словами чтоб контрол центрировался.

    Как то добавлять нужный Target в AniCalculations.OnStart или как то дотягивать в AniCalculations.OnStop?

  10. на мобильной платформе отношение к ресурсам строже...
    когда 1 кнопка - то можно терпеть, а когда десятки то начинаешь задумываться - а не уменьшится потребление памяти если заменить контрол на что-нибудь попроще
    а не шустрее будет скролитяся если убрать картинки (TBitmapLinks) и делать заливку цветом (Rectangle)

  11. Имеется кнопка, нужен эффект нажатия(Pressed) без анимации, т.е. 2 состояния с разным фоном
    что быстрее и менее накладно по ресурсам на мобильной платформе - Rectangle+ColorAnimation(IsPressed) или TButtonStyleObject +TBitmapLinks (только фон, без рамок)?

    тоже касается TButtonStyleTextObject: насколько уместно его применение если цвет не меняется от состояний, и не лучше ли его заменять на статичный TText.

     

  12. Да пробовал я TextToPath... на андроиде - артефакты... TrueType сглаживается полутонами - как полутон ToPath? никак.
    с растром та же фигня 
    MaskToAlpha работает с ЧБ изображением, и белый фон тонируется сглаживанием шрифтов и фильтр ColorKeyAlpha в полутонах теряется

    ЗЫ: все еще в поиске

  13. Переделал на растр

    1. Белый фон черный текст
    2. Применил фильтр MaskToAlpha
    3. Градиентный фон сверху прозрачная маска из п.2
    4. Применил фильтр ColorKeyAlpha, замена белого на прозрачный

    качество лучше но при наложении на другой фон имеются артефакты белых полутонов по краям

  14. как стилями/в рантайме создать прозрачную кнопу с градиентным текстом... (будет )
    пока смог нарисовать градиентный текст на белом фоне стилем - слой градиента (слой белый (черный текст и MaskToAlphaEffect))
    дело осталось за малым - белый фон убрать... но добавление прочих эффектов все портит 

    object TRectangle
        StyleName = 'bt0Gradient'
        Align = Center
        Fill.Color = claNull
        object TRectangle
          StyleName = 'Gradient'
          Align = Contents
          Fill.Kind = Gradient
          Fill.Gradient.Points = <
            item
              Color = xFFF60404
              Offset = 0.000000000000000000
            end
            item
              Color = xFF1BFE5A
              Offset = 0.354037255048751800
            end
            item
              Color = xFFFEF60D
              Offset = 0.642857134342193700
            end
            item
              Color = xFF0035FF
              Offset = 1.000000000000000000
            end>
          Fill.Gradient.StartPosition.Y = 0.500000000000000000
          Fill.Gradient.StopPosition.X = 1.000000000000000000
          Fill.Gradient.StopPosition.Y = 0.500000000000000000
        end
        object TRectangle
          StyleName = 'white'
          Align = Contents
          Fill.Color = claWhite
          object TText
            StyleName = 'text'
            Align = Contents
            Text = 'TextTextText'
            TextSettings.Font.Size = 40.000000000000000000
          end
          object TMaskToAlphaEffect
            StyleName = 'MaskToAlphaEffect1Style'
          end
        end
      end

    или как управлять применением фильтров?

     

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