Равиль Зарипов (ZuBy)

использовать TMultiView с режимом Custom + FMX.MultiView.CustomPresentation.pas

смотреть демо пример

...\Embarcadero\Studio\16.0\Samples\Object Pascal\Mobile Samples\User Interface\MultiView

 

кинуть на этот MultiView edit и кнопку, готово

StringReplace, не?

Присоединяюсь, поздравляю с днем рождения!

Благодарю!

Хорошие приложение! С днём рождения ZuBy!

Благодарю!

Я написал подобное приложение для себя для IPhone чтобы слушать в машине через блютус. Все отлично. Подумал я, мб в AppStore выложить? И тут у меня возникли дикие сомнения по поводу правомерности таких действий. Если музыка, которую пользователь скачает к себе на телефон, будет залита на сайт нелегально, то получается приложение помогает распространять контрафакт?

скорей всего его не пропустят, поэтому я и не выкладываю в магазин, а только на сайт

Обновленная версия

• поддержка Android 5.x
• обновленный дизайн

 

 

Скачать с офф. сайта

 

Копался, копался так ничего и не получилось, в итоге сделал как предложил ruslan (пост 4) но со своими доработками, если кому интересно

на создание объекта и на событие OnUpdatingObjects (на TListView) сделал

   aItem.Height := Round(CalculateTextHeight(aItem.Text, aItem.Objects.TextObject.Width, 36, 130, aItem.Objects.TextObject.Font))+4;

aItem - TListViewItem - элемент списка из TListView

 

сама функция вот

function CalculateTextHeight(aText: String; aWidth: Single; aMinHeight: Single = 0; aMaxHeight: Integer = 0; aFont: TFont) : Single;
begin
  FTextLayout.BeginUpdate;
  try
    FTextLayout.Text := aText;
    FTextLayout.MaxSize := TPointF.Create(aWidth, 1000);
    FTextLayout.WordWrap := True;
    FTextLayout.Font.Assign(aFont);
    FTextLayout.HorizontalAlign := FMX.Types.TTextAlign.Leading;
    FTextLayout.VerticalAlign := FMX.Types.TTextAlign.Leading;
  finally
    FTextLayout.EndUpdate;
  end;
  Result := FTextLayout.Height;
  if aMinHeight>0 then
    if Result < aMinHeight then
      Result := aMinHeight;
  if aMaxHeight>0 then
    if Result > aMaxHeight then
      Result := aMaxHeight;
end;

Параметры

aText - текст, который там отображен,

aWidth - ширина текстового объекта,

aMinHeight - минимально возможная высота (0 - если не нужно ограничение)

aMaxHeight - максимально возможная высота (0- если не нужно ограничение)

aFont - шрифт, используемый объектом

 

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

P.S.Прибавил 4 пикселя, для того, чтобы рамка поместилась

 

 

FTextLayout - это что за компонент?

Ну вам выше вроде ответили, если не хотите лагов интерфейса то используюте синхронизацию

добавлены методы fetchTopic, fetchPosts

XML RPC API.zip

 

Благодарю!

Вы читаете между строк! Я не пишу под яблоко!! Для андроида я уже все дал, дальше сами

Если я вам сделаю тоже нечего не получится, я не пиву под яблоки. Даже компилятор не стоит. Так что, смысл ждать, читайте пробуйте и делайте

Вы делали что я описал выше? Если нет то конечно ничего не получится... Пример смогу дать только в понедельник. Хотя если посмотреть ссылки то можно найти пример

Что именно не получается? Библиотеку в деплоймент закинули? Пути для iOS нужные поставили?

В модуле bassfunction loadbass смотрели? Там нужно пути для ios указать, я под яблоко не пишу поэтому незнаю. Распишите что не получается, чем смогу помогу

Ну так тоже самое будет, только либу для ios скачай и всё. Это я выдернул из своего приложения

Либа на сайте басс есть для ios

Создание

{$IFDEF ANDROID}
if LoadBASS then
begin
if not BASS_Init(-1, 44100, BASS_DEVICE_SPEAKERS, nil, nil) then
ShowMessage('BASS not Init!')
else
begin
BASS_SetConfig(BASS_CONFIG_NET_PLAYLIST, 1);
// enable playlist processing
BASS_SetConfig(BASS_CONFIG_NET_PREBUF, 0);
BASS_SetConfig(BASS_CONFIG_BUFFER, 500);
BASS_SetConfig(BASS_CONFIG_UPDATEPERIOD, 20);
end;
end
else
ShowMessage('BASS library not loaded!');
{$ENDIF}

Воспроизведение

mCh := BASS_StreamCreateURL(Pointer(aURL), 0, BASS_STREAM_PRESCAN or BASS_STREAM_STATUS or
BASS_STREAM_AUTOFREE or BASS_UNICODE, nil, nil);

if mCh > 0 then
begin
BASS_ChannelPlay(mCh, true);
end;

для ознакомления там полно тем в поиске набрать "Delphi XE"

BASSFunctions.zip

попробуйте использовать bass есть библиотека и для iOS

procedure TFormFM.NavigationTreeView(aTree: TTreeView; const aData: string);
var
  Root, Child, SubChild, Item: TTreeViewItem;
  StrList: TStringList;
  i, c: integer;
  Str, ParseStr: string;
begin
  StrList := TStringList.Create;
  StrList.Text := aData;

  aTree.BeginUpdate;
  aTree.Clear;

  for i := 0 to StrList.Count - 1 do
  begin
    Str := StrList.Strings[i];
    ParseStr := Parse('">', '</option>', Str);
    if Pos('a', ParseStr) > 0 then
      ParseStr := StringReplace(ParseStr, 'a', 'a', [rfReplaceAll]);

    Item := TTreeViewItem.Create(nil);
    Item.StyleLookup := 'treeviewitemstyle';
    Item.Text := trim(StringReplace(ParseStr, '-', '', [rfReplaceAll]));
    Item.HelpKeyword := Parse('<option value="', '">', Str);
    Item.ClipChildren := false;

    if Pos('-', ParseStr) = 0 then
    begin
      aTree.AddObject(Item);
      Root := Item;
    end
    else if ParseStr.StartsWith('-- ') then
    begin
      Root.AddObject(Item);
      Child := Item;
    end
    else if ParseStr.StartsWith('---- ') then
    begin
      Child.AddObject(Item);
      SubChild := Item;
    end
    else if ParseStr.StartsWith('------ ') then
    begin
      SubChild.AddObject(Item);
    end;
  end;

  aTree.EndUpdate;
  aTree.RealignContent;

  FreeAndNil(StrList);
end;

вот решение если кто столкнется с таким же багом

спасибо Ярославу!

аналогично с OnKeyUp реализовывал, все работало

Разработка продолжается

 

• Полностью перевел приложение на XML RPC API (демо и исходник тут)
• Авторизация (если её можно так назвать)
• Информация о пользователе из профиля (добавлена информация о возрасте +незначительные улучшения кода)
• Обновил немного дизайн
• Кэширование данных пользователя и навигации форума (самостоятельное обновление когда это требуется)
• Используется OXml для Android
• Кэширование всех картинок пользователей (на данный момент это ~1200 юзеров, НО не все юзеры имеют фотографии) Кэшируется всё на внешнюю память
• Теперь можно открывать "сайт" из профиля юзера (для Windows с окном уведомления)

в ближайшее время собираюсь реализовать

1. Доделать навигацию по веткам (как только пойму почему косяк с TTreeView)
2. Кэширование всех картинок пользователей
3. разработать иконку и сплеш картинку (может её и вовсе уберу)
4. много чего...

Проект также open-source, помощь приветствуется

 

исходники выкладываю без бинарников, бинарники лежат на google диске в соответствующих папках (но синхронизация не всегда включена )

 

FireMonkey.ru.zip

 

XML RPC API - модуль для работы с форумом fire-monkey.ru

 

Реализованы все методы (спасибо Ярославу Бровину)

 

модуль кроссплатформенный, для Windows можно использовать MSXML, также поддерживается OXml для мобильных платформ

 

XML RPC API.zip

таймер должен быть объявлен глобально!

и зачем в потоке таймер?

поменять среду разработки на XE8 или XE7 update 1 + lollipop hotfix

Доброго времени суток!

 

В общем задача заключается в следующем:

не разворачиваются Item'ы на Андроиде

 

вот так выглядит на android'e

 

а вот так на windows

 

код который использую

procedure TFormFM.NavigationTreeView(aTree: TTreeView; const aData: string);

  function myIndexStr(aFind, aStr: string): Boolean;
  // точное совпаданеи начала строки
  var
    i: integer;
    s: string;
  begin
    s := '';
    for i := {$IFDEF WIN32} 1 {$ELSE} 0 {$ENDIF} to aFind.Length do
      s := s + aStr[i];
    Result := aFind = s;
  end;

var
  Item: TTreeViewItem;
  StrList: TStringList;
  i, c: integer;
  Str, ParseStr: string;
begin
  StrList := TStringList.Create;
  StrList.Text := aData;

  aTree.BeginUpdate;
  for i := 0 to StrList.Count - 1 do
  begin
    Str := StrList.Strings[i];
    ParseStr := Parse('">', '</option>', Str);
    if Pos('a', ParseStr) > 0 then
      ParseStr := StringReplace(ParseStr, 'a', 'a', [rfReplaceAll]);

    Item := TTreeViewItem.Create(nil);
    Item.StyleLookup := 'treeviewitemstyle';
    Item.Text := trim(StringReplace(ParseStr, '-', '', [rfReplaceAll]));
    Item.HelpKeyword := Parse('<option value="', '">', Str);

    if Pos('-', ParseStr) = 0 then
      aTree.AddObject(Item)
    else if myIndexStr('-- ', ParseStr) then
      aTree.Items[aTree.GlobalCount - 1].AddObject(Item)
    else if myIndexStr('---- ', ParseStr) then
      aTree.Items[aTree.GlobalCount - 1].Items[aTree.Items[aTree.GlobalCount - 1].Count - 1]
        .AddObject(Item)
    else if myIndexStr('------ ', ParseStr) then
    begin
      c := aTree.Items[aTree.GlobalCount - 1].Items[aTree.Items[aTree.GlobalCount - 1].Count -
        1].Count - 1;
      aTree.Items[aTree.GlobalCount - 1].Items[aTree.Items[aTree.GlobalCount - 1].Count - 1]
        .Items[c].AddObject(Item)
    end;

  end;
  aTree.EndUpdate;

  FreeAndNil(StrList);
end;

в стиле присутствует этот ресурс (стрелка)

при дизайн тайме стрелка появляется и все разворачивается

 

Кто знает решение? может чего не прописал в создании Item'a