Перейти к содержанию
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
  • Модераторы

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

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

Решил эту проблему так: В потоке загружаются изображения и сохраняются в кэш. В OnPaint идет проверка существования файла в кэше, и загрузка его в лист бокс итем.

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

Снова всем привет. Вопрос не тот что был в начале но в тему:

Дело в непонятно откуда берущихся багах. Я не могу отследить определенную закономерность их появления, не могу понять из-за чего они. В режиме отладки перекидывает на некию юнит, в котором мне запомнилось частое фигурирование слова "Canvas" или чтото в этом роде.

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

Текст сообщения с ошибкой: "Access violation at adress 00000000 in module 'Lotus.exe'. Read of adress 00000000."

 

Есть подозрения на баг компилятора. Пока ничем доказать не могу. Кто нибудь сталкивался?

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

что за код находится в обработчиках OnClick этих кнопок?

Цитата

Есть подозрения на баг компилятора. Пока ничем доказать не могу. Кто нибудь сталкивался?

есть подозрение что программист делает не то)

 

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

Так, я поясню. Нельзя работать с UI компонентами в не главном UI потоке. Отсюда у вас и ошибки через раз. Банально по причине того, что когда вы изменяете состояние UI компонента, это может привести к перерисовке. А в свою очередь процесс отрисовки может наложиться с очередной работой с этим компонентом из другого потока. Отсюда всякие AV в главной процедуре отрисовки.

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

Накидал примерный проект для корректной работы с потоками. Создаем поток, в который с помощью очереди закидываем задания и в таймере получаем результат выполнения. Вместо изжившего себя TIdHTTP, использовал THTTPClient (вдруг вам понадобится, к примеру, запускать это приложение на 6 андроиде и обращаться по https - Indy такое уже не сможет).

Код юнита с потоком:

unit UnitGetHttpThread;

interface

uses
  classes,
  SysUtils,
  System.Generics.Collections,
  System.SyncObjs,
  System.Net.HttpClient;

type
  THTTPRec=record
    Command : String;
    Query : String;
    ErrorMsg : String;
    ErrorCode : Integer;
    Page : String;
    Stream : TMemoryStream;
    ItemImageIndex : Integer;
  end;

  THTTPThread=class(TThread)
  private
    FQueueRequest: TThreadedQueue<THTTPRec>;
    FQueueResult: TThreadedQueue<THTTPRec>;
    FHTTPRec: THTTPRec;
    function GetHTTP(AHTTPRec: THTTPRec) : THTTPRec;
  protected
    HTTPClient: THTTPClient;
    procedure Execute; override;
  public
    constructor Create(AQueueRequest, AQueueResult : TThreadedQueue<THTTPRec>);
    destructor Destroy; override;
  end;

implementation

constructor THTTPThread.Create(AQueueRequest, AQueueResult : TThreadedQueue<THTTPRec>);
begin
  FreeOnTerminate:=False;
  FQueueRequest:=AQueueRequest;
  FQueueResult:=AQueueResult;
  HTTPClient:=THTTPClient.Create;
  Inherited Create(FALSE);
end;

destructor THTTPThread.Destroy;
begin
  HTTPClient.Free;
  inherited Destroy;
end;

procedure THTTPThread.Execute;
begin
  while Not Terminated do
    if FQueueRequest.PopItem(FHTTPRec) = TWaitResult.wrSignaled Then
    begin
      if FHTTPRec.Command.Equals('stop') then
      begin
        FHTTPRec.ErrorCode:=200;
        FHTTPRec.ErrorMsg:='Ok';
        FQueueResult.PushItem(FHTTPRec);
        Continue;
      end;
      FHTTPRec.ErrorCode:=0;
      FHTTPRec.ErrorMsg:='';
      FHTTPRec:=GetHTTP(FHTTPRec);
      if Not FHTTPRec.Command.Equals('error') then
        FQueueResult.PushItem(FHTTPRec);
    end;
end;

function THTTPThread.GetHTTP(AHTTPRec: THTTPRec) : THTTPRec;
Var HTTPResponse: IHTTPResponse;
begin
  try
    if AHTTPRec.Command.Equals('image') then
    begin
      HTTPResponse:=HTTPClient.Get(AHTTPRec.Query,AHTTPRec.Stream);
      AHTTPRec.ErrorCode:=HTTPResponse.StatusCode;
      AHTTPRec.ErrorMsg:=HTTPResponse.StatusText;
    end
    Else
    begin
      HTTPResponse:=HTTPClient.Get(AHTTPRec.Query);
      AHTTPRec.Page:=HTTPResponse.ContentAsString;
      AHTTPRec.ErrorCode:=HTTPResponse.StatusCode;
      AHTTPRec.ErrorMsg:=HTTPResponse.StatusText;
    end;
  except
    AHTTPRec.ErrorCode:=-1;
    AHTTPRec.ErrorMsg:='ErrorGetURL';
  end;
  Result:=AHTTPRec;
end;

end.

Код основной формы (основного потока):

unit UnitFormMain;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
  System.Generics.Collections,
  UnitGetHttpThread, FMX.Layouts, FMX.ListBox,
  System.JSON;

type
  TFormMain = class(TForm)
    MainContentDownloadBaseListBox: TListBox;
    Timer: TTimer;
    procedure TimerTimer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    FQueueRequest: TThreadedQueue<THTTPRec>;
    FQueueResult: TThreadedQueue<THTTPRec>;
    HTTPThread : THTTPThread;
  public
    { Public declarations }
    procedure GetHTTP(ACommand : String; AListItemIndex : Integer; BaseID : String);
    procedure FillListBoxImage(AHTTPRec : THTTPRec);
    procedure FillListBoxItem(AHTTPRec : THTTPRec);
  end;

var
  FormMain: TFormMain;

implementation

{$R *.fmx}

procedure TFormMain.FormCreate(Sender: TObject);
begin
  Timer.Interval:=10;
  FQueueRequest:=TThreadedQueue<THTTPRec>.Create(50, 1000, 10);
  FQueueResult:=TThreadedQueue<THTTPRec>.Create(50, 1000, 10);
  HTTPThread:=THTTPThread.Create(FQueueRequest,FQueueResult);

  GetHTTP('json', -1, ''); // запускаем карусель
end;

procedure TFormMain.TimerTimer(Sender: TObject);
Var FHTTPRec : THTTPRec;
begin
  while FQueueResult.PopItem(FHTTPRec) = TWaitResult.wrSignaled do
  begin
    if FHTTPRec.ErrorCode=200 then
    begin
      if FHTTPRec.Command.Equals('json') then
        FillListBoxItem(FHTTPRec);
      if FHTTPRec.Command.Equals('image') then
        FillListBoxImage(FHTTPRec);
      if FHTTPRec.Command.Equals('stop') then
      begin
        Timer.Enabled:=False;
//        AniIndicator.Visible:=False;
//        AniIndicator.Enabled:=False;
      end;
    end
    Else
    begin
      Timer.Enabled:=False;
//      AniIndicator.Visible:=False;
//      AniIndicator.Enabled:=False;
//      LabelTitle.Text:='Не удалось получить данные, проверьте подключение к Интернет.';
    end;
  end;
end;

procedure TFormMain.FillListBoxItem(AHTTPRec : THTTPRec);
Var JSON : TJSONObject;
    I : Integer;
    BaseName, BaseCaption, BaseCategory, BaseID, BaseData: String;
    Item, ItemRadio: TListBoxItem;
begin
    JSON := TJSONObject.ParseJSONValue(AHTTPRec.Page) as TJSONObject;
    if Not Assigned(JSON) then
      Exit;
    for I:=0 To JSON.Count-1 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;
GetHTTP('image', Item.Index, BaseID); // отсылаем в поток запрос на скачивание картинки
        MainContentDownloadBaseListBox.AddObject(Item);
      End;
    End;
  GetHTTP('stop', -1, '');
end;

procedure TFormMain.FillListBoxImage(AHTTPRec : THTTPRec);
begin
  MainContentDownloadBaseListBox.ListItems[AHTTPRec.ItemImageIndex].ItemData.Bitmap.LoadFromStream(AHTTPRec.Stream);
end;

procedure TFormMain.GetHTTP(ACommand : String; AListItemIndex : Integer; BaseID : String);
Var FHTTPRec : THTTPRec;
begin
  FHTTPRec.Page:='';
  Timer.Enabled:=True;
  if ACommand='stop' then
  begin
    FHTTPRec.Command:='stop';
    FQueueRequest.PushItem(FHTTPRec);
  end;
  if ACommand='json' then
  begin
    FHTTPRec.Command:=ACommand;
    FHTTPRec.Query:='https://ссылка получения json';
    FQueueRequest.PushItem(FHTTPRec);
  end;
  if ACommand='image' then
  begin
    FHTTPRec.Command:=ACommand;
    FHTTPRec.Query:='https://ссылка получения картинки'+BaseID;
    FHTTPRec.ItemImageIndex:=AListItemIndex;
    FHTTPRec.Stream:=TMemoryStream.Create;
    FQueueRequest.PushItem(FHTTPRec);
  end;
end;
      
end.

Одним потоком забираем все что нужно из сети - и json данные и картинки, ну и все что еще прикрутите.

Изменено пользователем Евгений Корепов
Нашел ошибку в коде, исправил.
Ссылка на комментарий
  • 0
4 часа назад, Rusland сказал:

Евгений Корепов, чему равен интервал таймера?

В приведенном коде процедура FormCreate:

procedure TFormMain.FormCreate(Sender: TObject);
begin
  Timer.Interval:=10;

Хотя такой короткий не нужен для большинства случаев.

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

Ухты. За TNetHTTPClient благодарствую. Как то не обращал на него внимания. долго мучался с проблемой подключения к серверу по https. На некоторых работает а на некоторых нет. С этим компонентом все вроде работает. Благодарю. А за карусель я и сам догадался. Вопрос был поставлен почему оно криво отрисовывается из потока. Причину этого вы мне доступно объяснили. За это тоже спасибо. Буду искать обходные пути.

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

Да и кстати: В Берлине если из потока обратиться к копоненту TChangeTabAction методом execute то выстреливает ошибка Invalid class typecast. Эта ошибка не отлавливается структурой try except, а выскакивает поверх сообщением с ошибкой. Напомню что в предыдущей версии абракадабры, этого не было. Еще одной особенностью этого является то, что сам экшн выполняется. И после его выполнения вылазит ошибка.

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

кстати, проблема с отрисовкой из потока касается только растровых изображений. все остальное отрисовывается вполне корректно. а вообще вопрос не верный. проблема не с отрисовкой битмапа из потока, а с загрузкой битмапа из потока. Отрисовывает поток все верно, как надо, но не может корректно загрузить векторное изображение в обьект. Это подтверждается моими экспериментами.

Ход работы:

Я создал поток для загрузки n-ого кол-ва битмапов в TVertScrollBox. При добавлении битмапа в список, я установил в событие onClick в битмапе процедуру, которая открывает модальную форму, на которой существует только один битмап. В качестве объекта для него использовал TRectangle.

procedure onClick(Sender: TObject);
Begin
	Form2.Rectangle1.Fill.Bitmap.Bitmap := TRectangle(Sender).Fill.Bitmap.Bitmap;
	Form2.Show.
End;

Итог: появляется форма с точной копией изображения по которому кликали. Что интересно: Если оно не правильно "отрисовалось" из потока, то оно будет таким же на второй форме

Вывод: Проблема не с отрисовкой из потока, а с загрузкой растрового изображения в TBitmap из потока.

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

хех. Мало ли что писали. Вопрос в том: читал ли я все это? :-) Правильно: нет. ))

 

P.S. Говоря точнее я даже не знал о существовании этих статей.

Изменено пользователем sviat
Ссылка на комментарий
  • 0
В 01.06.2016 в 13:27, sviat сказал:

Да и кстати: В Берлине если из потока обратиться к копоненту TChangeTabAction методом execute то выстреливает ошибка Invalid class typecast. Эта ошибка не отлавливается структурой try except, а выскакивает поверх сообщением с ошибкой. Напомню что в предыдущей версии абракадабры, этого не было. Еще одной особенностью этого является то, что сам экшн выполняется. И после его выполнения вылазит ошибка.

Что вы думаете по этому поводу?

Ссылка на комментарий
  • 0
3 часа назад, sviat сказал:

Что вы думаете по этому поводу?

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

Такое ощущение что вы не слышите, или не читаете ответы на заданные вами вопросы, и каждое новое сообщение от вас звучит примерно так "А вот если я на эти грабли не наступлю, а с разбега прыгну, что будет?" ;-) 

Надеюсь я не слишком эмоционально высказался? Не хотел никого обидеть.

Изменено пользователем Евгений Корепов
Ссылка на комментарий

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

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

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

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

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

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

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

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

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

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

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