Не правильно подгружается картинка в RunTime

Dozent · 2 августа, 2015

Добрый день!

Суть в проблемы в следующем.

Создал стиль для TListBoxItem

В RunTime создаю итемы по событию

procedure TfrmMain.ReadActionDb(Sender: TObject; const sTime, sActionName: string; const RecordNumber, ActionID: integer);
var
  iCurItem: integer;
  Item: TListBoxItem;
begin
  Item := TListBoxItem.Create(nil);
  Item.Index := 0;
  // Item.Parent := lbLogActions;
  Item.Height := 60;
  Item.Margins.Top := 10;
  Item.StyleLookup := 'listboxitemaction';
  Item.Tag := ActionID;
  Item.StylesData['timeaction'] := SecToTime(sTime);
  Item.StylesData['labelaction'] := sActionName;
  Item.StylesData['imageaction'] := '.\images\ScenarioImage\actions\' + IntToStr(ActionID) + '.png';
  lbLogActions.InsertObject(0, Item);
end;

Проблема в том что, картинки подгружаются не всегда правильно, могу выскочить просто какие-то артефакты, а может вообще уменьшенная часть экрана не понятно почему)

Можно видеть на картинке что 2 созданный итем не отобразил картинку

Что не так делаю?

FIL · 2 августа, 2015

Попробуй грузить картинки не с диска. Вряд ли их у тебя очень много.

enatechno · 2 августа, 2015

Ваша ошибка в том, что вы присваиваете имя файла, а не TBitmap.

Item.StylesData['imageaction'] := '.\images\ScenarioImage\actions\' + IntToStr(ActionID) + '.png';

Загрузка картинки с диска:

var
 aFileStream: TFileStream;
....
aFileStream := TFileStream.Create('.\images\ScenarioImage\actions\' + IntToStr(ActionID) + '.png', fmOpenRead);
try
  if (aFileStream.Size > 0) then
    Item.StylesData['imageaction'] := TValue.From<TBitmap>(TBitmap.CreateFromStream(aFileStream));
finally
  FreeAndNil(aFileStream);
end;

если проблема останется, то вот еще тема.

Если у вас XE8, то вы можете смело использовать ImageList.

Изменено 2 августа, 2015 пользователем enatechno

Dozent · 2 августа, 2015

у меня XE8 up1 подскажите как исользовать ImageList, что то не нашёл у image ссылку на него...

enatechno · 2 августа, 2015

TImageList - это новый компонент http://blogs.embarcadero.com/roschinspb/2015/03/03/timagelistxe8ru/.

Видео https://www.youtube.com/watch?v=YTU7o7xMbws

Обсуждение http://fire-monkey.ru/forum/35-timagelist-s-xe8/

Изменено 2 августа, 2015 пользователем enatechno

Dozent · 2 августа, 2015

Спасибо, почитаю!

Dozent · 2 августа, 2015

Подгрузка в поток не помогла! Картинки также иногда не подгружаются, буду смотреть работу с ImageList

enatechno · 2 августа, 2015

иногда не подгружаются

вариант ZuBy тоже не помог?

var
 aFileStream: TFileStream;
 aBitmap:     TBitmap;
....
aFileStream := TFileStream.Create('.\images\ScenarioImage\actions\' + IntToStr(ActionID) + '.png', fmOpenRead);
try
  if (aFileStream.Size > 0) then
  begin 
    aBitmap := TBitmap.CreateFromStream(aFileStream);
    Item.StylesData['imageaction'] := TValue.From<TBitmap>(aBitmap);
    Item.StylesData['imageaction.visible'] := true;
    Item.ItemData.Bitmap.Assign(aBitmap);
  end;
finally
  FreeAndNil(aFileStream);
end;

буду смотреть работу с ImageList

Этот вариант предпочтительнее для Вашего примера.

Dozent · 3 августа, 2015

Использую ImageList какой компонент мне нужен для отображения? TGlyph? Я так понимаю TImage не подходит, к нему нельзя подключить ImageList

Dozent · 3 августа, 2015

иногда не подгружаются

вариант ZuBy тоже не помог?
var
 aFileStream: TFileStream;
 aBitmap:     TBitmap;
....
aFileStream := TFileStream.Create('.\images\ScenarioImage\actions\' + IntToStr(ActionID) + '.png', fmOpenRead);
try
  if (aFileStream.Size > 0) then
  begin 
    aBitmap := TBitmap.CreateFromStream(aFileStream);
    Item.StylesData['imageaction'] := TValue.From<TBitmap>(aBitmap);
    Item.StylesData['imageaction.visible'] := true;
    Item.ItemData.Bitmap.Assign(aBitmap);
  end;
finally
  FreeAndNil(aFileStream);
end;
буду смотреть работу с ImageList

Этот вариант предпочтительнее для Вашего примера.

К сожалению не помогло...

Изменено 3 августа, 2015 пользователем Dozent

#WAMACO · 3 августа, 2015

Что не так делаю?

а почему insert, а не add?

Равиль Зарипов (ZuBy) · 4 августа, 2015

IntToStr(ActionID) - всегда правильное значение? может дело в этом?

Dozent · 4 августа, 2015

Что не так делаю?

а почему insert, а не add?

потому что надо чтобы добавилось в нулевую позицию новый итем а не в последнюю

Dozent · 4 августа, 2015

IntToStr(ActionID) - всегда правильное значение? может дело в этом?

Да правильное, бывает просто нужно прокрутить и картинка появится иногда нет) Но метод который помог вам мне не подошёл, мб потому что планшет под виндой. Пока решение не нащёл..

Равиль Зарипов (ZuBy) · 4 августа, 2015

IntToStr(ActionID) - всегда правильное значение? может дело в этом?

Да правильное, бывает просто нужно прокрутить и картинка появится иногда нет) Но метод который помог вам мне не подошёл, мб потому что планшет под виндой. Пока решение не нащёл..

Пробовали просто Repaint?

Dozent · 4 августа, 2015

нет, я сейчас попробую или в при загрузки приложения складывать всё в массив или с ImageList попробую, только не понятно как связать TImageList c TImage

Кривяков Виталий · 4 августа, 2015

Добрый день!

Недавно столкнулся с похожей проблемой, картинки не всегда подгружались, проблема была в том, что любые действия с TBitmap (загрузка, изменение размера и т.п.) должны обязательно выполнятся в основном потоке. Проверьте, нет ли у вас работы с изображением не в основном потоке?

Dozent · 4 августа, 2015

Подгрузка изображение ощучествляется в кал-бак функции второстепеного потока, но срабатывает же он из основного) После синхранизации...

xenon54 · 4 августа, 2015

Вероятно, любые действия с TBitmap нужно выполнять в основном потоке, только если этот Bitmap участвует в отрисовке на экране. Но это касается всего, что касается отрисовке на экране

AngryOwl · 4 августа, 2015

Подгрузка изображение ощучествляется в кал-бак функции второстепеного потока, но срабатывает же он из основного) После синхранизации...

Только если Вы сделаете TThread.Synchronize(TThread.CurrentThread, {тут процедура отрисовки вашего bitmap}) из того самого "второстепенного" потока.

Dozent · 4 августа, 2015

Подгрузка изображение ощучествляется в кал-бак функции второстепеного потока, но срабатывает же он из основного) После синхранизации...

Только если Вы сделаете TThread.Synchronize(TThread.CurrentThread, {тут процедура отрисовки вашего bitmap}) из того самого "второстепенного" потока.

создаю поток

procedure TfrmMain.SetInitializationReadDB(iExerciseId: integer);
begin
  ReadAction := TReadActionFromDB.Create();
  ReadAction.onReadAction := ReadActionDb;
  ReadAction.ExId := iExerciseId;
  ReadAction.Start;
end;

процедура Exrcute

procedure TReadActionFromDB.Execute;
var
  qr: ISyncQueryResult;
begin
  try
    fRecordsCount := 0;
    while not Terminated do
    begin
      if ExId > 0 then
      begin
        qr := AppData.Select('log', [TScriptGetParameterHelper.Create('exercise', ExId)]);
        if qr.DataSet.RecordCount > fRecordsCount then
        begin // если появились новые записи
          qr.DataSet.First;
          qr.DataSet.MoveBy(fRecordsCount);
          while not qr.DataSet.Eof do
          begin
            // время события
            fTime := qr.DataSet.FieldByName('VTIME').AsString;;
            // название события
            fActionName := qr.DataSet.FieldByName('DESCRIP_ACTION').AsString;
            // id действия
            if not qr.DataSet.FieldByName('ID_ACTION').IsNull then
              fActionID := qr.DataSet.FieldByName('ID_ACTION').AsInteger
            else
              fActionID := 0;
            // номер записи
            fRecordNumber := qr.DataSet.RecNo;
            // колличество всех записией
            fRecordsCount := qr.DataSet.RecordCount;
            Synchronize(Sync);
            // Queue(Sync);

            // Sleep(100);
            qr.DataSet.Next;
          end;
          // Sleep(500);
        end;
      end;
    end;
  except
    on E: Exception do
      DoReadError(E.ClassName + ' ошибка с сообщением : ' + E.Message);
  end;

end;

procedure TReadActionFromDB.Sync;
begin
  if Assigned(fonReadAction) then
    fonReadAction(Self, fTime, fActionName, fRecordNumber, fActionID);
end;

Кал-бак функцию для отрисовки

procedure TfrmMain.ReadActionDb(Sender: TObject; const sTime, sActionName: string; const RecordNumber, ActionID: integer);
var
  Item: TListBoxItem;
  aFileStream: TFileStream;
  aBitmap: TBitmap;
begin

  Item := TListBoxItem.Create(nil);
  Item.Index := 0;
  // Item.Parent := lbLogActions;
  Item.Height := 60;
  Item.Margins.Top := 10;
  Item.StyleLookup := 'listboxitemaction';
  Item.Tag := ActionID;
  Item.StylesData['timeaction'] := SecToTime(sTime);
  Item.StylesData['labelaction'] := sActionName;
  // Item.StylesData['imageaction'] := '.\images\ScenarioImage\actions\' + IntToStr(ActionID) + '.png';
  aFileStream := TFileStream.Create('.\images\ScenarioImage\actions\' + IntToStr(ActionID) + '.png', fmOpenRead);
  try
    if (aFileStream.Size > 0) then
    begin
      aBitmap := TBitmap.CreateFromStream(aFileStream);
      Item.StylesData['imageaction'] := TValue.From<TBitmap>(aBitmap);
      Item.StylesData['imageaction.visible'] := True;
      Item.ItemData.Bitmap.Assign(aBitmap);
    end;
  finally
    FreeAndNil(aFileStream);
  end;
  lbLogActions.InsertObject(0, Item);
end;

AngryOwl · 4 августа, 2015

Попробуйте так:

procedure TReadActionFromDB.Sync;
begin
  if Assigned(fonReadAction) then
    TThread.Synchronize(TThread.CurrentThread, procedure
    begin
      fonReadAction(Self, fTime, fActionName, fRecordNumber, fActionID);
    end);
end;

кроме того,

aBitmap := TBitmap.CreateFromStream(aFileStream);
Item.StylesData['imageaction'] := TValue.From<TBitmap>(aBitmap);
Item.StylesData['imageaction.visible'] := True;
Item.ItemData.Bitmap.Assign(aBitmap);

'imageaction' - что это за объект? (в смысле - зачем в один Item дважды засовывать одно изображение?)

Dozent · 4 августа, 2015

ну это был совет с форума, просто попробовал, но не помогло...

А чем код приведёный вами по синхронизации лучше? Поясните плз

AngryOwl · 4 августа, 2015

Да! Еще забыл.

Тут об этом много уже писалось. Если у вас есть не одно изображение в ListBoxItem, или одно, но не "стандартное" 'icon', то Вам нужно сделать следующее:

Item.OnApplyStyleLookup := MyItemApplyStyle;

где MyItemApplyStyle(Sender: TObject) - процедура, где Вам нужно перерисовать ваш битмап

типа:

procedure MyItemApplyStyle(Sender: TObject);
var
  StyleObject: TFmxObject;
begin
  if Assigned(TListBoxItem(Sender)) then
    with TListBoxItem(Sender) do
    try
      BeginUpdate;

      StyleObject := FindStyleResource('imageaction') as {тут ваш объект, например, TImage};
      if Assigned(StyleObject)then
      begin
          TImage(StyleObject).Bitmap.Canvas.BeginScene();
          try
            TImage(StyleObject).Bitmap := {здесь грузите ваш битмап};
          finally
            TImage(StyleObject).Bitmap.Canvas.EndScene;
          end;
      ............
    finally
      EndUpdate;
    end;
end;

З.Ы. За возможные ошибки - сорри, писал "на коленке"

З.З.Ы. И не бойтесь грузить картинки из файлов - это все-равно будет очень быстро.

Изменено 4 августа, 2015 пользователем AlexG

AngryOwl · 4 августа, 2015

ну это был совет с форума, просто попробовал, но не помогло...

А чем код приведёный вами по синхронизации лучше? Поясните плз

Я бы советовал Вам посмотреть вот эту тему

Dozent · 4 августа, 2015

О спасибо Вам за развёрнутый ответ, но я думаю всё же будет лучше если работать с ImageList... Можете дать ссылочку где почитать как подружить ImageList с Image?

Войти

Не правильно подгружается картинка в RunTime

Вопрос

Ссылка на комментарий

27 ответов на этот вопрос

Рекомендуемые сообщения

Ссылка на комментарий

Ссылка на комментарий

Ссылка на комментарий

Ссылка на комментарий

Ссылка на комментарий

Ссылка на комментарий

Ссылка на комментарий

Ссылка на комментарий

Ссылка на комментарий

Ссылка на комментарий

Ссылка на комментарий

Ссылка на комментарий

Ссылка на комментарий

Ссылка на комментарий

Ссылка на комментарий

Ссылка на комментарий

Ссылка на комментарий

Ссылка на комментарий

Ссылка на комментарий

Ссылка на комментарий

Ссылка на комментарий

Ссылка на комментарий

Ссылка на комментарий

Ссылка на комментарий

Ссылка на комментарий

Присоединяйтесь к обсуждению

Похожий контент

Последние посетители 0 пользователей онлайн