sviat9440 Опубликовано 8 марта, 2016 Поделиться Опубликовано 8 марта, 2016 Всем привет. Есть такая проблема: Вот код потока: 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');, то все отрисовается корректно. Ниже прилагаю скрины как оно может быть отрисовано. Надеюсь на вашу поддержку)))) Цитата Ссылка на комментарий
0 sviat9440 Опубликовано 8 марта, 2016 Автор Поделиться Опубликовано 8 марта, 2016 В общем проблема только с битмапами. Я ставил и TImage и TRectangle, Результат один... Цитата Ссылка на комментарий
0 Модераторы Равиль Зарипов (ZuBy) Опубликовано 8 марта, 2016 Модераторы Поделиться Опубликовано 8 марта, 2016 (изменено) Уже миллион раз обсуждалось, нужно использовать Bitmap Helper в этой теме есть не надо так JSON := TJSONObject.ParseJSONValue(Browser.Get(Main_URL + 'base/get?client=' + Client)) as TJSONObject; exception словишь, если пустой или вернётся не json Изменено 8 марта, 2016 пользователем ZuBy Цитата Ссылка на комментарий
0 sviat9440 Опубликовано 8 марта, 2016 Автор Поделиться Опубликовано 8 марта, 2016 exception словишь, если пустой или вернётся не json знаю... для этого юзаю try/except. Просто тут не записал так как могут быть ошибки и их надо исправлять. А есть другие варианты? Цитата Ссылка на комментарий
0 sviat9440 Опубликовано 8 марта, 2016 Автор Поделиться Опубликовано 8 марта, 2016 Уже миллион раз обсуждалось, нужно использовать 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; вот результат: Цитата Ссылка на комментарий
0 sviat9440 Опубликовано 8 марта, 2016 Автор Поделиться Опубликовано 8 марта, 2016 Одно НО: использую TListBox ибо с TListView не могу разобраться... Цитата Ссылка на комментарий
0 sviat9440 Опубликовано 8 марта, 2016 Автор Поделиться Опубликовано 8 марта, 2016 Если я залью: Item.ItemData.Bitmap.LoadFromUrl(Main_URL + 'base/img/' + BaseID); в отдельные потоки, будет лучше? ну чтобы создавать поток специально для загрузки одного изображения. Цитата Ссылка на комментарий
0 sviat9440 Опубликовано 8 марта, 2016 Автор Поделиться Опубликовано 8 марта, 2016 Уже миллион раз обсуждалось, нужно использовать Bitmap Helper в этой теме есть Использую BitmapHelper Хотя по сути, если посмотреть в код, то Bitmap Helper делает тоже самое. Цитата Ссылка на комментарий
0 sviat9440 Опубликовано 8 марта, 2016 Автор Поделиться Опубликовано 8 марта, 2016 Кстати, я и в стили напрямую залазил, через ....Children.Items , и через .FindStyleObject[] , результат такой же,.. Цитата Ссылка на комментарий
0 Модераторы Равиль Зарипов (ZuBy) Опубликовано 8 марта, 2016 Модераторы Поделиться Опубликовано 8 марта, 2016 Нельзя грузить в доп. потоке картинки!!! вынеси загрузку картинок отдельно в главный поток Цитата Ссылка на комментарий
0 sviat9440 Опубликовано 8 марта, 2016 Автор Поделиться Опубликовано 8 марта, 2016 Нельзя грузить в доп. потоке картинки!!! вынеси загрузку картинок отдельно в главный поток Главный поток тормозить не будет? Цитата Ссылка на комментарий
0 Модераторы Равиль Зарипов (ZuBy) Опубликовано 8 марта, 2016 Модераторы Поделиться Опубликовано 8 марта, 2016 Нельзя грузить в доп. потоке картинки!!! вынеси загрузку картинок отдельно в главный поток Главный поток тормозить не будет? нет, для этого в хелпере создается свой доп. поток. все будет чётко. ссылку которую я давал, запустите оттуда демку и посмотрите как там всё устроено Цитата Ссылка на комментарий
0 sviat9440 Опубликовано 8 марта, 2016 Автор Поделиться Опубликовано 8 марта, 2016 Блин... 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 sviat9440 Опубликовано 8 марта, 2016 Автор Поделиться Опубликовано 8 марта, 2016 Может в листбоксе проблема? Цитата Ссылка на комментарий
0 sviat9440 Опубликовано 8 марта, 2016 Автор Поделиться Опубликовано 8 марта, 2016 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 sviat9440 Опубликовано 8 марта, 2016 Автор Поделиться Опубликовано 8 марта, 2016 Хотя иногда встречается проблемы но не так часто... Цитата Ссылка на комментарий
0 sviat9440 Опубликовано 8 марта, 2016 Автор Поделиться Опубликовано 8 марта, 2016 Кажется понял: Когда я гружу имг из локалхост, то глючит, а когда с сервера то вроде все ок. Есть ли в TIdHTTP возможность ограничения скорости скачивания? Цитата Ссылка на комментарий
0 Модераторы Равиль Зарипов (ZuBy) Опубликовано 8 марта, 2016 Модераторы Поделиться Опубликовано 8 марта, 2016 Блин... 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 sviat9440 Опубликовано 8 марта, 2016 Автор Поделиться Опубликовано 8 марта, 2016 Во, уже количество неккоректных загрузок сократилось в разы... Цитата Ссылка на комментарий
0 sviat9440 Опубликовано 8 марта, 2016 Автор Поделиться Опубликовано 8 марта, 2016 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; Вот кое что написал. Вопрос: Почему у меня так: Цитата Ссылка на комментарий
0 sviat9440 Опубликовано 8 марта, 2016 Автор Поделиться Опубликовано 8 марта, 2016 Фото не грузятся вообще. Но если я вместо 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 sviat9440 Опубликовано 8 марта, 2016 Автор Поделиться Опубликовано 8 марта, 2016 Проблема с отрисовкой была из за потока. Я в потоке создавал итемы. Ну блин, не одно так другое. Че теперь делать? Цитата Ссылка на комментарий
0 sviat9440 Опубликовано 8 марта, 2016 Автор Поделиться Опубликовано 8 марта, 2016 Еще одна деталь: 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 krapotkin Опубликовано 8 марта, 2016 Поделиться Опубликовано 8 марта, 2016 почему в потоке создаются визуальные элементы? (listItem) в потоке создавайте нормальную модель данных потом уже мухой, по модели заполните свой list Цитата Ссылка на комментарий
0 sviat9440 Опубликовано 9 марта, 2016 Автор Поделиться Опубликовано 9 марта, 2016 С созданием элементов в потоке нет проблем, проблема с отрисовкой элемента после изменения его из потока. Цитата Ссылка на комментарий
0 sviat9440 Опубликовано 9 марта, 2016 Автор Поделиться Опубликовано 9 марта, 2016 Тоесть элемент создается нормально, и отокбражается корректно, но если текст, фото, и пр. будут изменены из еще одного потока, то это не отрисуется до клика по объекту. Цитата Ссылка на комментарий
Вопрос
sviat9440
Всем привет. Есть такая проблема:
Вот код потока:
В общем он должен загружать с сервера список итемов и заливать их в лист бокс.
Проблема в том что не всегда итемы в листбоксе отображаются корректно.
Если я вместо sleep(100) (закомментирован), поставлю ShowMessage('dd');, то все отрисовается корректно.
Ниже прилагаю скрины как оно может быть отрисовано.
Надеюсь на вашу поддержку))))
Ссылка на комментарий
Лучшие авторы в вопросе
6
3
3
35
Популярные дни
8 март
24
2 июнь
9
17 март
4
9 март
4
Лучшие авторы в вопросе
Равиль Зарипов (ZuBy) 6 постов
krapotkin 3 постов
Евгений Корепов 3 постов
sviat9440 35 постов
Популярные дни
8 март 2016
24 постов
2 июнь 2016
9 постов
17 март 2016
4 постов
9 март 2016
4 постов
Популярные посты
Евгений Корепов
Накидал примерный проект для корректной работы с потоками. Создаем поток, в который с помощью очереди закидываем задания и в таймере получаем результат выполнения. Вместо изжившего себя TIdHTTP, испол
Brovin Yaroslav
Так, я поясню. Нельзя работать с UI компонентами в не главном UI потоке. Отсюда у вас и ошибки через раз. Банально по причине того, что когда вы изменяете состояние UI компонента, это может при
Евгений Корепов
В приведенном коде процедура FormCreate: procedure TFormMain.FormCreate(Sender: TObject); begin Timer.Interval:=10; Хотя такой короткий не нужен для большинства случаев.
Изображения в теме
51 ответ на этот вопрос
Рекомендуемые сообщения
Присоединяйтесь к обсуждению
Вы можете написать сейчас и зарегистрироваться позже. Если у вас есть аккаунт, авторизуйтесь, чтобы опубликовать от имени своего аккаунта.