AngryOwl

Добрый вечер!

Не вдавался в проверку кода самой процедуры TextHeight, но мне кажется, что именно в Вашем, конкретном, случае, Вы забываете, что передаете этой функции неверные параметры.

TextHeight(AItem.Text, TS, ListView1.Width)

В качестве "ширины" по умолчанию Вы передаете значение ширины всего объекта TListView. При том как Ваш объект TListView имеет еще видимый TScrollBar (полосу прокрутки), ширину которой Вы не учитываете и не вычитаете из общей ширины TListView соответственно.

Спасибо за развернутый ответ!

Возник следующий вопрос:

Допустим есть "сложная" форма, внешний вид которой должен быть нестандартным и на которой расположено N-ное количество компонент (исходим из того, что их много, некоторые из них - динамические, например - вывод видео с камеры).
"Нестандартный вид" подразумевает: наличие тени у формы, измененный внешний вид, отличный от вида по умолчанию в любой ОС.

Непосредственно вопрос звучит так.
Какая из двух следующих реализаций будет работать быстрее (отрисовка/обновление этой формы при обновлении компонент: текста, списков, вывод видео и т.д.):

Оба вида форм предопределяются в стиле.

ВАРИАНТ 1.
- Тень формы реализована в виде компонента TImage с подгруженным PNG изображением.
- Контур формы реализован компонентом TRectangle с "окантовкой" и заливкой прямоугольника заданным цветом (все без градиентов)
- Шапка формы реализована вторым прямоугольником TRectangle без "окантовки", но с заливкой другим цветом (без градиента)

ВАРИАНТ 2. Вся форма задана одним объектом TStyleObject в котором в качестве свойств установлены:
- SourceLookup - ссылка на PNG-изображение в данном стиле
- SourceLink - создан TBitmapLink, у которого заданы свойства CapInsets и SourceRect

Внешний вид у них будет практически одинаковый (хотя во втором случае он будет более корректным на любой ОС и при использовании любой видео-карты, чего не скажешь о первом варианте).
Однако, интересует именно СКОРОСТЬ отрисовки в обеих случаях!
Интересует именно теория, с точки зрения реализации самой FMX.

З.Ы. Предполагаю, что вопрос больше к разработчикам FMX, но возможно у кого-то уже есть опыт работы с подобными задачами...

{$IFDEF ANDROID}
function Encode_Stream( AStream: TStream ): string;
var
  LStream: TMemoryStream;
begin
  AStream.Position:= 0;
  LStream := TMemoryStream.Create;
  TNetEncoding.Base64.Encode( AStream, LStream );
  LStream.Position := 0;
  Result := ReadStringFromStream(LStream, -1, IndyTextEncoding_8Bit);
end;

function Decode_Stream( enc_str: string ): TMemoryStream;
var
  LStream: TStringStream;
begin
  Result:= TMemoryStream.Create;
  LStream:= TStringStream.Create;
  LStream.WriteString( enc_str );
  LStream.Position:= 0;
  TNetEncoding.Base64.Decode( LStream, Result );
end;
{$ELSE}
function Encode_Stream(AStream: TStream): string;
begin
  AStream.Position:= 0;
  Result:= TIdEncoderMIME.EncodeStream(AStream);
end;

function Decode_Stream(enc_str: string): TMemoryStream;
begin
  Result:= TMemoryStream.Create;
  TIdDecoderMIME.DecodeStream(enc_str, Result);
end;
{$ENDIF}

function LoadBitmapFromStream(const AStream: TStream; const Bitmap: TBitmap): Boolean;
var
  Bmp: TBitmapSurface;
begin
  Result := False;
  Bmp := TBitmapSurface.Create;
  try
    Bmp.Assign(Bitmap);
    Result := TBitmapCodecManager.LoadFromStream(AStream, Bmp);
    Bitmap.Assign(Bmp);
  finally
    FreeAndNil(Bmp);
  end;
end;

function SaveBitmapToStream(const AStream: TStream; const Bitmap: TBitmap; const Extension: string;
  SaveParams: PBitmapCodecSaveParams = nil): Boolean;
var
  surf: TBitmapSurface;
begin
  Result := False;
  surf := TBitmapSurface.Create;
  surf.Assign(Bitmap);
  try
    Result := TBitmapCodecManager.SaveToStream(AStream, surf, Extension, SaveParams);
  finally
    surf.Free;
  end;
end;

function Bitmap_To_Base64(bmp: TBitmap; const AQuality: Integer = 85): string;
var
  eStream: TMemoryStream;
  SaveParams: TBitmapCodecSaveParams;
begin
  eStream:= TMemoryStream.Create;
  SaveParams.Quality := AQuality;
  SaveBitmapToStream(eStream, bmp, '.jpg', @SaveParams);
  Result:= Encode_Stream(eStream);
  eStream.Free;
end;

function Bitmap_From_Base64(b64_string: string): TBitmap;
var
  eStream: TMemoryStream;
begin
  Result := TBitmap.Create;
  eStream := Decode_Stream(b64_string);
  if Assigned(eStream) then
  try
    eStream.Position := 0;
    LoadBitmapFromStream(eStream, Result);
  finally
    eStream.free;
  end;
end;

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

Вот, кстати, Андрей Ефимов создал тему. Вот и сформулируйте правильно вопрос, на который бы Вы хотели получить полноценный и развернутый ответ.

Вдруг наши гуру обратят на него внимание!? )))

Ну а если нет - будем ждать..

Все-таки работа с видео, в частности его скоростное воспроизведение средствами FMX, - "больная" тема...

Ну если бы не FMX - было бы намного проще... В смысле - реализация Вашей задачи под Windows.

А в FMX пока, к сожалению, работа с мультимедиа "хромает". В том смысле, что пока мало компонентов, да и рассматривается FMX, в первую очередь, как простой "инструмент" для создания кроссплатформенных приложений. И здесь нужно понимать, что именно из-за этого и сложно реализовать серьезные компоненты (в частности - для работы с аудио и видео).

Хотя, думаю, что со временем все появится. И вполне приличное. А пока либо сами, "ручками", либо приобретаете то, что есть.

Если только под винду - могу посоветовать Mitov VideoLab. Только они платные. Бесплатно - будет надпись на видео. Там никаких проблем с нагрузкой, скоростью и синхронностью - хоть 10 окон сделайте.

 

 

Попробуйте сделать просто:

improgressbar.Bitmap.Canvas.BeginScene;
try
  improgressbar.Bitmap.LoadFromFile(........................
finally
  improgressbar.Bitmap.Canvas.EndScene;
end;

Огромное спасибо! Только вот теперь выяснилось что глючит в довесок TLabel. Но это удалось решить костылём sleep(10);

И еще такой вопрос: как убрать мерцание?

 

С TLabel ситуация точно та же.

Сначала BeginUpdate, потом EndUpdate.

А если проблема не в этом - тогда все (вывод в GUI) загнать в

TThread.Syncronize(TThread.CurrentThread, procedure
begin
 .................
end);

С мерцанием - не понял, что именно и когда мерцает?

Попробуйте сделать просто:

improgressbar.Bitmap.Canvas.BeginScene;
try
  improgressbar.Bitmap.LoadFromFile(........................
finally
  improgressbar.Bitmap.Canvas.EndScene;
end;

Друзья!

Поздравляю вас всех с Новым Годом!

Желаю всем вам здоровья, счатья и благополучия в наступившем 2016 году!

Пожелаю всем нам успехов в наших делах, проектах, разработках!

Чтобы все у нас с вами сложилось)

Отдельно хочу поздравить Бровина Ярослава и Ефимова Андрея!

Пожелать Вам, ребята, и Вашим близким, успехов и благополучия!

Еще раз - с Новым Годом!

p.s. Надеюсь не забанят за то, что "не в тему" )))

Вариантов много:

1. Как ребята сказали выше - это использование собственного шрифта в программе. Пример уже приводился. И использование готового компонента из примеров.

Используя свой шрифт, можно делать и разными цветами. И с "бордюром". И т.д. Единственное - будет сложно получить какие-то сложные эффекты.

2. Использование картинок:

Последовательность именно в таком порядке.

Следовательно - меняя ширину "синей" картинки, Вы получите плавную "заливку" "звездочек". Тут вариантов намного больше чем в других случаях. Можно делать с анимацией, с любыми эффектами...

Можно и компонент свой написать и в первом случае (со шрифтом) и во втором..

Вообще в голове крутится много вариантов. Просто Вам нужно решить, что для Вас важнее - память? скорость? универсальность? простота? И конечный результат.

Гугель форева... (за верность кода не отвечаю))

Вопрос какой-то всеобъемлющий...

1. Картинку в качестве обоев

2. не ручками, а чтоб само

3. да еще и из заданной папки....

чтобы не осталось

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Application.MainForm := Self;
  inherited;
end;

Вопрос поднимался не единожды. Я тут описывал как сделать подобное.

unit uHelpers;

interface

uses
  FMX.Forms;

type
  TForm_Helper = class helper for TForm
     procedure Minimize;
     procedure SendToTaskbar;
  end;

implementation

uses System.UITypes{$IFDEF MSWINDOWS}, Winapi.Windows, FMX.Platform.Win{$ENDIF};

{ TForm_Helper }

procedure TForm_Helper.Minimize;
begin
  Application.MainForm:= nil;
  WindowState := TWindowState.wsMinimized;
end;

procedure TForm_Helper.SendToTaskbar;
begin
{$IFDEF MSWINDOWS}
  SetWindowLong(WindowHandleToPlatform(Handle).Wnd, GWL_EXSTYLE,
    GetWindowLong(WindowHandleToPlatform(Handle).Wnd, GWL_EXSTYLE) or WS_EX_APPWINDOW);
{$ENDIF}
end;

end.

у Вашей формы пишем

type
  TForm1 = class(TForm)
  ........
  protected
    procedure CreateHandle; override;
  private
    ........
  public
  ......
  end;

implementation

uses
  uHelpers;

{$R *.fmx}

{это позволит сворачивать ваше окно на панель задач, независимо от количества окон в приложении}
procedure TForm1.CreateHandle;
begin
  inherited CreateHandle;
  SendToTaskbar;
end;

а Minimize свернет все как надо, независимо от того - какое у него "состояние".

1. думаю, что надо назначить свой обработчик отрисовки, и в нем перерисовывать в тот цвет, что Вы "запомните" где-то

2. тут

Тут

Можно сделать что угодно.

Посмотрите тут. Я там приводил, в качестве примера, как сделать свои окна. С ними-то (с окнами) вы можете сделать "всплывающие", "выезжающие" и вообще какие угодно.

Все зависит от полета фантазии...

Может я не правильно Вас понял, но думаю, что самый простой способ - это создать один стиль объединив несколько.

Смысл заключается в следующем:

- помещаете в ваш стиль нужные изображения с элементами компонентов

- создаете одинаковые (например) кнопки, только с разным названием стиля. Например одна будет "buttonstyle" и будет использовать Background SourceLookup из одного изображения, а вторая "buttondarkstyle" из другого изображения

- в программе Вам нужно лишь в соответствующий момент менять стиль кнопки

(к "кнопкам" не привязываемся - это я в качестве примера))

P.S. сорри за большие картинки, но так понятнее...

 

в демках есть тоже все

так в том то и дело, что не все!

как например добавить сепаратор (разделитель) не знаю!

 

  var
    newLine : TListViewItem;
  begin
    newLine := {ваш_TListView}.Items.Add;
    newLine.purpose:= TListItemPurpose.Header;
    newLine.Height := 1;
    newLine.Text := '';
  end;

вот Вам "разделитель")

P.S. А в остальном, думаю, что слишком много вопросов сразу... Потому и не отвечают.

Вот у меня, например, нет времени отвечать на все - в итоге не отвечу совсем. (просто именно этот ответ занял пару минут на все)

А иногда было бы можно, если бы вопрос был кратко и четко сформулирован.

Надо было сразу уточнить, - что на мобильном.

У меня и на мобильном все работает. Только вот как решил, в свое время, - сейчас так и не вспомню))

Попробуйте у компонента TTabControl выставить свойство StyleLookup = 'imagecellstyle' (например). И меняйте высоту TabHeight.

Применение эффекта нужно делать в TThread.Synchronize(TThread.CurrentThread, ....)

(для каждой отрисовки "кадра")

Иначе они у Вас "накапливаться" будут.

Но я не стал бы их принять вообще в вашем случае (особенно Glow).

А в чем собственно проблема то?

Этот вопрос тут звучит не в первый раз. Хотите сказать, что TTabControl(ваш_объект).TabHeight - изменение этого свойства в DesignTime не влияет на высоту?

Работает все, как ни крути...

Может у Вас что-то со стилем?

Присоединяюсь к вопросу)

Подобное уже обсуждалось. Посмотрите, например, тут.