Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
4.2k views
in Technique[技术] by (71.8m points)

delphi - how do i update listview item index inside thread

i am creating project that allow multi users to login and add there details inside listview but i am stuck with problem , but First here is my threading code with comment implementation

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;

Every thing working fine only i got problem when i try to ExchangeItems(ListView, FListViewIdx, 0); text exchanged but always image stay at wrong index if there 5 or 10 clients , i think the way that i do it is missed up

Forget to add Exchange items function

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;

Updated information

i tried to move GIF images to the TListItem.Data property but image shows empty now

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;

that's how i use gif inside listview OnDrawitem event

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;

also for gif animation i am using timer for repaint listview

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;

and this when i send stream to other clients thats what should happend

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;

i posted every thing in my project i follow remy advice and answer this issues seems very complicated i cannot catch any false in coding hope some one knows whats up

Updates

by using wininet problem reduced but when execute requested too fast problem happened is it from the timer ?

Update

after create stand alone application the only problem is in exchange items it has some times false index by change exchange item by following code

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;

it work good but some times its insert empty item and application abort until re exchange happened

updated mcve

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] 

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Answer

0 votes
by (71.8m points)

Try something more like this:

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

  TDownloadImage = class(TThread)
  private
    FURL: String;
    FGif: TGifImage;
    FOnImageReady: TDownloadImageReadyEvent;
    FUserData: Pointer;
    procedure DoImageReady;
  protected
    procedure Execute; override;
  public
    constructor Create(const AUrl: String; AOnImageReady: TDownloadImageReadyEvent; AUserData: Pointer); reintroduce;
  end;

constructor TDownloadImage.Create(const AUrl: String; AOnImageReady: TDownloadImageReadyEvent; AUserData: Pointer);
begin
  inherited Create(False);
  FreeOnTerminate := True;
  FUrl := AUrl;
  FOnImageReady := AOnImageReady;
  FUserData := AUserData;
end;

procedure TDownloadImage.Execute;
var
  aMs: TMemoryStream;
  aIdHttp: TIdHttp;
begin
  FGif := TGifImage.Create;
  try
    aMs := TMemoryStream.Create;
    try
      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, aMs);
      finally
        aIdHttp.Free;
      end;
      aMs.Position := 0;
      FGif.LoadFromStream(aMs);
      FGif.Transparent := True;
    finally
      aMs.Free;
    end;
    if Assigned(FOnImageReady) then
      Synchronize(DoImageReady);
    end;
  finally
    FGif.Free;
  end;
end;

procedure TDownloadImage.DoImageReady;
begin
  if Assigned(FOnImageReady) then
    FOnImageReady(Self, FUserData, FGif);
end;

procedure TForm1.Add_Item(const strCaption, strFile, strUniqueID: String);
var
  Item: TListItem;
begin
  Item := ListView1.Items.Add;
  Item.Caption := '';
  Item.SubItems.Add(strCaption); // subitem 0
  Item.SubItems.Add('IMA'); // subitem 1
  Item.SubItems.Add(strUniqueID); // subitem 2 // Client id
  Item.SubItems.Add('-'); // subitem 3 // Next User Idx (beside)
  Item.Data := nil;
  TDownloadImage.Create(strFile, ImageReady, Item);
end;

procedure TForm1.ListView1Deletion(Sender: TObject; Item: TListItem);
begin
  TGifImage(Item.Data).Free;
end;

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

procedure TForm1.ImageReady(Sender: TObject; AUserData: Pointer; var AImage: TGifImage);
var
  Item: TListItem;
  i: Integer;
  sClientID: string;
begin
  Item := TListItem(AUserData);

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

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

  if Streamin then
  begin
    sClientID := IntToStr(IDCLIENT);
    for i := 0 to ListView1.Items.Count - 1 do
    begin
      if ListView.Items[i].SubItems[3] = sClientID then
      begin
        ExchangeItems(ListView1, Item.Index, 0);
        Exit;
      end;
    end;
  end;
end;

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

2.1m questions

2.1m answers

60 comments

57.0k users

...