我正在创建允许多用户登录并在listview中添加详细信息的项目,但我遇到了问题,但首先是我的线程代码与注释实现 @H_502_2@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,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;

当我尝试使用ExchangeItems(ListView,0)时,每一件工作都很好我只会遇到问题;文本交换但总是图像保持在错误的索引,如果有5或10个客户端,我认为我这样做的方式是错过了

忘记添加Exchange项目功能

@H_502_2@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;

更新的信息

我试图将GIF图像移动到TListItem.Data属性,但图像现在显示为空

@H_502_2@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;

这就是我在listview OnDrawitem事件中使用gif的方式

@H_502_2@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;

同样对于gif动画我正在使用计时器重新绘制listview

@H_502_2@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;

当我向其他客户发送流应该发生的事情时

@H_502_2@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;

我发布了我项目中的所有内容我跟随雷米建议并回答这个问题似乎非常复杂我不能抓住编码中的任何错误希望有人知道怎么了什么

更新

通过使用wininet问题减少但当执行请求太快时问题是从计时器发生的？

更新

创建独立应用程序后,唯一的问题是在交换项目中它通过以下代码更改交换项目有一些错误的索引

@H_502_2@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;

它工作得很好,但有时它插入空项目和应用程序中止,直到重新交换发生

更新了mcve

@H_502_2@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,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.Bottom-( (Rect.Bottom-Rect.Top) div 2 ),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 + 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,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,P - 1); 3: icon := Copy(Line,P - 1); end; Delete(Line,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,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,icon); boolblink := True; Add_Item( strName,icon,boolblink,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,0); if not Assigned(hSession) then Exit; try hService := InternetOpenUrl(hSession,PChar(FUrl),0); if hService = nil then Exit; try dwTimeOut := 60000; InternetSetOption(hService,INTERNET_OPTION_RECEIVE_TIMEOUT,@dwTimeOut,SizeOf(dwTimeOut)); if InternetQueryDataAvailable(hService,dwBytesAvail,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,0); ListView1.Invalidate; end; end; end; end.