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

Проблемы с отрисовкой


sviat9440

Вопрос

Всем привет. Есть такая проблема:

 

Вот код потока:

procedure Tmain_form.GetBase_threadAfterRun(Sender: TIdThreadComponent);
var
  Browser: TIdHTTP;
  JSON, JSON1: TJSONObject;
  i: Integer;
  Item, ItemRadio: TListBoxItem;
  BaseName, BaseCaption, BaseCategory, BaseID, BaseData: String;
  IMG: TMemoryStream;
begin
  if Connect then
  Begin
    Browser := TIdHTTP.Create(Self);
    img := TMemoryStream.Create;
    JSON := TJSONObject.ParseJSONValue(Browser.Get(Main_URL + 'base/get?client=' + Client)) as TJSONObject;
    i := 0;
    while i < JSON.Count do
    Begin
      BaseData := JSON.Pairs[i].ToString;
      BaseData := BaseData.Substring(pos('"', BaseData));
      BaseName := BaseData.Remove(pos('"', BaseData) - 1);
      BaseData := BaseData.Substring(pos('"', BaseData));
      BaseData := BaseData.Substring(pos(':', BaseData));
      JSON1 := TJSONObject.ParseJSONValue(BaseData) as TJSONObject;
      BaseCaption := JSON1.Values['caption'].Value;
      BaseCategory := JSON1.Values['category'].Value;
      BaseID := JSON1.Values['id'].Value;
      if MainContentDownloadBaseListBox.Items.IndexOf(BaseID) = -1 then
      Begin
        Item := TListBoxItem.Create(Self);
        Item.Height := 120;
        Item.StyleLookup := 'ListBoxItemDownloadBaseStyle';
        Item.Text := BaseID;
        Item.StylesData['name'] := BaseName;
        Item.StylesData['caption'] := BaseCaption;
        Item.StylesData['category'] := BaseCategory;
        Browser.Get(Main_URL + 'base/img/' + BaseID, IMG);
        Item.ItemData.Bitmap.LoadFromStream(IMG);
//        Sleep(100);
        MainContentDownloadBaseListBox.AddObject(Item);
      End;
      if MainContentDownloadBaseListBoxCategory.Items.IndexOf(BaseCategory) = -1 then
      Begin
        ItemRadio := TListBoxItem.Create(Self);
        ItemRadio.Height := 30;
        ItemRadio.StyleLookup := 'RadioListBoxItemStyle';
        ItemRadio.Text := BaseCategory;
        ItemRadio.Selectable := False;
        ItemRadio.Margins.Top := 5;
        ItemRadio.StylesData['text.OnChange'] := TValue.From<TNotifyEvent>(MainContentDownloadBaseListBoxCategoryChange);
        MainContentDownloadBaseListBoxCategory.AddObject(ItemRadio);
      End;
      i := i + 1;
    End;
    Browser.Free;
    img.Free;
    GetBase_thread.Terminate;
  End else sleep(100);
end;

В общем он должен загружать с сервера список итемов и заливать их в лист бокс.

Проблема в том что не всегда итемы в листбоксе отображаются корректно.

Если я вместо sleep(100) (закомментирован), поставлю ShowMessage('dd');, то все отрисовается корректно.

 

Ниже прилагаю скрины как оно может быть отрисовано.

 

Надеюсь на вашу поддержку))))

post-1145-0-93140500-1457419986_thumb.jp

post-1145-0-61345500-1457419990_thumb.jp

post-1145-0-92413300-1457419996_thumb.jp

Ссылка на комментарий
  • Ответы 51
  • Создана
  • Последний ответ

Лучшие авторы в вопросе

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

  • 0
  • Модераторы

Уже миллион раз обсуждалось, нужно использовать Bitmap Helper

в этой теме есть

 

не надо так

JSON := TJSONObject.ParseJSONValue(Browser.Get(Main_URL + 'base/get?client=' + Client)) as TJSONObject;

exception словишь, если пустой или вернётся не json

Изменено пользователем ZuBy
Ссылка на комментарий
  • 0

exception словишь, если пустой или вернётся не json

 

 

 

 знаю... для этого юзаю try/except. Просто тут не записал так как могут быть ошибки и их надо исправлять. А есть другие варианты?

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

Уже миллион раз обсуждалось, нужно использовать Bitmap Helper

в этой теме есть

 

Использую BitmapHelper

procedure Tmain_form.GetBase_threadAfterRun(Sender: TIdThreadComponent);
var
  Browser: TIdHTTP;
  JSON, JSON1: TJSONObject;
  i: Integer;
  Item, ItemRadio: TListBoxItem;
  BaseName, BaseCaption, BaseCategory, BaseID, BaseData: String;
//  IMG: TMemoryStream;
begin
  if Connect then
  Begin
    Browser := TIdHTTP.Create(Self);
//    img := TMemoryStream.Create;
    JSON := TJSONObject.ParseJSONValue(Browser.Get(Main_URL + 'base/get?client=' + Client)) as TJSONObject;
    i := 0;
    while i < JSON.Count do
    Begin
      BaseData := JSON.Pairs[i].ToString;
      BaseData := BaseData.Substring(pos('"', BaseData));
      BaseName := BaseData.Remove(pos('"', BaseData) - 1);
      BaseData := BaseData.Substring(pos('"', BaseData));
      BaseData := BaseData.Substring(pos(':', BaseData));
      JSON1 := TJSONObject.ParseJSONValue(BaseData) as TJSONObject;
      BaseCaption := JSON1.Values['caption'].Value;
      BaseCategory := JSON1.Values['category'].Value;
      BaseID := JSON1.Values['id'].Value;
      if MainContentDownloadBaseListBox.Items.IndexOf(BaseID) = -1 then
      Begin
        Item := TListBoxItem.Create(Self);
        Item.Height := 120;
        Item.StyleLookup := 'ListBoxItemDownloadBaseStyle';
        Item.Text := BaseID;
        Item.StylesData['name'] := BaseName;
        Item.StylesData['caption'] := BaseCaption;
        Item.StylesData['category'] := BaseCategory;
//        Browser.Get(Main_URL + 'base/img/' + BaseID, IMG);
        Item.ItemData.Bitmap.LoadFromUrl(Main_URL + 'base/img/' + BaseID);
//        Sleep(100);
        MainContentDownloadBaseListBox.AddObject(Item);
      End;
      if MainContentDownloadBaseListBoxCategory.Items.IndexOf(BaseCategory) = -1 then
      Begin
        ItemRadio := TListBoxItem.Create(Self);
        ItemRadio.Height := 30;
        ItemRadio.StyleLookup := 'RadioListBoxItemStyle';
        ItemRadio.Text := BaseCategory;
        ItemRadio.Selectable := False;
        ItemRadio.Margins.Top := 5;
        ItemRadio.StylesData['text.OnChange'] := TValue.From<TNotifyEvent>(MainContentDownloadBaseListBoxCategoryChange);
        MainContentDownloadBaseListBoxCategory.AddObject(ItemRadio);
      End;
      i := i + 1;
    End;
    Browser.Free;
//    img.Free;
    GetBase_thread.Terminate;
  End else sleep(100);
end;

вот результат: 

post-1145-0-92818700-1457421574_thumb.jp

post-1145-0-45358300-1457421583_thumb.jp

post-1145-0-22384700-1457421587_thumb.jp

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

Если я залью:

Item.ItemData.Bitmap.LoadFromUrl(Main_URL + 'base/img/' + BaseID);

в отдельные потоки, будет лучше? ну чтобы создавать поток специально для загрузки одного изображения.

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

 

Уже миллион раз обсуждалось, нужно использовать Bitmap Helper

в этой теме есть

 

Использую BitmapHelper

 

Хотя по сути, если посмотреть в код, то Bitmap Helper делает тоже самое.

Ссылка на комментарий
  • 0
  • Модераторы

 

Нельзя грузить в доп. потоке картинки!!! вынеси загрузку картинок отдельно в главный поток

Главный поток тормозить не будет?

 

нет, для этого в хелпере создается свой доп. поток. все будет чётко.

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

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

Блин...

procedure Tmain_form.MainContentDownloadBaseListBoxPaint(Sender: TObject;
  Canvas: TCanvas; const [Ref] ARect: TRectF);
var
  i: Integer;
begin
  i := 0;
  if TListBox(Sender).Items.Count > 0 then
  while i < TListBox(Sender).Items.Count do
  with TListBox(Sender).Children.Items[1].Children.Items[i] as TListBoxItem do
  Begin
    if StylesData['img'].ToString = '0' then
    Begin
      StylesData['img'] := '1';
      ItemData.Bitmap.LoadFromUrl(Main_URL + 'base/img/' + Text);
    End;
    i := i + 1;
  End;
end;

Все равно. Результат тот же...

Ссылка на комментарий
  • 0
procedure Tmain_form.GetBase_threadAfterRun(Sender: TIdThreadComponent);
var
  Browser: TIdHTTP;
  JSON, JSON1: TJSONObject;
  i: Integer;
  Item, ItemRadio: TListBoxItem;
  BaseName, BaseCaption, BaseCategory, BaseID, BaseData: String;
  IMG: TMemoryStream;
  Bitmap: TBitmap;
begin
  if Connect then
  Begin
    Browser := TIdHTTP.Create(Self);
    img := TMemoryStream.Create;
    Bitmap := TBitmap.Create;
    JSON := TJSONObject.ParseJSONValue(Browser.Get(Main_URL + 'base/get?client=' + Client)) as TJSONObject;
    i := 0;
    while i < JSON.Count do
    Begin
      BaseData := JSON.Pairs[i].ToString;
      BaseData := BaseData.Substring(pos('"', BaseData));
      BaseName := BaseData.Remove(pos('"', BaseData) - 1);
      BaseData := BaseData.Substring(pos('"', BaseData));
      BaseData := BaseData.Substring(pos(':', BaseData));
      JSON1 := TJSONObject.ParseJSONValue(BaseData) as TJSONObject;
      BaseCaption := JSON1.Values['caption'].Value;
      BaseCategory := JSON1.Values['category'].Value;
      BaseID := JSON1.Values['id'].Value;
      if MainContentDownloadBaseListBox.Items.IndexOf(BaseID) = -1 then
      Begin
        Item := TListBoxItem.Create(Self);
        Item.Height := 120;
        Item.StyleLookup := 'ListBoxItemDownloadBaseStyle';
        Item.Text := BaseID;
        Item.StylesData['name'] := BaseName;
        Item.StylesData['caption'] := BaseCaption;
        Item.StylesData['category'] := BaseCategory;
        Browser.Get(Main_URL + 'base/img/' + BaseID, IMG);
        Bitmap.LoadFromStream(IMG);
        Item.ItemData.Bitmap := Bitmap;
//        Item.ItemData.Bitmap.LoadFromUrl(Main_URL + 'base/img/' + BaseID);
//        Sleep(100);
//        Item.StylesData['img'] := '0';
        MainContentDownloadBaseListBox.AddObject(Item);
      End;
      if MainContentDownloadBaseListBoxCategory.Items.IndexOf(BaseCategory) = -1 then
      Begin
        ItemRadio := TListBoxItem.Create(Self);
        ItemRadio.Height := 30;
        ItemRadio.StyleLookup := 'RadioListBoxItemStyle';
        ItemRadio.Text := BaseCategory;
        ItemRadio.Selectable := False;
        ItemRadio.Margins.Top := 5;
        ItemRadio.StylesData['text.OnChange'] := TValue.From<TNotifyEvent>(MainContentDownloadBaseListBoxCategoryChange);
        MainContentDownloadBaseListBoxCategory.AddObject(ItemRadio);
      End;
      i := i + 1;
    End;
    Browser.Free;
    Bitmap.Free;
    img.Free;
    GetBase_thread.Terminate;
  End else sleep(100);
end;

Проблема решена.

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

Кажется понял: Когда я гружу имг из локалхост, то глючит, а когда с сервера то вроде все ок. Есть ли в TIdHTTP возможность ограничения скорости скачивания?

Ссылка на комментарий
  • 0
  • Модераторы

Блин...

procedure Tmain_form.MainContentDownloadBaseListBoxPaint(Sender: TObject;
  Canvas: TCanvas; const [Ref] ARect: TRectF);
var
  i: Integer;
begin
  i := 0;
  if TListBox(Sender).Items.Count > 0 then
  while i < TListBox(Sender).Items.Count do
  with TListBox(Sender).Children.Items[1].Children.Items[i] as TListBoxItem do
  Begin
    if StylesData['img'].ToString = '0' then
    Begin
      StylesData['img'] := '1';
      ItemData.Bitmap.LoadFromUrl(Main_URL + 'base/img/' + Text);
    End;
    i := i + 1;
  End;
end;

Все равно. Результат тот же...

при обновлении картинки нужно еще вызвать перерисовку Item'a через ApplyStyleLookup

Ссылка на комментарий
  • 0
procedure Tmain_form.GetBase;
var
  Browser: TIdHTTP;
  JSON, JSON1: TJSONObject;
  i: Integer;
  Item, ItemRadio: TListBoxItem;
  BaseName, BaseCaption, BaseCategory, BaseID, BaseData: String;
  Zip: TZipFile;
  TString: TStringList;
  Memory: TMemoryStream;
  thread: TThread;
begin
  try
    if Connect then
    Begin
      Browser := TIdHTTP.Create(Self);
      Browser.ConnectTimeout := 1000;
      Browser.ReadTimeout := 10000;
      TString := TStringList.Create;
      JSON := TJSONObject.ParseJSONValue(Browser.Get(Main_URL + 'base/get?client=' + Client)) as TJSONObject;
      i := 0;
      if DirectoryExists(Path + '/Lotus/base') and
      FileExists(Path + '/Lotus/base/data.lotus') then
      begin
        Zip := TZipFile.Create;
        Decode(Path + '/Lotus/base/data.lotus', Path + '/Lotus/base/data.tmp');
        if Zip.IsValid(Path + '/Lotus/base/data.tmp') then
        Begin
          Zip.Open(Path + '/Lotus/base/data.tmp', zmRead);
          if (Zip.FileCount = 1) and (Zip.FileName[0] = 'data') then
          Begin
            Zip.Extract('data', Path + '/Lotus/base/');
            TString.LoadFromFile(Path + '/Lotus/base/data');
            DeleteFile(Path + '/Lotus/base/data');
          End;
          Zip.Close;
          DeleteFile(Path + '/Lotus/base/data.tmp');
        End;
        Zip.Free;
      end;
      while i < JSON.Count do
      Begin
        BaseData := JSON.Pairs[i].ToString;
        BaseData := BaseData.Substring(pos('"', BaseData));
        BaseName := BaseData.Remove(pos('"', BaseData) - 1);
        BaseData := BaseData.Substring(pos('"', BaseData));
        BaseData := BaseData.Substring(pos(':', BaseData));
        JSON1 := TJSONObject.ParseJSONValue(BaseData) as TJSONObject;
        BaseCaption := JSON1.Values['caption'].Value;
        BaseCategory := JSON1.Values['category'].Value;
        BaseID := JSON1.Values['id'].Value;
        if (MainContentDownloadBaseListBox.Items.IndexOf(BaseID) = -1) then
        Begin
          Item := TListBoxItem.Create(Self);
          Item.Height := 120;
          Item.StyleLookup := 'ListBoxItemDownloadBaseStyle';
          Item.Text := BaseID;
          Item.StylesData['name'] := BaseName;
          Item.StylesData['caption'] := BaseCaption;
          Item.StylesData['category'] := BaseCategory;
          Item.Selectable := False;
          Item.StylesData['download.OnClick'] := TValue.From<TNotifyEvent>(MainContentDownloadBaseButtonClick);
          Item.ItemData.Bitmap.LoadFromUrl(Main_URL + 'base/img/' + BaseID);
//            Memory := TMemoryStream.Create;
//            Browser.Get(Main_URL + 'base/img/' + BaseID, Memory);
//            Item.ItemData.Bitmap.LoadFromStream(Result);
//            Item.ApplyStyleLookup;
//            Memory.Free;

          if (not(TString.IndexOf(BaseID) = -1)) and (FileExists(Path + '/Lotus/base/' + BaseID + '.lotus')) then
          Begin
            Item.StylesData['download.Visible'] := False;
          End;
          MainContentDownloadBaseListBox.AddObject(Item);
          if MainContentDownloadBaseListBoxCategory.Items.IndexOf(BaseCategory) = -1 then
          Begin
            ItemRadio := TListBoxItem.Create(Self);
            ItemRadio.Height := 30;
            ItemRadio.StyleLookup := 'RadioListBoxItemStyle';
            ItemRadio.Text := BaseCategory;
            ItemRadio.Selectable := False;
            ItemRadio.Margins.Top := 5;
            ItemRadio.StylesData['text.OnChange'] := TValue.From<TNotifyEvent>(MainContentDownloadBaseListBoxCategoryChange);
            MainContentDownloadBaseListBoxCategory.AddObject(ItemRadio);
          End;
        End;
        i := i + 1;
      End;
      Browser.Free;
      TString.Free;
      MainContentDownloadBaseBlock.Visible := False;
    End;
  except
    MainContentDownloadBaseBlockText.Text := 'Произошла ошибка';
  end;
end;

Вот кое что написал. Вопрос: Почему у меня так:

post-1145-0-55666600-1457450419.jpg

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

Фото не грузятся вообще. Но если я вместо 

Item.ItemData.Bitmap.LoadFromUrl(Main_URL + 'base/img/' + BaseID);

Поставлю

Memory := TMemoryStream.Create;
Browser.Get(Main_URL + 'base/img/' + BaseID, Memory);
Item.ItemData.Bitmap.LoadFromStream(Result);
Item.ApplyStyleLookup;
Memory.Free;

То все грузится корректно, если бы не одно но: если баз на сервере будет 100+ то загрузка займет до нескольких минут.

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

Еще одна деталь:

procedure Tmain_form.DownloadMenuButtonClickClick(Sender: TObject);
begin
  MainContentDownloadBaseListBox.Clear;
  if not (MenuView.Width = 40) then
    MenuView.HideMaster;
  if not (MainContent.ActiveTab = MainContentDownloadBase) then
    ToMainContentDownloadBase.Execute;
  GetBase;
end;

Если я сначала очищу а потом опять загружу итемы, то иногда "Пробивает" на закачку всех картинок. Нет такого чтобы одна загрузилась, вторая нет. Либо все, либо ничего.

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

почему в потоке создаются визуальные элементы? (listItem)

в потоке создавайте нормальную модель данных

потом уже мухой, по модели заполните свой list

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

Тоесть элемент создается нормально, и отокбражается корректно, но если текст, фото, и пр. будут изменены из еще одного потока, то это не отрисуется до клика по объекту.

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

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

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

Гость
Ответить на вопрос...

×   Вставлено с форматированием.   Вставить как обычный текст

  Разрешено использовать не более 75 эмодзи.

×   Ваша ссылка была автоматически встроена.   Отображать как обычную ссылку

×   Ваш предыдущий контент был восстановлен.   Очистить редактор

×   Вы не можете вставлять изображения напрямую. Загружайте или вставляйте изображения по ссылке.

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

    • Ни одного зарегистрированного пользователя не просматривает данную страницу

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