¿Cómo actualizo el índice del elemento listview dentro del hilo?

Question

Aug 29, 2015, 07:54 PM

¿Cómo actualizo el índice del elemento listview dentro del hilo?

Estoy creando un proyecto que permite que múltiples usuarios inicien sesión y agreguen detalles dentrolistview pero estoy atascado con el problema, pero primero aquí está mi código de subprocesos con implementación de comentarios

type
  TUPDATEAFTERDOWNLOAD = class(TThread)
  private
    FListView: TListView;
    FListViewIdx: Integer;
    FMs: TMemoryStream;
    FURL: String;
    procedure UpdateVisual; // update after download
    function DownloadToStream: Boolean; // download function
    function CheckURL(const URL: Widestring): Boolean;
    // Check if its http url using urlmon
  protected
    procedure Execute; override;
  public
    property URL: String read FURL write FURL;
    property ListView: TListView read FListView write FListView;
    property ListViewIdx: Integer read FListViewIdx write FListViewIdx;
  end;

function TUPDATEAFTERDOWNLOAD.CheckURL(const URL: Widestring): Boolean;
begin
  if IsValidURL(nil, PWideChar(URL), 0) = S_OK then
    Result := True
  else
    Result := False;
end;

function TUPDATEAFTERDOWNLOAD.DownloadToStream: Boolean;
var
  aIdHttp: TIdHttp;
begin
  Result := False;
  if CheckURL(URL) = False then
    exit;
  aIdHttp := TIdHttp.Create(nil);
  try
    aIdHttp.Request.UserAgent :=
      'Mozilla/5.0 (Windows NT 6.1; WOW64; rv:12.0) Gecko/20100101 Firefox/12.0';
    aIdHttp.Get(FURL, FMs);
    Result := FMs.Size > 0;
  finally
    aIdHttp.Free;
  end;
end;

// procedure to start adding items then download image then update image to current item index
Procedure TForm1.Add_Item(strCaption: String; ListView: TListView;
  strFile: String; strUniqueID: String);
begin
  With ListView.Items.Add do
  begin
    Caption := '';
    SubItems.Add(strCaption); // subitem 0
    SubItems.AddObject('IMA', TObject(aGif)); // subitem 1
    SubItems.Add(strUniqueID); // subitem 2 // Client id
    SubItems.Add('-'); // subitem 3 // Next User Idx (beside)
    With TUPDATEAFTERDOWNLOAD.Create(False) do
    begin
      FreeOnTerminate := True;
      URL := strFile;
      ListView := ListView1;
      ListViewIdx := ListView1.Items.Count - 1;
      // this for define index of item that just added
      Application.ProcessMessages;
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Strname, image, strUniqueID: String;
begin
  Strname := 'Matrin';
  Add_Item(Strname, ListView1, image, strUniqueID);
end;

// Execute thread
procedure TUPDATEAFTERDOWNLOAD.Execute;
begin
  FMs := TMemoryStream.Create;
  if DownloadToStream then
  // if download done then start update the visual inside list view
    synchronize(UpdateVisual);
end;

procedure TUPDATEAFTERDOWNLOAD.UpdateVisual;
var
  ResStream: TResourceStream;
  i: Integer;
begin

  FMs.Position := 0;

  begin
    aGif := TGifImage.Create;
    aGif.LoadFromStream(FMs);
    aGif.Transparent := True;
    FListView.Items[FListViewIdx].SubItems.Objects[1] := TObject(aGif);
    if Streamin = True then
    begin
      for i := 0 to ListView.Items.Count - 1 do
        if ListView.Items[i].SubItems[3] = IntToStr(IDCLIENT) then
        begin
          ExchangeItems(ListView, FListViewIdx, 0);
        end;
    end;
  end;
  FMs.Free;

end;

Todo funciona bien, solo tengo un problema cuando trato deExchangeItems(ListView, FListViewIdx, 0); texto intercambiado pero siempre la imagen permanece en un índice incorrecto si hay 5 o 10 clientes, creo que la forma en que lo hago se pierde

Olvídate de agregar la función de elementos de Exchange

procedure ExchangeItems(lv: TListView; i, j: Integer);
var
  tempLI: TListItem;
begin
  lv.Items.BeginUpdate;
  try
    tempLI := TListItem.Create(lv.Items);
    tempLI.Assign(lv.Items.Item[i]);
    lv.Items.Item[i].Assign(lv.Items.Item[j]);
    lv.Items.Item[j].Assign(tempLI);
    tempLI.Free;
  finally
    lv.Items.EndUpdate
  end;
end;

Información actualizada

Traté de mover imágenes GIF a la propiedad TListItem.Data pero la imagen se muestra vacía ahora

procedure TFORM1.UpdateVisual(Sender: TObject; AUserData: Pointer; var AImage: TGifImage);
var
 Item: TListItem;
i : integer;
begin
 Item := TListItem(AUserData);

  if ListView1.Items.IndexOf(Item) = -1 then
    Exit;

  Item.Data:= AImage;// iam not sure if this right or wrong
  AImage := nil;

if recorder.Active = True then
      begin
       for i := 0 to ListView1.Items.Count-1
     do if ListView1.Items[i].SubItems[3] = IntToStr(UniqueID)
     then
     begin
     ExchangeItems(ListView1, Item.Index, 0);
     ListView1.Invalidate;
     SendCommandWithParams(TCPClient, 'Streamin', IntToStr(UniqueID) + Sep);
     end;
   end;
end;

así es como yo usogif dentrolistview OnDrawitem evento

procedure TFORM1.ListView1DrawItem(Sender: TCustomListView; Item: TListItem;
  Rect: TRect; State: TOwnerDrawState);
Var
  xOff, yOff : Integer;
  R: TRect;
  i : Integer;
  NewRect : TRect;
begin
    // Client image
      NewRect := Rect;
      NewRect.Right  := Sender.Column[0].Width - 4; // for Right Justify
      NewRect.Left   := NewRect.Right  - ImageList1.Width;
      NewRect.Top    := NewRect.Top + 2;
      NewRect.Bottom := NewRect.Bottom;
      Sender.Canvas.StretchDraw( NewRect, TGIFImage( Item.data) );
end;

También porgif animación estoy usando temporizador para repintarlistview

procedure TFrom1.Timer1Timer(Sender: TObject);
{$j+}
  Const iCount : Cardinal = 0;
{$j-}
begin
  inc(iCount);
  if (iCount * TTimer(Sender).Interval) > 500 then
  begin
    iCount := 0;
  end;
  ListView1.Invalidate; // This is for animation over ListView Canvas
end;

y esto cuando envío stream a otros clientes eso es lo que debería pasar

procedure TFORM1.Streamin;
var
i : integer;
begin
for i := 0 to ListView1.Items.Count-1
    do if ListView1.Items[i].SubItems[3] = Trim(CLIENTID) then
  begin
  R:= listview1.Items[i].Index;
   ExchangeItems( ListView1, R, 0);
  end;
   Panel2.Top  := xSelItemTop;
   panel2.Visible := true;
   panelmeter.Visible := True;
end;

publiqué todo en mi proyecto, sigo los consejos de Remy y respondo a estos problemas parece muy complicado, no puedo captar ningún falso en la codificación, espero que alguien sepa qué pasa

Actualizaciones

mediante el usowininet se redujo el problema, pero cuando se ejecutó la solicitud solicitada, se produjo un problema demasiado rápido ¿es del temporizador?

Actualizar

después de crear una aplicación independiente, el único problema es el intercambio de elementos, algunas veces tiene un índice falso al cambiar el elemento de intercambio siguiendo el código

procedure ExchangeItems(lv: TListView; ItemFrom, ItemTo: Word);
var
 Source, Target: TListItem;
begin
  lv.Items.BeginUpdate;
  try
 Source := lv.Items[ItemFrom];
 Target := lv.Items.Insert(ItemTo);
 Target.Assign(Source);
 Source.Free;
  finally
    lv.Items.EndUpdate
  end;
end;

funciona bien, pero algunas veces su elemento vacío insertado y la aplicación se cancelan hasta que se produce el intercambio

mcve actualizado

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls, Vcl.ExtCtrls, JPEG, Vcl.Imaging.pngimage, GIFImg, GraphUtil,
  Vcl.ImgList;

type
  TForm1 = class(TForm)
    ListView1: TListView;
    Additem: TButton;
    Exchange: TButton;
    Timer1: TTimer;
    ImageList1: TImageList;
    Panel2: TPanel;
    Shape1: TShape;
    Edit1: TEdit;
    AddToSTringlistFirst: TButton;
    procedure FormCreate(Sender: TObject);
    procedure AdditemClick(Sender: TObject);
    procedure ListView1DrawItem(Sender: TCustomListView; Item: TListItem;
      Rect: TRect; State: TOwnerDrawState);
    procedure Timer1Timer(Sender: TObject);
    procedure ExchangeClick(Sender: TObject);
    procedure AddToSTringlistFirstClick(Sender: TObject);
  private
     namelist: TList;
    { Private declarations }
  public
    { Public declarations }
    procedure Add_Item(strCaption: String; ListView: TListView; strFile: String;
    boolBlink: Boolean; strUniqueID, Currentstatus: string);
    procedure UpdateVisual(Sender: TObject; AUserData: Pointer;
      var AImage: TGifImage);
  end;

    type
  TDownloadUpdateVisualEvent = procedure(Sender: TObject; AUserData: Pointer; var AImage: TGifImage) of object;

  type
  TURLDownload = class(TThread)
  private
    FGif         : TGifImage;
    FOnUpdateVisual: TDownloadUpdateVisualEvent;
    FUserData: Pointer;
    FURL         : String;
    procedure DoUpdateVisual;
  protected
    procedure Execute; override;
  public
  constructor Create(const AUrl: String; AOnUpdateVisual: TDownloadUpdateVisualEvent; AUserData: Pointer); reintroduce;
  end;


  Tcollectlist = class(TObject)
  Name: String;
  icon:string;
  UniqueID : Dword;
  end;

var
  Form1: TForm1;
  xProcessingTime : Boolean = False;
  aGIF : TGifImage;
  jpg : TJPEGImage;
  png : TPngImage;
  Status : string = '-';
  xSelItemLeft   : Integer = 0;
  xSelItemTop    : Integer = 0;
  recorder : Boolean;
  UniqueID : Dword;
  xboolBlink : Boolean = False;
  listMS: TMemoryStream;


implementation

uses wininet;

{$R *.dfm}

{$j+}
  Const boolblink : boolean = false;
  Const Sep = '#$%^&';
{$j-}



constructor TURLDownload.Create(const AUrl: String; AOnUpdateVisual: TDownloadUpdateVisualEvent; AUserData: Pointer);
begin
  inherited Create(False);
  FreeOnTerminate := True;
  FUrl := AUrl;
  FOnUpdateVisual:= AOnUpdateVisual;
  FUserData := AUserData;
end;


procedure ExchangeItems(lv: TListView; ItemFrom, ItemTo: Word);
var
 Source, Target: TListItem;
begin
  lv.Items.BeginUpdate;
  try
 Source := lv.Items[ItemFrom];
    Target := lv.Items.Insert(ItemTo);
    Target.Assign(Source);
    Source.Free;
  finally
    lv.Items.EndUpdate
  end;
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
namelist := TList.Create;
  // This is for repaint the ListView and so for the animation
    Timer1.Interval       := 10;
    Timer1.Enabled        := true;

  // This is for enlarge the ListView height
  //   ImageList1.Width      := 50;
  //   ImageList1.Height     := 30;
  With ListView1 do
  begin
    SmallImages    := ImageList1;
    ViewStyle      := vsReport;
    RowSelect      := True;
    ReadOnly       := True;
    OwnerDraw      := True;
    DoubleBuffered := True;
    With Columns.Add do Width := (ImageList1.Width+4)*2; // Caption
    With Columns.Add do Width := ListView1.Width - ListView1.Columns[0].Width;  // 0 Name
  end;
end;

procedure TForm1.ListView1DrawItem(Sender: TCustomListView; Item: TListItem;
  Rect: TRect; State: TOwnerDrawState);
Var
  xOff, yOff : Integer;
  i : Integer;
    R: TRect;
  NewRect : TRect;
begin
  With TListView(Sender).Canvas do
  begin
    if Item.Selected then
    begin
          SetRect(R, Rect.Left, Rect.Top, Rect.Right, Rect.Bottom-( (Rect.Bottom-Rect.Top) div 2 ) );
      SetRect(R, Rect.Left, Rect.Bottom-( (Rect.Bottom-Rect.Top) div 2 ), Rect.Right, Rect.Bottom );
      Sender.Canvas.Brush.Style := bsClear;
      Sender.Canvas.Pen.Width   := 0;

      //Sender.Canvas.Font.Color  := clBlue;
      //Sender.Canvas.Brush.Color := clYellow;
      //Sender.Canvas.FillRect(Rect);
      Rectangle( Rect.Left, Rect.Top,  Rect.Right, Rect.Top + ImageList1.Height);
    end;
    xSelItemTop    := sender.Top + ImageList1.Height;
    Sender.Canvas.Brush.Style := bsClear;
    // User State Image
     if (Item.SubItems[5] <> '-') then
     begin
      if Panel2.Visible AND (Item.Index = 0) then
     else
     ImageList1.Draw( Sender.Canvas, Rect.Left, Rect.Top, StrToInt(Item.SubItems[5]) );
      end;
    // User Image
      NewRect := Rect;
      NewRect.Right  := Sender.Column[0].Width - 4; // for Right Justify
      NewRect.Left   := NewRect.Right  - ImageList1.Width;
      NewRect.Top    := NewRect.Top + 2;
      NewRect.Bottom := NewRect.Bottom;
      Sender.Canvas.StretchDraw( NewRect, TGIFImage( Item.data) );

    // Image - Beside User
      if Item.SubItems[4] <> '-' then
      begin
        NewRect := Rect;
        NewRect.Left   := NewRect.Left  + ImageList1.Width; // after StateImage offset
        NewRect.Right  := NewRect.Left  + ImageList1.Width;
        NewRect.Top    := NewRect.Top    + 4;
        NewRect.Bottom := NewRect.Bottom - 4;
        Sender.Canvas.StretchDraw( NewRect, TGIFImage( TListView(Sender).Items[StrToInt(Item.SubItems[4])].SubItems.Objects[1]) );
      end;

    // --- Caption and Text --- //
    xOff := Rect.Left;
    for i := 1 to TListView(sender).Columns.Count-1 do // 1,2,3,4,5,6
    begin
      xOff := xOff + TListView(Sender).Columns[i-1].Width;
      yOff := Rect.Top + ((ImageList1.Height-Canvas.TextHeight('H')) div 2);
      if xboolBlink or ( Item.SubItems[2] = '' )
        then sender.canvas.font.color := clgray
        else sender.canvas.font.color := clred;
      TextOut( xOff, yOff, Item.SubItems[i-1] );
    end;
  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
{$j+}
  Const iCount : Cardinal = 0;
{$j-}
begin
  inc(iCount);
  if (iCount * TTimer(Sender).Interval) > 500 then
  begin  // this is for blink text which subitem[2] contains 'blink'
    xboolBlink := NOT xboolBlink;
    iCount := 0;
  end;
  ListView1.Invalidate; // This is for animation over ListView Canvas
end;


procedure parselist(Line: string; var strName, strUniqueID,icon: string);
var
  P, I: Integer;
begin
  I := 0;
  repeat
    P := Pos(Sep, Line);
    if P <> 0 then
    begin
      Inc(I);
      case I of
        1: strName     := Copy(Line, 1, P - 1);
        2: strUniqueID := Copy(Line, 1, P - 1);
        3: icon  := Copy(Line, 1, P - 1);
      end;
      Delete(Line, 1, P + Length(Sep) - 1);
    end;
  until (I = 3) or (P = 0) or (Line = '')
end;


procedure TForm1.AdditemClick(Sender: TObject);
var
I : integer;
Line: string;
strName, strUniqueID, icon : String;
strSelectedUID : String;
Sl : Tstringlist;
begin
  if ListView1.Selected <> nil
      then strSelectedUID := Listview1.Selected.SubItems[3]
      else strSelectedUID := '';
    listview1.Items.BeginUpdate;
    try
    ListView1.Items.Clear;
finally
    listview1.Items.EndUpdate;
  end;
    if Assigned(listms) then
    SL := TStringList.Create;
    begin
      try
        listms.Position := 0;
        Sl.LoadFromStream(listms);
        for I := 0 to SL.Count -1  do
        begin
            Line := SL.Strings[I];
            parselist(Line, strName, strUniqueID, icon);
            boolblink := True;
           Add_Item( strName, ListView1, icon, boolblink, strUniqueID, Status);
        end;
      finally
       Sl.Free
      end;
      listms.Free;

    if strSelectedUID <> '' then
      begin
        for i := 0 to ListView1.Items.Count-1
          do if ListView1.Items[i].SubItems[3] = strSelectedUID
            then Listview1.Items[i].Selected := True;
      end;
    end;
end;


procedure TForm1.AddToSTringlistFirstClick(Sender: TObject);
var
  I: Integer;
  image : string;
  collectlist : Tcollectlist;
  MS: TMemoryStream;
  Sl : Tstringlist;
begin
collectlist := Tcollectlist.Create;
SL := TStringList.Create;
image := edit1.Text;
collectlist.Name := 'Martinloanel';
collectlist.UniqueID :=  StrToint('5555' + intTostr(1));
collectlist.icon := image;
namelist.Add(collectlist);

 try
    // Collect List
    for I := 0 to namelist.Count - 1 do
    begin
      collectlist := Tcollectlist(namelist.Items[I]);
      SL.Add(collectlist.Name + Sep + IntToStr(collectlist.UniqueID) + Sep +  collectlist.icon + Sep);
    end;
// Send List
    for I := 0 to namelist.Count - 1 do
    begin
      collectlist := Tcollectlist(namelist.Items[I]);
      if (SL.Count > 0) then
      begin
        MS := TMemoryStream.Create;
        listms :=  TMemoryStream.Create;
        try
          SL.SaveToStream(MS);
          MS.Position := 0;
          listms.LoadFromStream(MS);

        finally
         MS.Free;
        end;
      end;
    end;
  finally
    Sl.Free
  end;
end;

Procedure TForm1.Add_Item( strCaption: String; ListView : TListView; strFile: String; boolBlink : Boolean; strUniqueID:String; Currentstatus: string);
var
  Item: TListItem;
begin
Currentstatus := Status;
  begin
    Item := ListView1.Items.Add;
    Item.Caption   := '';
    Item.SubItems.Add( strCaption ); // subitem 0
    Item.SubItems.AddObject( 'IMA', nil); // subitem 1
    if boolBlink
      then  Item.SubItems.Add( 'blink' ) // subitem 2
      else  Item.SubItems.Add( '' );     // subitem 2
      Item.SubItems.Add( strUniqueID );                  // subitem 3 // UniqueID
      UniqueID := strToint(strUniqueID);
    Item.SubItems.Add('-');                            // subitem 4 // Next User Idx (beside)
    Item.SubItems.Add(Currentstatus);                              // subitem 5 // StateIdx
    TURLDownload.Create(strFile, UpdateVisual, Item);
    end;
  end;



  procedure TForm1.ExchangeClick(Sender: TObject);
begin
recorder := True;
end;

procedure TURLDownload.DoUpdateVisual;
begin
  if Assigned(FOnUpdateVisual) then
    FOnUpdateVisual(Self, FUserData, FGif);
end;

procedure TURLDownload.Execute;
var
  aMs: TMemoryStream;
  hSession     : HINTERNET;
  hService     : HINTERNET;
  lpBuffer     : array[0..1023] of Byte;
  dwBytesRead  : DWORD;
  dwBytesAvail : DWORD;
  dwTimeOut    : DWORD;
begin
  FGif := TGifImage.Create;
  try
  aMs := TMemoryStream.Create;
  hSession := InternetOpen('anyname', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
  if not Assigned(hSession) then Exit;
    try
      hService := InternetOpenUrl(hSession, PChar(FUrl), nil, 0, 0, 0);
    if hService = nil then
      Exit;
      try
      dwTimeOut := 60000;
      InternetSetOption(hService, INTERNET_OPTION_RECEIVE_TIMEOUT, @dwTimeOut, SizeOf(dwTimeOut));
      if InternetQueryDataAvailable(hService, dwBytesAvail, 0, 0) then
      repeat
      if not InternetReadFile(hService, @lpBuffer[0], SizeOf(lpBuffer), dwBytesRead) then
      Break;
      if dwBytesRead <> 0 then
      aMs.WriteBuffer(lpBuffer[0], dwBytesRead);
      until dwBytesRead = 0;
      finally
       InternetCloseHandle(hService);
      end;
      aMs.Position := 0;
      FGif.LoadFromStream(aMs);
      FGif.Transparent := True;
    finally
      aMs.Free;
      InternetCloseHandle(hSession);
    end;
    if Assigned(FOnUpdateVisual) then
    begin
      Synchronize(DoUpdateVisual);
    end;
  finally
    FGif.Free;
  end;
end;




  procedure TForm1.UpdateVisual(Sender: TObject; AUserData: Pointer; var AImage: TGifImage);
var
 Item: TListItem;
i : integer;
begin
 Item := TListItem(AUserData);

  if ListView1.Items.IndexOf(Item) = -1 then
    Exit;

  Item.Data := AImage;
  AImage := nil;

if recorder = True then
      begin
       for i := 0 to ListView1.Items.Count-1
     do if ListView1.Items[i].SubItems[3] = IntToStr(UniqueID)
     then
     begin
     ExchangeItems(ListView1, Item.Index, 0);
     ListView1.Invalidate;
     end;
   end;
end;


end.