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

Евгений (KeeperWorld)

Пользователи
  • Постов

    2
  • Зарегистрирован

  • Посещение

  • Победитель дней

    2

Активность репутации

  1. Like
    Евгений (KeeperWorld) отреагировална Равиль Зарипов (ZuBy) в ListView Color Helper   
    Привет Всем!
    Много тем на форуме про раскраску TListView, нашел в интернете решение и доработал его
    Вот что получилось
       
    LV_Helper.zip                                                                  ColorListView.zip
    Доступно для Seattle
    ListView1.SetColorItemSelected(TAlphaColorRec.Orangered); //выделенный ListView1.SetColorItemFill(TAlphaColorRec.Gray); // обычный цвет Item ListView1.SetColorItemFillAlt(TAlphaColorRec.Lightgrey); // альтернативный цвет Item ListView1.SetColorBackground(TAlphaColorRec.Black); // цвет самого TListView ListView1.SetColorItemSeparator(TAlphaColorRec.Lightgray); // Линия разделения Item'ов ListView1.SetColorText(TAlphaColorRec.Red); // Обычный текст ListView1.SetColorTextSelected(TAlphaColorRec.White); // выделенный текст ListView1.SetColorTextDetail(TAlphaColorRec.Yellow); // текст доп. инфы ListView1.SetColorTextHeader(TAlphaColorRec.Green); // текст заголовка ListView1.SetColorTextHeaderShadow(TAlphaColorRec.Lightgray); // тень текста   ListView1.SetColorButtonText(TAlphaColorRec.Orange); // цвет текста кнопки   ListView1.SetColorButtonTextPressed(TAlphaColorRec.Orangered); // цвет нажатой кнопки добавлено в Berlin
    ListView1.SetColorPullRefresh(TAlphaColorRec.Orange); ListView1.SetColorPullRefreshIndicator(TAlphaColorRec.Orangered); ListView1.SetColorStretchGlow(TAlphaColorRec.Lime); ModernListView.rar
  2. Like
    Евгений (KeeperWorld) получил реакцию от Евгений Корепов в Отображение картинок в ListView   
    Да там всё Евгений Корепов сделал уже. Я только три копейки своих добавил...
    Вот конечный код:
    unit Unit1; interface uses System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, System.Net.HttpClient, System.Generics.Collections,   FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.ListView.Types, FMX.ListView.Appearances, FMX.ListView.Adapters.Base, FMX.Controls.Presentation, FMX.StdCtrls, FMX.Layouts, FMX.ListView; const ListViewItemImageEmpty = -1; ListViewItemImageLoading = 0; ListViewItemImageLoaded = 1; type TForm1 = class(TForm) ListView1: TListView; Layout1: TLayout; Button1: TButton; procedure Button1Click(Sender: TObject); procedure ListView1UpdatingObjects(const Sender: TObject; const AItem: TListViewItem; var AHandled: Boolean); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); private FListViewUpdating : Boolean; FHTTPClient : THTTPClient; FAsyncResultList : TList<IAsyncResult>; procedure LoadImage(const AItem: TListViewItem; const AListItemImage : TListItemImage); procedure ClearListViewAndCancelAsynchronousRequests(); public end; var Form1: TForm1; implementation {$R *.fmx} procedure TForm1.FormCreate(Sender: TObject); begin listview1.ItemIndex := 0; listview1.ItemAppearance.ItemAppearance := 'Custom'; listview1.ItemAppearanceObjects.ItemObjects.Accessory.Visible := False; FHTTPClient := THTTPClient.Create; FAsyncResultList := TList<IAsyncResult>.Create; FListViewUpdating := False; end; procedure TForm1.FormDestroy(Sender: TObject); begin ClearListViewAndCancelAsynchronousRequests(); FListViewUpdating := True;   FreeAndNil(FAsyncResultList); if Assigned(FHTTPClient) then FHTTPClient.Free; end; procedure TForm1.ClearListViewAndCancelAsynchronousRequests(); var   I: Integer; begin   FListViewUpdating := True; // Запрещаем продолжать загружать фотки (если ещё не успели загрузиться все)   while FAsyncResultList.Count > 0 do  // Дожидаемся окончания выполнения всех IAsyncResult.Cancel, несмотря на асинхронность   begin     for I := FAsyncResultList.Count - 1 downto 0 do       if Assigned(FAsyncResultList.Items) and (not FAsyncResultList.Items.IsCompleted) then         FAsyncResultList.Items.Cancel       else         FAsyncResultList.Delete(I); // Заодно удаляем отработанные элементы   end;   ListView1.Items.Clear;   FListViewUpdating := False; end; procedure TForm1.Button1Click(Sender: TObject); var   I: Integer; Item: TListViewItem; ARandom: Integer; begin ClearListViewAndCancelAsynchronousRequests(); //Формирование нового списка for I := 1 to 10000 do begin FAsyncResultList.Add(nil); FListViewUpdating := True; Item := listview1.Items.Add; Item.Height := 45; Randomize; ARandom := Random(6); case ARandom of 0 : Item.data['ImageURL'] := 'http://fire-monkey.ru/uploads/monthly_2017_06/me.thumb.jpg.966ddc17d5602ee14feb43479c1f6963.jpg'; 1 : Item.data['ImageURL'] := 'http://fire-monkey.ru/uploads/monthly_2018_05/B-IpGQmVgTM.thumb.jpg.2ebeb0bd766ab7cf19f10195d6ea2be9.jpg'; 2 : Item.data['ImageURL'] := 'http://fire-monkey.ru/uploads/monthly_2016_04/10.png.b9ab371e8fd38172fee96bcf75fb6699.thumb.png.b0685259b03bfff540903913845532a5.png'; 3 : Item.data['ImageURL'] := 'https://secure.gravatar.com/avatar/9942c50b1641a921c52d4b389bd718d6?d=http://fire-monkey.ru/uploads/monthly_2017_12/K_member_87.png'; 4 : Item.data['ImageURL'] := 'http://fire-monkey.ru/uploads/monthly_2016_11/photo-1529.png.7267be10b59f950b7c5bb3f34a60901e.thumb.png.22027ae85266216220310ed694d57628.png'; 5 : Item.data['ImageURL'] := 'http://fire-monkey.ru/uploads/profile/photo-thumb-115.jpg'; end; Item.Data['ImageState'] := ListViewItemImageEmpty; FListViewUpdating := False; Item.Adapter.ResetView(Item); end; end; procedure TForm1.LoadImage(const AItem: TListViewItem; const AListItemImage : TListItemImage); var   K: Integer; // Анонимная процедура захватывает локальную переменную, а не обращается к AItem, которой уже может не быть в момент _окончания_ скачивания фотки   AAsyncResult: IAsyncResult; begin   if Not Assigned(AItem) or Not Assigned(AListItemImage) then     Exit;   if AItem.Data['ImageState'].AsInteger <> ListViewItemImageEmpty then     Exit;   if AItem.Data['ImageURL'].AsString.IsEmpty then     Exit;   AItem.Data['ImageState'] := ListViewItemImageLoading;   K := AItem.Index; // Запоминаем индекс в локальную K, которая уйдёт в анонимку (время жизни K > времени жизни анонимки)   FAsyncResultList.Items[K] := FHTTPClient.BeginGet(     procedure (const ASyncResult: IAsyncResult)     var       AHTTPResponse: IHTTPResponse;     begin       if ASyncResult.IsCancelled then         Exit;       try         AHTTPResponse := THTTPClient.EndAsyncHTTP(ASyncResult);         if Not Assigned(AHTTPResponse) then           Exit;         if AHTTPResponse.StatusCode <> 200 then           Exit;       except         Exit;       end;       TThread.Synchronize(Nil,         procedure         begin           if FListViewUpdating or ASyncResult.IsCancelled then // Выходим, так как внутри анонимной процедуры AItem или AListItemImage - не сброшены в nil, хотя их уже может и не быть             Exit;           if Not Assigned(AItem) or Not Assigned(AListItemImage) then             Exit;           AListItemImage.BeginUpdate;           AListItemImage.Bitmap := TBitmap.Create;           AListItemImage.Bitmap.LoadFromStream(AHTTPResponse.ContentStream);           AListItemImage.EndUpdate;           AItem.Data['ImageState'] := ListViewItemImageLoaded;           FAsyncResultList.Items[K] := nil;         end       );     end,     AItem.Data['ImageURL'].AsString   ); end; procedure TForm1.ListView1UpdatingObjects(const Sender: TObject; const AItem: TListViewItem; var AHandled: Boolean); function SetupImageObject(const AName: String; AWidth, AHeight, X , Y: Single; AAlign, AVertAlign: TListItemAlign): TListItemImage;   var     LIT: TListItemText; begin Result := TListItemImage(AItem.View.FindDrawable(AName)); if Result = Nil then begin   // Создаём картинку Result := TListItemImage.Create(AItem); Result.Name := AName; Result.Bitmap := nil; Result.OwnsBitmap := True;   // Создаём надпись       LIT := TListItemText.Create(AItem);       LIT.Name := 'LIT-' + AItem.Index.ToString;       LIT.Width := 100;       LIT.Height := 22;       LIT.PlaceOffset.X := X + AWidth + 10;       LIT.PlaceOffset.Y := Y;       LIT.Text := LIT.Name;       LIT.Visible := True; end; Result.Width := AWidth; Result.Height := AHeight; Result.PlaceOffset.X := X; Result.PlaceOffset.Y := Y; Result.Align := AAlign; Result.VertAlign := AVertAlign; Result.ScalingMode := TImageScalingMode.StretchWithAspect; Result.Visible := True; end; Var   AListItemImage: TListItemImage; begin if FListViewUpdating then Exit; AListItemImage := SetupImageObject('s_image', 35, 35, 0 , 0, TListitemalign.Leading, TListItemAlign.Center); LoadImage(AItem, AListItemImage); AHandled := True; end; end.  
  3. Like
    Евгений (KeeperWorld) получил реакцию от krapotkin в Отображение картинок в ListView   
    Да там всё Евгений Корепов сделал уже. Я только три копейки своих добавил...
    Вот конечный код:
    unit Unit1; interface uses System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, System.Net.HttpClient, System.Generics.Collections,   FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.ListView.Types, FMX.ListView.Appearances, FMX.ListView.Adapters.Base, FMX.Controls.Presentation, FMX.StdCtrls, FMX.Layouts, FMX.ListView; const ListViewItemImageEmpty = -1; ListViewItemImageLoading = 0; ListViewItemImageLoaded = 1; type TForm1 = class(TForm) ListView1: TListView; Layout1: TLayout; Button1: TButton; procedure Button1Click(Sender: TObject); procedure ListView1UpdatingObjects(const Sender: TObject; const AItem: TListViewItem; var AHandled: Boolean); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); private FListViewUpdating : Boolean; FHTTPClient : THTTPClient; FAsyncResultList : TList<IAsyncResult>; procedure LoadImage(const AItem: TListViewItem; const AListItemImage : TListItemImage); procedure ClearListViewAndCancelAsynchronousRequests(); public end; var Form1: TForm1; implementation {$R *.fmx} procedure TForm1.FormCreate(Sender: TObject); begin listview1.ItemIndex := 0; listview1.ItemAppearance.ItemAppearance := 'Custom'; listview1.ItemAppearanceObjects.ItemObjects.Accessory.Visible := False; FHTTPClient := THTTPClient.Create; FAsyncResultList := TList<IAsyncResult>.Create; FListViewUpdating := False; end; procedure TForm1.FormDestroy(Sender: TObject); begin ClearListViewAndCancelAsynchronousRequests(); FListViewUpdating := True;   FreeAndNil(FAsyncResultList); if Assigned(FHTTPClient) then FHTTPClient.Free; end; procedure TForm1.ClearListViewAndCancelAsynchronousRequests(); var   I: Integer; begin   FListViewUpdating := True; // Запрещаем продолжать загружать фотки (если ещё не успели загрузиться все)   while FAsyncResultList.Count > 0 do  // Дожидаемся окончания выполнения всех IAsyncResult.Cancel, несмотря на асинхронность   begin     for I := FAsyncResultList.Count - 1 downto 0 do       if Assigned(FAsyncResultList.Items) and (not FAsyncResultList.Items.IsCompleted) then         FAsyncResultList.Items.Cancel       else         FAsyncResultList.Delete(I); // Заодно удаляем отработанные элементы   end;   ListView1.Items.Clear;   FListViewUpdating := False; end; procedure TForm1.Button1Click(Sender: TObject); var   I: Integer; Item: TListViewItem; ARandom: Integer; begin ClearListViewAndCancelAsynchronousRequests(); //Формирование нового списка for I := 1 to 10000 do begin FAsyncResultList.Add(nil); FListViewUpdating := True; Item := listview1.Items.Add; Item.Height := 45; Randomize; ARandom := Random(6); case ARandom of 0 : Item.data['ImageURL'] := 'http://fire-monkey.ru/uploads/monthly_2017_06/me.thumb.jpg.966ddc17d5602ee14feb43479c1f6963.jpg'; 1 : Item.data['ImageURL'] := 'http://fire-monkey.ru/uploads/monthly_2018_05/B-IpGQmVgTM.thumb.jpg.2ebeb0bd766ab7cf19f10195d6ea2be9.jpg'; 2 : Item.data['ImageURL'] := 'http://fire-monkey.ru/uploads/monthly_2016_04/10.png.b9ab371e8fd38172fee96bcf75fb6699.thumb.png.b0685259b03bfff540903913845532a5.png'; 3 : Item.data['ImageURL'] := 'https://secure.gravatar.com/avatar/9942c50b1641a921c52d4b389bd718d6?d=http://fire-monkey.ru/uploads/monthly_2017_12/K_member_87.png'; 4 : Item.data['ImageURL'] := 'http://fire-monkey.ru/uploads/monthly_2016_11/photo-1529.png.7267be10b59f950b7c5bb3f34a60901e.thumb.png.22027ae85266216220310ed694d57628.png'; 5 : Item.data['ImageURL'] := 'http://fire-monkey.ru/uploads/profile/photo-thumb-115.jpg'; end; Item.Data['ImageState'] := ListViewItemImageEmpty; FListViewUpdating := False; Item.Adapter.ResetView(Item); end; end; procedure TForm1.LoadImage(const AItem: TListViewItem; const AListItemImage : TListItemImage); var   K: Integer; // Анонимная процедура захватывает локальную переменную, а не обращается к AItem, которой уже может не быть в момент _окончания_ скачивания фотки   AAsyncResult: IAsyncResult; begin   if Not Assigned(AItem) or Not Assigned(AListItemImage) then     Exit;   if AItem.Data['ImageState'].AsInteger <> ListViewItemImageEmpty then     Exit;   if AItem.Data['ImageURL'].AsString.IsEmpty then     Exit;   AItem.Data['ImageState'] := ListViewItemImageLoading;   K := AItem.Index; // Запоминаем индекс в локальную K, которая уйдёт в анонимку (время жизни K > времени жизни анонимки)   FAsyncResultList.Items[K] := FHTTPClient.BeginGet(     procedure (const ASyncResult: IAsyncResult)     var       AHTTPResponse: IHTTPResponse;     begin       if ASyncResult.IsCancelled then         Exit;       try         AHTTPResponse := THTTPClient.EndAsyncHTTP(ASyncResult);         if Not Assigned(AHTTPResponse) then           Exit;         if AHTTPResponse.StatusCode <> 200 then           Exit;       except         Exit;       end;       TThread.Synchronize(Nil,         procedure         begin           if FListViewUpdating or ASyncResult.IsCancelled then // Выходим, так как внутри анонимной процедуры AItem или AListItemImage - не сброшены в nil, хотя их уже может и не быть             Exit;           if Not Assigned(AItem) or Not Assigned(AListItemImage) then             Exit;           AListItemImage.BeginUpdate;           AListItemImage.Bitmap := TBitmap.Create;           AListItemImage.Bitmap.LoadFromStream(AHTTPResponse.ContentStream);           AListItemImage.EndUpdate;           AItem.Data['ImageState'] := ListViewItemImageLoaded;           FAsyncResultList.Items[K] := nil;         end       );     end,     AItem.Data['ImageURL'].AsString   ); end; procedure TForm1.ListView1UpdatingObjects(const Sender: TObject; const AItem: TListViewItem; var AHandled: Boolean); function SetupImageObject(const AName: String; AWidth, AHeight, X , Y: Single; AAlign, AVertAlign: TListItemAlign): TListItemImage;   var     LIT: TListItemText; begin Result := TListItemImage(AItem.View.FindDrawable(AName)); if Result = Nil then begin   // Создаём картинку Result := TListItemImage.Create(AItem); Result.Name := AName; Result.Bitmap := nil; Result.OwnsBitmap := True;   // Создаём надпись       LIT := TListItemText.Create(AItem);       LIT.Name := 'LIT-' + AItem.Index.ToString;       LIT.Width := 100;       LIT.Height := 22;       LIT.PlaceOffset.X := X + AWidth + 10;       LIT.PlaceOffset.Y := Y;       LIT.Text := LIT.Name;       LIT.Visible := True; end; Result.Width := AWidth; Result.Height := AHeight; Result.PlaceOffset.X := X; Result.PlaceOffset.Y := Y; Result.Align := AAlign; Result.VertAlign := AVertAlign; Result.ScalingMode := TImageScalingMode.StretchWithAspect; Result.Visible := True; end; Var   AListItemImage: TListItemImage; begin if FListViewUpdating then Exit; AListItemImage := SetupImageObject('s_image', 35, 35, 0 , 0, TListitemalign.Leading, TListItemAlign.Center); LoadImage(AItem, AListItemImage); AHandled := True; end; end.  
  4. Like
    Евгений (KeeperWorld) получил реакцию от #WAMACO в Отображение картинок в ListView   
    Да там всё Евгений Корепов сделал уже. Я только три копейки своих добавил...
    Вот конечный код:
    unit Unit1; interface uses System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, System.Net.HttpClient, System.Generics.Collections,   FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.ListView.Types, FMX.ListView.Appearances, FMX.ListView.Adapters.Base, FMX.Controls.Presentation, FMX.StdCtrls, FMX.Layouts, FMX.ListView; const ListViewItemImageEmpty = -1; ListViewItemImageLoading = 0; ListViewItemImageLoaded = 1; type TForm1 = class(TForm) ListView1: TListView; Layout1: TLayout; Button1: TButton; procedure Button1Click(Sender: TObject); procedure ListView1UpdatingObjects(const Sender: TObject; const AItem: TListViewItem; var AHandled: Boolean); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); private FListViewUpdating : Boolean; FHTTPClient : THTTPClient; FAsyncResultList : TList<IAsyncResult>; procedure LoadImage(const AItem: TListViewItem; const AListItemImage : TListItemImage); procedure ClearListViewAndCancelAsynchronousRequests(); public end; var Form1: TForm1; implementation {$R *.fmx} procedure TForm1.FormCreate(Sender: TObject); begin listview1.ItemIndex := 0; listview1.ItemAppearance.ItemAppearance := 'Custom'; listview1.ItemAppearanceObjects.ItemObjects.Accessory.Visible := False; FHTTPClient := THTTPClient.Create; FAsyncResultList := TList<IAsyncResult>.Create; FListViewUpdating := False; end; procedure TForm1.FormDestroy(Sender: TObject); begin ClearListViewAndCancelAsynchronousRequests(); FListViewUpdating := True;   FreeAndNil(FAsyncResultList); if Assigned(FHTTPClient) then FHTTPClient.Free; end; procedure TForm1.ClearListViewAndCancelAsynchronousRequests(); var   I: Integer; begin   FListViewUpdating := True; // Запрещаем продолжать загружать фотки (если ещё не успели загрузиться все)   while FAsyncResultList.Count > 0 do  // Дожидаемся окончания выполнения всех IAsyncResult.Cancel, несмотря на асинхронность   begin     for I := FAsyncResultList.Count - 1 downto 0 do       if Assigned(FAsyncResultList.Items) and (not FAsyncResultList.Items.IsCompleted) then         FAsyncResultList.Items.Cancel       else         FAsyncResultList.Delete(I); // Заодно удаляем отработанные элементы   end;   ListView1.Items.Clear;   FListViewUpdating := False; end; procedure TForm1.Button1Click(Sender: TObject); var   I: Integer; Item: TListViewItem; ARandom: Integer; begin ClearListViewAndCancelAsynchronousRequests(); //Формирование нового списка for I := 1 to 10000 do begin FAsyncResultList.Add(nil); FListViewUpdating := True; Item := listview1.Items.Add; Item.Height := 45; Randomize; ARandom := Random(6); case ARandom of 0 : Item.data['ImageURL'] := 'http://fire-monkey.ru/uploads/monthly_2017_06/me.thumb.jpg.966ddc17d5602ee14feb43479c1f6963.jpg'; 1 : Item.data['ImageURL'] := 'http://fire-monkey.ru/uploads/monthly_2018_05/B-IpGQmVgTM.thumb.jpg.2ebeb0bd766ab7cf19f10195d6ea2be9.jpg'; 2 : Item.data['ImageURL'] := 'http://fire-monkey.ru/uploads/monthly_2016_04/10.png.b9ab371e8fd38172fee96bcf75fb6699.thumb.png.b0685259b03bfff540903913845532a5.png'; 3 : Item.data['ImageURL'] := 'https://secure.gravatar.com/avatar/9942c50b1641a921c52d4b389bd718d6?d=http://fire-monkey.ru/uploads/monthly_2017_12/K_member_87.png'; 4 : Item.data['ImageURL'] := 'http://fire-monkey.ru/uploads/monthly_2016_11/photo-1529.png.7267be10b59f950b7c5bb3f34a60901e.thumb.png.22027ae85266216220310ed694d57628.png'; 5 : Item.data['ImageURL'] := 'http://fire-monkey.ru/uploads/profile/photo-thumb-115.jpg'; end; Item.Data['ImageState'] := ListViewItemImageEmpty; FListViewUpdating := False; Item.Adapter.ResetView(Item); end; end; procedure TForm1.LoadImage(const AItem: TListViewItem; const AListItemImage : TListItemImage); var   K: Integer; // Анонимная процедура захватывает локальную переменную, а не обращается к AItem, которой уже может не быть в момент _окончания_ скачивания фотки   AAsyncResult: IAsyncResult; begin   if Not Assigned(AItem) or Not Assigned(AListItemImage) then     Exit;   if AItem.Data['ImageState'].AsInteger <> ListViewItemImageEmpty then     Exit;   if AItem.Data['ImageURL'].AsString.IsEmpty then     Exit;   AItem.Data['ImageState'] := ListViewItemImageLoading;   K := AItem.Index; // Запоминаем индекс в локальную K, которая уйдёт в анонимку (время жизни K > времени жизни анонимки)   FAsyncResultList.Items[K] := FHTTPClient.BeginGet(     procedure (const ASyncResult: IAsyncResult)     var       AHTTPResponse: IHTTPResponse;     begin       if ASyncResult.IsCancelled then         Exit;       try         AHTTPResponse := THTTPClient.EndAsyncHTTP(ASyncResult);         if Not Assigned(AHTTPResponse) then           Exit;         if AHTTPResponse.StatusCode <> 200 then           Exit;       except         Exit;       end;       TThread.Synchronize(Nil,         procedure         begin           if FListViewUpdating or ASyncResult.IsCancelled then // Выходим, так как внутри анонимной процедуры AItem или AListItemImage - не сброшены в nil, хотя их уже может и не быть             Exit;           if Not Assigned(AItem) or Not Assigned(AListItemImage) then             Exit;           AListItemImage.BeginUpdate;           AListItemImage.Bitmap := TBitmap.Create;           AListItemImage.Bitmap.LoadFromStream(AHTTPResponse.ContentStream);           AListItemImage.EndUpdate;           AItem.Data['ImageState'] := ListViewItemImageLoaded;           FAsyncResultList.Items[K] := nil;         end       );     end,     AItem.Data['ImageURL'].AsString   ); end; procedure TForm1.ListView1UpdatingObjects(const Sender: TObject; const AItem: TListViewItem; var AHandled: Boolean); function SetupImageObject(const AName: String; AWidth, AHeight, X , Y: Single; AAlign, AVertAlign: TListItemAlign): TListItemImage;   var     LIT: TListItemText; begin Result := TListItemImage(AItem.View.FindDrawable(AName)); if Result = Nil then begin   // Создаём картинку Result := TListItemImage.Create(AItem); Result.Name := AName; Result.Bitmap := nil; Result.OwnsBitmap := True;   // Создаём надпись       LIT := TListItemText.Create(AItem);       LIT.Name := 'LIT-' + AItem.Index.ToString;       LIT.Width := 100;       LIT.Height := 22;       LIT.PlaceOffset.X := X + AWidth + 10;       LIT.PlaceOffset.Y := Y;       LIT.Text := LIT.Name;       LIT.Visible := True; end; Result.Width := AWidth; Result.Height := AHeight; Result.PlaceOffset.X := X; Result.PlaceOffset.Y := Y; Result.Align := AAlign; Result.VertAlign := AVertAlign; Result.ScalingMode := TImageScalingMode.StretchWithAspect; Result.Visible := True; end; Var   AListItemImage: TListItemImage; begin if FListViewUpdating then Exit; AListItemImage := SetupImageObject('s_image', 35, 35, 0 , 0, TListitemalign.Leading, TListItemAlign.Center); LoadImage(AItem, AListItemImage); AHandled := True; end; end.  
  5. Like
    Евгений (KeeperWorld) получил реакцию от #WAMACO в Отображение картинок в ListView   
    Евгений, спасибо громадное за код!!! Красиво и лаконично!
    Но под Rio всё равно крэшится с ошибкой, если приложение закрывать раньше, чем успевают загрузиться фотки:
    Project Test21.exe raised exception class ENetHTTPClientException with message 'Error receiving data: (12017) Операция отменена'.
     
    Поправил вот так:
    procedure TForm1.ClearListViewAndCancelAsynchronousRequests();
    var
      I: Integer;
    begin
      FListViewUpdating := True; // Запрещаем продолжать загружать фотки (если ещё не успели загрузиться все)
      while FAsyncResultList.Count > 0 do  // Дожидаемся окончания выполнения всех IAsyncResult.Cancel, несмотря на асинхронность
      begin
        for I := FAsyncResultList.Count - 1 downto 0 do
          if Assigned(FAsyncResultList.Items) and (not FAsyncResultList.Items.IsCompleted) then
            FAsyncResultList.Items.Cancel
          else
            FAsyncResultList.Delete(I); // Заодно удаляем элементы (раннее не удалялись - утечка памяти)
      end;
      ListView1.Items.Clear;
      FListViewUpdating := False;
    end;
     
    =====
    Тоже, кстати, пару раз поймал ошибку в  TMonitor и в TDictionary. 
    Выяснил, что возникает из-за обращения к элементам списка в LoadImage, когда их уже нет. Пофиксил так (отмечено синим):
     
    procedure TForm1.LoadImage(const AItem: TListViewItem; const AListItemImage : TListItemImage);
    var
      K: Integer; // Анонимная процедура захватывает локальную переменную, а не обращается к AItem, которой уже может не быть в момент _окончания_ скачивания фотки
      AAsyncResult: IAsyncResult;
    begin
      if Not Assigned(AItem) or Not Assigned(AListItemImage) then
        Exit;
      if AItem.Data['ImageState'].AsInteger <> ListViewItemImageEmpty then
        Exit;
      if AItem.Data['ImageURL'].AsString.IsEmpty then
        Exit;
      AItem.Data['ImageState'] := ListViewItemImageLoading;
      K := AItem.Index; // Запоминаем индекс в локальную K, которая уйдёт в анонимку (время жизни K > времени жизни анонимки)
      FAsyncResultList.Items[K] := FHTTPClient.BeginGet(
        procedure (const ASyncResult: IAsyncResult)
        var
          AHTTPResponse: IHTTPResponse;
        begin
          if ASyncResult.IsCancelled then
            Exit;
          try
            AHTTPResponse := THTTPClient.EndAsyncHTTP(ASyncResult);
            if Not Assigned(AHTTPResponse) then
              Exit;
            if AHTTPResponse.StatusCode <> 200 then
              Exit;
          except
            Exit;
          end;
          TThread.Synchronize(Nil,
            procedure
            begin
              if FListViewUpdating then // Выходим, так как внутри анонимной процедуры AItem или AListItemImage - не сброшены в nil, хотя их уже может и не быть
                Exit;  // Кстати, наверное, правильнее было бы вместо проверки FListViewUpdating  использовать и/или условие: if ASyncResult.IsCancelled then Exit; ?
              if Not Assigned(AItem) or Not Assigned(AListItemImage) then
                Exit;
              AListItemImage.BeginUpdate;
              AListItemImage.Bitmap := TBitmap.Create;
              AListItemImage.Bitmap.LoadFromStream(AHTTPResponse.ContentStream);
              AListItemImage.EndUpdate;
              AItem.Data['ImageState'] := ListViewItemImageLoaded;
              FAsyncResultList.Items[K] := nil; // Наверное, это присвоение лучше вытащить наверх, перед проверкой всех условий? Ведь фотка скачалась успешно...  Или не надо?
            end
          );
        end,
        AItem.Data['ImageURL'].AsString
      );
    end;
    ====
    Прогонял много раз, клацал по кнопке один и много раз и закрывал сразу приложение, ошибки пока больше не появлялись... Тьфу-тьфу-тьфу....
     
  6. Like
    Евгений (KeeperWorld) получил реакцию от Евгений Корепов в Отображение картинок в ListView   
    Евгений, спасибо громадное за код!!! Красиво и лаконично!
    Но под Rio всё равно крэшится с ошибкой, если приложение закрывать раньше, чем успевают загрузиться фотки:
    Project Test21.exe raised exception class ENetHTTPClientException with message 'Error receiving data: (12017) Операция отменена'.
     
    Поправил вот так:
    procedure TForm1.ClearListViewAndCancelAsynchronousRequests();
    var
      I: Integer;
    begin
      FListViewUpdating := True; // Запрещаем продолжать загружать фотки (если ещё не успели загрузиться все)
      while FAsyncResultList.Count > 0 do  // Дожидаемся окончания выполнения всех IAsyncResult.Cancel, несмотря на асинхронность
      begin
        for I := FAsyncResultList.Count - 1 downto 0 do
          if Assigned(FAsyncResultList.Items) and (not FAsyncResultList.Items.IsCompleted) then
            FAsyncResultList.Items.Cancel
          else
            FAsyncResultList.Delete(I); // Заодно удаляем элементы (раннее не удалялись - утечка памяти)
      end;
      ListView1.Items.Clear;
      FListViewUpdating := False;
    end;
     
    =====
    Тоже, кстати, пару раз поймал ошибку в  TMonitor и в TDictionary. 
    Выяснил, что возникает из-за обращения к элементам списка в LoadImage, когда их уже нет. Пофиксил так (отмечено синим):
     
    procedure TForm1.LoadImage(const AItem: TListViewItem; const AListItemImage : TListItemImage);
    var
      K: Integer; // Анонимная процедура захватывает локальную переменную, а не обращается к AItem, которой уже может не быть в момент _окончания_ скачивания фотки
      AAsyncResult: IAsyncResult;
    begin
      if Not Assigned(AItem) or Not Assigned(AListItemImage) then
        Exit;
      if AItem.Data['ImageState'].AsInteger <> ListViewItemImageEmpty then
        Exit;
      if AItem.Data['ImageURL'].AsString.IsEmpty then
        Exit;
      AItem.Data['ImageState'] := ListViewItemImageLoading;
      K := AItem.Index; // Запоминаем индекс в локальную K, которая уйдёт в анонимку (время жизни K > времени жизни анонимки)
      FAsyncResultList.Items[K] := FHTTPClient.BeginGet(
        procedure (const ASyncResult: IAsyncResult)
        var
          AHTTPResponse: IHTTPResponse;
        begin
          if ASyncResult.IsCancelled then
            Exit;
          try
            AHTTPResponse := THTTPClient.EndAsyncHTTP(ASyncResult);
            if Not Assigned(AHTTPResponse) then
              Exit;
            if AHTTPResponse.StatusCode <> 200 then
              Exit;
          except
            Exit;
          end;
          TThread.Synchronize(Nil,
            procedure
            begin
              if FListViewUpdating then // Выходим, так как внутри анонимной процедуры AItem или AListItemImage - не сброшены в nil, хотя их уже может и не быть
                Exit;  // Кстати, наверное, правильнее было бы вместо проверки FListViewUpdating  использовать и/или условие: if ASyncResult.IsCancelled then Exit; ?
              if Not Assigned(AItem) or Not Assigned(AListItemImage) then
                Exit;
              AListItemImage.BeginUpdate;
              AListItemImage.Bitmap := TBitmap.Create;
              AListItemImage.Bitmap.LoadFromStream(AHTTPResponse.ContentStream);
              AListItemImage.EndUpdate;
              AItem.Data['ImageState'] := ListViewItemImageLoaded;
              FAsyncResultList.Items[K] := nil; // Наверное, это присвоение лучше вытащить наверх, перед проверкой всех условий? Ведь фотка скачалась успешно...  Или не надо?
            end
          );
        end,
        AItem.Data['ImageURL'].AsString
      );
    end;
    ====
    Прогонял много раз, клацал по кнопке один и много раз и закрывал сразу приложение, ошибки пока больше не появлялись... Тьфу-тьфу-тьфу....
     
  7. Like
    Евгений (KeeperWorld) отреагировална Евгений Корепов в Отображение картинок в ListView   
    У меня на Rio работает как то не стабильно. Изредка вылазят исключения при закрытии приложения. То в TMonitor, то даже в TDictionary (((
     
    Сделал стабильную версию - работает быстро и без глюков, но с использованием внешнего списка с IAsyncResult. Добавил процедуру ClearListViewAndCancelAsynchronousRequests() где выполняется Cancel и очищается ListView. Теперь можно клацать по кнопке сколько угодно.
    unit Unit1; interface uses System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.ListView.Types, FMX.ListView.Appearances, FMX.ListView.Adapters.Base, System.Net.HttpClient, System.Generics.Collections, FMX.Controls.Presentation, FMX.StdCtrls, FMX.Layouts, FMX.ListView; const ListViewItemImageEmpy = -1; ListViewItemImageLoading = 0; ListViewItemImageLoaded = 1; type TForm1 = class(TForm) ListView1: TListView; Layout1: TLayout; Button1: TButton; procedure Button1Click(Sender: TObject); procedure ListView1UpdatingObjects(const Sender: TObject; const AItem: TListViewItem; var AHandled: Boolean); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); private { Private declarations } FListViewUpdating : Boolean; FHTTPClient : THTTPClient; FAsyncResultList : TList<IAsyncResult>; procedure LoadImage(const AItem: TListViewItem; const AListItemImage : TListItemImage); procedure ClearListViewAndCancelAsynchronousRequests(); public { Public declarations } end; var Form1: TForm1; implementation {$R *.fmx} procedure TForm1.FormCreate(Sender: TObject); begin listview1.ItemIndex:=0; listview1.ItemAppearance.ItemAppearance:='Custom'; listview1.ItemAppearanceObjects.ItemObjects.Accessory.Visible:=false; FHTTPClient:=THTTPClient.Create; FAsyncResultList:=TList<IAsyncResult>.Create; FListViewUpdating:=False; end; procedure TForm1.FormDestroy(Sender: TObject); begin ClearListViewAndCancelAsynchronousRequests(); FListViewUpdating:=True; if Assigned(FHTTPClient) then FHTTPClient.Free; end; procedure TForm1.ClearListViewAndCancelAsynchronousRequests(); Var I : Integer; begin for I := 0 to FAsyncResultList.Count - 1 do if FAsyncResultList.Items[I] <> Nil then if Not FAsyncResultList.Items[I].IsCompleted then FAsyncResultList.Items[I].Cancel; FListViewUpdating:=True; for I := ListView1.Items.Count - 1 downto 0 do ListView1.Items.Delete(I); FListViewUpdating:=False; end; procedure TForm1.Button1Click(Sender: TObject); var i:integer; item:TListViewItem; ARandom : Integer; begin ClearListViewAndCancelAsynchronousRequests(); //Формирование нового списка for i := 1 to 10000 do begin FAsyncResultList.Add(Nil); FListViewUpdating:=True; Item:=listview1.Items.Add; item.Height:=45; Randomize; ARandom:=Random(6); case ARandom of 0 : item.data['ImageURL']:='http://fire-monkey.ru/uploads/monthly_2017_06/me.thumb.jpg.966ddc17d5602ee14feb43479c1f6963.jpg'; 1 : item.data['ImageURL']:='http://fire-monkey.ru/uploads/monthly_2018_05/B-IpGQmVgTM.thumb.jpg.2ebeb0bd766ab7cf19f10195d6ea2be9.jpg'; 2 : item.data['ImageURL']:='http://fire-monkey.ru/uploads/monthly_2016_04/10.png.b9ab371e8fd38172fee96bcf75fb6699.thumb.png.b0685259b03bfff540903913845532a5.png'; 3 : item.data['ImageURL']:='https://secure.gravatar.com/avatar/9942c50b1641a921c52d4b389bd718d6?d=http://fire-monkey.ru/uploads/monthly_2017_12/K_member_87.png'; 4 : item.data['ImageURL']:='http://fire-monkey.ru/uploads/monthly_2016_11/photo-1529.png.7267be10b59f950b7c5bb3f34a60901e.thumb.png.22027ae85266216220310ed694d57628.png'; 5 : item.data['ImageURL']:='http://fire-monkey.ru/uploads/profile/photo-thumb-115.jpg'; end; Item.Data['ImageState']:=ListViewItemImageEmpy; FListViewUpdating:=False; item.Adapter.ResetView(item); end; end; procedure TForm1.LoadImage(const AItem: TListViewItem; const AListItemImage : TListItemImage); Var AAsyncResult : IAsyncResult; begin if Not Assigned(AItem) or Not Assigned(AListItemImage) then exit; if AItem.Data['ImageState'].AsInteger <> ListViewItemImageEmpy then exit; if AItem.Data['ImageURL'].AsString.IsEmpty then exit; AItem.Data['ImageState']:=ListViewItemImageLoading; FAsyncResultList.Items[AItem.Index]:=FHTTPClient.BeginGet( // AItem.TagObject:=TBaseAsyncResult(FHTTPClient.BeginGet( // FHTTPClient.BeginGet( procedure (const ASyncResult: IAsyncResult) Var AHTTPResponse : IHTTPResponse; begin if ASyncResult.IsCancelled then begin exit; end; try AHTTPResponse:=THTTPClient.EndAsyncHTTP(ASyncResult); if Not Assigned(AHTTPResponse) then exit; if AHTTPResponse.StatusCode <> 200 then exit; except exit; end; TThread.Synchronize(Nil, procedure begin if Not Assigned(AItem) then exit; if Not Assigned(AListItemImage) then exit; AListItemImage.BeginUpdate; AListItemImage.Bitmap:=TBitmap.Create; AListItemImage.Bitmap.LoadFromStream(AHTTPResponse.ContentStream); AListItemImage.EndUpdate; AItem.Data['ImageState']:=ListViewItemImageLoaded; FAsyncResultList.Items[AItem.Index]:=Nil; end ); end, AItem.Data['ImageURL'].AsString ); end; procedure TForm1.ListView1UpdatingObjects(const Sender: TObject; const AItem: TListViewItem; var AHandled: Boolean); function SetupImageObject(const AName : String; AWidth, AHeight, X , Y : Single; AAlign, AVertAlign: TListItemAlign) : TListItemImage; begin Result:=TListItemImage(AItem.View.FindDrawable(AName)); if Result = Nil then begin Result:=TListItemImage.Create(AItem); Result.Name:=AName; Result.Bitmap:=Nil; Result.OwnsBitmap:=True; end; Result.Width:=AWidth; Result.Height:=AHeight; Result.PlaceOffset.X:=X; Result.PlaceOffset.Y:=Y; Result.Align:=AAlign; Result.VertAlign:=AVertAlign; Result.ScalingMode:=TImageScalingMode.StretchWithAspect; Result.Visible:=True; end; Var AListItemImage : TListItemImage; begin if FListViewUpdating then exit; AListItemImage:=SetupImageObject('s_image', 35, 35, 0 , 0, TListitemalign.Leading, TListItemAlign.Center); LoadImage(AItem, AListItemImage); AHandled:=true; end; end.  
×
×
  • Создать...