我如何更新线程内的列表视图项目索引
how do i update listview item index inside thread
我正在创建允许多用户登录并在其中添加详细信息的项目 listview 但我遇到了问题，但首先这是我的线程代码与注释实现
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;
一切正常，只是当我尝试 ExchangeItems(ListView, FListViewIdx, 0); 文本交换时遇到问题，但如果有 5 或 10 个客户，图像总是停留在错误的索引处，我认为我这样做的方式被遗漏了
忘记添加兑换物品功能
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 属性 但图像现在显示为空
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 的方式
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
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;
这就是当我向其他客户端发送流时应该发生的事情
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 问题减少了，但是当执行请求太快时出现问题是来自计时器吗？
更新
创建独立应用程序后，唯一的问题是在交换项目中，它有时会通过以下代码更改交换项目而产生错误的索引
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
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.
试试像这样的东西：
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;
我正在创建允许多用户登录并在其中添加详细信息的项目 listview 但我遇到了问题，但首先这是我的线程代码与注释实现
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;
一切正常，只是当我尝试 ExchangeItems(ListView, FListViewIdx, 0); 文本交换时遇到问题，但如果有 5 或 10 个客户，图像总是停留在错误的索引处，我认为我这样做的方式被遗漏了
忘记添加兑换物品功能
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 属性 但图像现在显示为空
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 的方式
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
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;
这就是当我向其他客户端发送流时应该发生的事情
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 问题减少了，但是当执行请求太快时出现问题是来自计时器吗？
更新
创建独立应用程序后，唯一的问题是在交换项目中，它有时会通过以下代码更改交换项目而产生错误的索引
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
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.
试试像这样的东西：
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;