如何更新内螺纹ListView项指标 [英] how do i update listview item index inside thread
本文介绍了如何更新内螺纹ListView项指标的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
我创建的项目，允许多用户登录，并添加列表视图里面的细节，但我坚持的问题，但首先这里是我的线程code。与注释执行
键入
TUPDATEAFTERDOWNLOAD =类（TThread类）
私人的
FListView：TListView的;
FListViewIdx：整数;
外长：内存流;
卷起：字符串;
程序UpdateVisual; //下载后更新
功能DownloadToStream：布尔; //下载功能
功能CheckURL（常量网址：WideString的）：布尔;
//检查它的HTTP URL使用URLMON
保护
程序执行;覆盖;
上市
资源网址：字符串读卷起写卷起;
物业的ListView：TListView的读FListView写FListView;
物业ListViewIdx：整数读FListViewIdx写FListViewIdx;
结束;功能TUPDATEAFTERDOWNLOAD.CheckURL（常量网址：WideString的）：布尔;
开始
如果IsValidURL（零，PWideChar（URL），0）= S_OK则
结果：= TRUE
其他
结果：= FALSE;
结束;功能TUPDATEAFTERDOWNLOAD.DownloadToStream：布尔;
VAR
aIdHttp：TIdHttp;
开始
结果：= FALSE;
如果CheckURL（URL）= false，那么
出口;
aIdHttp：= TIdHttp.Create（无）;
尝试
aIdHttp.Request.UserAgent：=
Mozilla的/ 5.0（Windows NT的6.1; WOW64; RV：12.0）的Gecko / 20100101火狐/ 12.0';
aIdHttp.Get（卷起，FMS）;
结果：= FMs.Size＆GT; 0;
最后
aIdHttp.Free;
结束;
结束;//程序开始添加项目，然后下载图像，然后更新图像当前项指数
程序TForm1.Add_Item（strCaption：字符串; ListView控件：TListView的;
strFile：字符串; strUniqueID：字符串）;
开始
随着ListView.Items.Add做
开始
标题：='';
SubItems.Add（strCaption）; // 0分项目
SubItems.AddObject（'IMA'，TObject的（AGIF））; //子项目1
SubItems.Add（strUniqueID）; //子项目2 //客户端ID
SubItems.Add（' - '）; //子项目3 //下一页用户并按Idx（旁）
随着TUPDATEAFTERDOWNLOAD.Create（假）做
开始
FreeOnTerminate：= TRUE;
网址：= strFile;
ListView控件：= ListView1的;
ListViewIdx：= ListView1.Items.Count - 1;
//刚才添加的项目本作定义指数
Application.ProcessMessages;
结束;
结束;
结束;过程TForm1.Button1Click（发件人：TObject的）;
VAR
STRNAME，图像，strUniqueID：字符串;
开始
STRNAME：='苦参碱';
Add_Item（STRNAME，ListView1的，图像，strUniqueID）;
结束;//执行线程
程序TUPDATEAFTERDOWNLOAD.Execute;
开始
外长：= TMemoryStream.Create;
如果DownloadToStream然后
//如果下载完成，然后开始更新视觉内部列表视图
同步（UpdateVisual）;
结束;程序TUPDATEAFTERDOWNLOAD.UpdateVisual;
VAR
ResStream：TResourceStream;
我：整数;
开始 FMs.Position：= 0; 开始
AGIF：= TGifImage.Create;
aGif.LoadFromStream（FMS）;
aGif.Transparent：= TRUE;
FListView.Items [FListViewIdx] .SubItems.Objects [1]：= TObject的（AGIF）;
如果Streamin = True，那么
开始
对于i：= 0 ListView.Items.Count - 1做
如果ListView.Items [Ⅰ] .SubItems [3] = IntToStr（IDCLIENT）然后
开始
ExchangeItems（ListView中，FListViewIdx，0）;
结束;
结束;
结束;
FMs.Free;结束;
做工精细每一件事只有我有问题，当我尝试 ExchangeItems（ListView中，FListViewIdx，0）; 文本交换，但始终形象留在错误的索引，如果有5个或10个客户端，我想我做到这一点错过了道路。
忘记添加Exchange项功能
程序ExchangeItems（LV：TListView的; I，J：整数）;
VAR
tempLI：TListItem;
开始
lv.Items.BeginUpdate;
尝试
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;
最后
lv.Items.EndUpdate
结束;
结束;
更新信息
我试图GIF图片移动到TListItem.Data财产，但现在的图像显示为空
程序TFORM1.UpdateVisual（发件人：TObject的; AUserData：指针; VAR AImage：TGifImage）;
VAR
项目：TListItem;
我：整数;
开始
项目：= TListItem（AUserData）; 如果ListView1.Items.IndexOf（项目）= -1，那么
出口; Item.Data：= AImage; // IAM不知道这对还是错
AImage：=零;如果recorder.Active = TRUE，则
开始
对于i：= 0至ListView1.Items.Count -1-
做，如果ListView1.Items [Ⅰ] .SubItems [3] = IntToStr（UniqueID的）
然后
开始
ExchangeItems（ListView1的，Item.Index，0）;
ListView1.Invalidate;
SendCommandWithParams（的TcpClient，'Streamin'，IntToStr（的UniqueID）+ 9月）;
结束;
结束;
结束;
这就是我如何使用 GIF 在列表视图 的OnDrawItem 事件
程序TFORM1.ListView1DrawItem（发件人：TCustomListView;项目：TListItem;
RECT：TRect;状态：TOwnerDrawState）;
瓦尔
x关，YOFF：整数;
R：TRect;
我：整数;
NewRect：TRect;
开始
//客户端图像
NewRect：=矩形;
NewRect.Right：= Sender.Column [0] .WIDTH - 4; //为右对齐
NewRect.Left：= NewRect.Right - ImageList1.Width;
NewRect.Top：= NewRect.Top + 2;
NewRect.Bottom：= NewRect.Bottom;
Sender.Canvas.StretchDraw（NewRect，TGIFImage（Item.data））;
结束;
也为 GIF 动画我使用计时器重绘列表视图
程序TFrom1.Timer1Timer（发件人：TObject的）;
{$ J +}
常量ICOUNT：红衣主教= 0;
{$ J-}
开始
INC（ICOUNT）;
如果（ICOUNT *的TTimer（发件人）.Interval）GT; 500则
开始
ICOUNT：= 0;
结束;
ListView1.Invalidate; //这是在动画画布的ListView
结束;
这时候我流发送给其他客户端多数民众赞成应该happend
程序TFORM1.Streamin;
VAR
我：整数;
开始
对于i：= 0至ListView1.Items.Count -1-
做，如果ListView1.Items [Ⅰ] .SubItems [3] =修剪（客户端ID），那么
开始
R：= listview1.Items [I]的.index;
ExchangeItems（ListView1的R，0）;
结束;
Panel2.Top：= xSelItemTop;
panel2.Visible：=真;
panelmeter.Visible：= TRUE;
结束;
我张贴的每一件事情在我的项目我跟雷米咨询和回答这个问题似乎很复杂，我无法捕捉任何虚假编码希望一些人知道怎么了。
更新
使用 WININET 问题减少，但在执行所请求的速度过快发生问题是由定时器？
更新
在创建独立的应用程序唯一的问题是在交换物品是由以下有一定的时间错误的指数变化交换项目code
程序ExchangeItems（LV：TListView的; ItemFrom，ItemTo：字）;
VAR
源，目标：TListItem;
开始
lv.Items.BeginUpdate;
尝试
来源：= lv.Items [ItemFrom]
目标：= lv.Items.Insert（ItemTo）;
Target.Assign（来源）;
Source.Free;
最后
lv.Items.EndUpdate
结束;
结束;
它的工作不错，但有些时候它插入空项目和应用中断，直到再次发生交换
更新MCVE
单元1单元;接口用途
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;类型
TForm1 =类（TForm的）
ListView1的：TListView的;
ADDITEM：TButton的;
交易所：TButton的;
定时器1：的TTimer;
ImageList1：的TImageList;
是Panel2：TPanel;
Shape1：T形;
EDIT1：TEDIT;
AddToSTringlistFirst：TButton的;
程序FORMCREATE（发件人：TObject的）;
程序AdditemClick（发件人：TObject的）;
程序ListView1DrawItem（发件人：TCustomListView;项目：TListItem;
RECT：TRect;状态：TOwnerDrawState）;
程序Timer1Timer（发件人：TObject的）;
程序ExchangeClick（发件人：TObject的）;
程序AddToSTringlistFirstClick（发件人：TObject的）;
私人的
名称列表：从TList;
{私人声明}
上市
{公开声明}
程序Add_Item（strCaption：字符串; ListView控件：TListView的; strFile：字符串;
boolBlink：布尔; strUniqueID，Currentstatus：字符串）;
程序UpdateVisual（发件人：TObject的; AUserData：指针;
VAR AImage：TGifImage）;
结束; 类型
TDownloadUpdateVisualEvent =过程（发件人：TObject的; AUserData：指针; VAR AImage：TGifImage）对象; 类型
TURLDownload =类（TThread类）
私人的
FGif：TGifImage;
FOnUpdateVisual：TDownloadUpdateVisualEvent;
FUserData：指针;
卷起：字符串;
程序DoUpdateVisual;
保护
程序执行;覆盖;
上市
构造函数创建（const的AUrl：字符串; AOnUpdateVisual：TDownloadUpdateVisualEvent; AUserData：指针）;重新引入;
结束;
Tcollectlist =类（TObject的）
名称：字符串;
图示：字符串;
的UniqueID：DWORD;
结束;VAR
Form1中：TForm1;
xProcessingTime：布尔= FALSE;
AGIF：TGifImage;
JPG：TJPEGImage;
PNG：TPngImage;
状态：字符串=' - ';
xSelItemLeft：整数= 0;
xSelItemTop：整数= 0;
记录：布尔;
的UniqueID：DWORD;
xboolBlink：布尔= FALSE;
listMS：内存流;
履行使用WININET;{$ R * .DFM}{$ J +}
常量boolblink：布尔= FALSE;
常量九月='＃$％^＆放大器;';
{$ J-}构造TURLDownload.Create（常量AUrl：字符串; AOnUpdateVisual：TDownloadUpdateVisualEvent; AUserData：指针）;
开始
继承创建（假）;
FreeOnTerminate：= TRUE;
卷起：= AUrl;
FOnUpdateVisual：= AOnUpdateVisual;
FUserData：= AUserData;
结束;
程序ExchangeItems（LV：TListView的; ItemFrom，ItemTo：字）;
VAR
源，目标：TListItem;
开始
lv.Items.BeginUpdate;
尝试
来源：= lv.Items [ItemFrom]
目标：= lv.Items.Insert（ItemTo）;
Target.Assign（来源）;
Source.Free;
最后
lv.Items.EndUpdate
结束;
结束;
程序TForm1.FormCreate（发件人：TObject的）;
开始
名称列表：= TList.Create;
//这是重绘ListView，并且因此对于动画
Timer1.Interval：= 10;
Timer1.Enabled：= TRUE; //这是放大ListView的高度
// ImageList1.Width：= 50;
// ImageList1.Height：= 30;
随着ListView1的做
开始
SmallImages：= ImageList1;
ViewStyle：= vsReport;
RowSelect：= TRUE;
只读：= TRUE;
的OwnerDraw：= TRUE;
DoubleBuffered：= TRUE;
随着Columns.Add做宽：=（ImageList1.Width + 4）* 2; //标题
随着Columns.Add做宽：= ListView1.Width - ListView1.Columns [0] .WIDTH; // 0名称
结束;
结束;程序TForm1.ListView1DrawItem（发件人：TCustomListView;项目：TListItem;
RECT：TRect;状态：TOwnerDrawState）;
瓦尔
x关，YOFF：整数;
我：整数;
R：TRect;
NewRect：TRect;
开始
随着的TListView（发件人）.Canvas做
开始
如果Item.Selected然后
开始
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）;
矩形（Rect.Left，Rect.Top，Rect.Right，Rect.Top + ImageList1.Height）;
结束;
xSelItemTop：= sender.Top + ImageList1.Height;
Sender.Canvas.Brush.Style：= bsClear;
//用户状态图片
如果（Item.SubItems [5]所述;＆GT; - ），那么
开始
如果Panel2.Visible AND（Item.Index = 0），那么
其他
ImageList1.Draw（Sender.Canvas，Rect.Left，Rect.Top，StrToInt（Item.SubItems [5]））;
结束;
//用户图片
NewRect：=矩形;
NewRect.Right：= Sender.Column [0] .WIDTH - 4; //为右对齐
NewRect.Left：= NewRect.Right - ImageList1.Width;
NewRect.Top：= NewRect.Top + 2;
NewRect.Bottom：= NewRect.Bottom;
Sender.Canvas.StretchDraw（NewRect，TGIFImage（Item.data））; //图像 - 除了用户
如果Item.SubItems [4]＆下;＆GT; '-' 然后
开始
NewRect：=矩形;
NewRect.Left：= NewRect.Left + ImageList1.Width; // StateImage后偏移
NewRect.Right：= NewRect.Left + ImageList1.Width;
NewRect.Top：= NewRect.Top + 4;
NewRect.Bottom：= NewRect.Bottom - 4;
Sender.Canvas.StretchDraw（NewRect，TGIFImage（TListView的（发送者）.Items [StrToInt（Item.SubItems [4]）] SubItems.Objects [1]））;
结束; // ---标题和文本--- //
x关：= Rect.Left;
对于i：= 1到的TListView（发件人）.Columns.Count-1做// 1,2,3,4,5,6
开始
x关：= x关+的TListView（发件人）.Columns [I-1] .WIDTH;
YOFF：= Rect.Top +（（ImageList1.Height-Canvas.TextHeight（'H'））DIV 2）;
如果xboolBlink或（Item.SubItems [2] =''）
然后sender.canvas.font.color：= clgray
否则sender.canvas.font.color：= clred;
的TextOut（x关，YOFF，Item.SubItems [I-1]）;
结束;
结束;
结束;程序TForm1.Timer1Timer（发件人：TObject的）;
{$ J +}
常量ICOUNT：红衣主教= 0;
{$ J-}
开始
INC（ICOUNT）;
如果（ICOUNT *的TTimer（发件人）.Interval）GT; 500则
开始//这是该分项[2]中含有眨眼的文字闪烁
xboolBlink：= NOT xboolBlink;
ICOUNT：= 0;
结束;
ListView1.Invalidate; //这是在动画画布的ListView
结束;
程序parselist（线路：字符串; VAR则strName，strUniqueID，图标：字符串）;
VAR
P，I：整数;
开始
I：= 0;
重复
病人：=波什（SEP，线）;
如果P＆LT;＆GT; 0，则
开始
公司（I）
的情况下，我
1：则strName：=复制（线，1，P - 1）;
2：strUniqueID：=复制（线，1，P - 1）;
3：图标：=复制（线，1，P - 1）;
结束;
删除（线，1，P +长度（9月） - 1）;
结束;
直到（i = 3）或（P = 0）或（线=''）
结束;
程序TForm1.AdditemClick（发件人：TObject的）;
VAR
I：整数;
行：字符串;
则strName，strUniqueID，图标：字符串;
strSelectedUID：字符串;
SL：TStringList中;
开始
如果ListView1.Selected＆LT;＆GT;零
然后strSelectedUID：= Listview1.Selected.SubItems [3]
否则strSelectedUID：='';
listview1.Items.BeginUpdate;
尝试
ListView1.Items.Clear;
最后
listview1.Items.EndUpdate;
结束;
如果分配（listms），然后
SL：= TStringList.Create;
开始
尝试
listms.Position：= 0;
Sl.LoadFromStream（listms）;
因为我：= 0到-1 SL.Count做
开始
行：= SL.Strings [I]
parselist（线路，则strName，strUniqueID，图标）;
boolblink：= TRUE;
Add_Item（则strName，ListView1的，图标，boolblink，strUniqueID，状态）;
结束;
最后
Sl.Free
结束;
listms.Free; 如果strSelectedUID＆LT;＆GT; '' 然后
开始
对于i：= 0至ListView1.Items.Count -1-
做，如果ListView1.Items [Ⅰ] .SubItems [3] = strSelectedUID
然后Listview1.Items [I] .Selected：= TRUE;
结束;
结束;
结束;
程序TForm1.AddToSTringlistFirstClick（发件人：TObject的）;
VAR
我：整数;
图片：串;
collectlist：Tcollectlist;
MS：内存流;
SL：TStringList中;
开始
collectlist：= Tcollectlist.Create;
SL：= TStringList.Create;
图片：= edit1.Text;
collectlist.Name：='Martinloanel';
collectlist.UniqueID：= StrToint（'5555'+ intTostr（1））;
collectlist.icon：=图像;
namelist.Add（collectlist）; 尝试
//收藏列表
因为我：= 0 namelist.Count - 1做
开始
collectlist：= Tcollectlist（namelist.Items [Ⅰ]）;
SL.Add（collectlist.Name + +九月IntToStr（collectlist.UniqueID）+月+ collectlist.icon + 9月）;
结束;
//发送列表
因为我：= 0 namelist.Count - 1做
开始
collectlist：= Tcollectlist（namelist.Items [Ⅰ]）;
如果（SL.Count大于0），那么
开始
MS：= TMemoryStream.Create;
listms：= TMemoryStream.Create;
尝试
SL.SaveToStream（MS）;
MS.Position：= 0;
listms.LoadFromStream（MS）; 最后
MS.Free;
结束;
结束;
结束;
最后
Sl.Free
结束;
结束;程序TForm1.Add_Item（strCaption：字符串; ListView控件：TListView的; strFile：字符串; boolBlink：布尔; strUniqueID：字符串; Currentstatus：字符串）;
VAR
项目：TListItem;
开始
Currentstatus：=状态;
开始
项目：= ListView1.Items.Add;
Item.Caption：='';
Item.SubItems.Add（strCaption）; // 0分项目
Item.SubItems.AddObject（IMA，无）; //子项目1
如果boolBlink
然后Item.SubItems.Add（'闪亮'）//子项目2
别的Item.SubItems.Add（''）; //子项目2
Item.SubItems.Add（strUniqueID）; //子项目3 // UniqueID的
的UniqueID：= strToint（strUniqueID）;
Item.SubItems.Add（' - '）; //子项目4 //下一步并按Idx用户（旁）
Item.SubItems.Add（Currentstatus）; //子项目5 // StateIdx
TURLDownload.Create（strFile，UpdateVisual，项目）;
结束;
结束; 程序TForm1.ExchangeClick（发件人：TObject的）;
开始
记录：= TRUE;
结束;程序TURLDownload.DoUpdateVisual;
开始
如果分配（FOnUpdateVisual），然后
FOnUpdateVisual（自考，FUserData，FGif）;
结束;procedure TURLDownload.Execute;
VAR
AMS：内存流;
hSession：HINTERNET;
hService：HINTERNET;
lpBuffer：字节数组的[0..1023]
dwBytesRead：DWORD;
dwBytesAvail：DWORD;
dwTimeOut：DWORD;
开始
FGif：= TGifImage.Create;
尝试
AMS：= TMemoryStream.Create;
hSession：= InternetOpen（'anyname'，INTERNET_OPEN_TYPE_ preCONFIG，零，零，0）;
如果未分配（hSession），然后退出;
尝试
hService：= InternetOpenUrl中（hSession，PChar类型（卷起），零，0，0，0）;
如果hService =零则
出口;
尝试
dwTimeOut：= 60000;
InternetSetOption（hService，INTERNET_OPTION_RECEIVE_TIMEOUT，@dwTimeOut，一下SizeOf（dwTimeOut））;
如果InternetQueryDataAvailable（hService，dwBytesAvail，0，0），那么
重复
如果不是的InternetReadFile（hService，@lpBuffer [0]，一下SizeOf（lpBuffer），dwBytesRead）然后
打破;
如果dwBytesRead＆LT;＆GT; 0，则
aMs.WriteBuffer（lpBuffer [0]，dwBytesRead）;
直到dwBytesRead = 0;
最后
InternetCloseHandle（hService）;
结束;
aMs.Position：= 0;
FGif.LoadFromStream（AMS）;
FGif.Transparent：= TRUE;
最后
aMs.Free;
InternetCloseHandle（hSession）;
结束;
如果分配（FOnUpdateVisual），然后
开始
同步（DoUpdateVisual）;
结束;
最后
FGif.Free;
结束;
结束;
程序TForm1.UpdateVisual（发件人：TObject的; AUserData：指针; VAR AImage：TGifImage）;
VAR
项目：TListItem;
我：整数;
开始
项目：= TListItem（AUserData）; 如果ListView1.Items.IndexOf（项目）= -1，那么
出口; Item.Data：= AImage;
AImage：=零;如果记录= True，那么
开始
对于i：= 0至ListView1.Items.Count -1-
做，如果ListView1.Items [Ⅰ] .SubItems [3] = IntToStr（UniqueID的）
然后
开始
ExchangeItems（ListView1的，Item.Index，0）;
ListView1.Invalidate;
结束;
结束;
结束;
结束。
解决方案
尝试更多的东西是这样的：
键入
TDownloadImageReadyEvent =过程（发件人：TObject的; AUserData：指针; VAR AImage：TGifImage）对象; TDownloadImage = A类（TThread类）
私人的
卷起：字符串;
FGif：TGifImage;
FOnImageReady：TDownloadImageReadyEvent;
FUserData：指针;
程序DoImageReady;
保护
程序执行;覆盖;
上市
构造函数创建（const的AUrl：字符串; AOnImageReady：TDownloadImageReadyEvent; AUserData：指针）;重新引入;
结束;构造TDownloadImage.Create（常量AUrl：字符串; AOnImageReady：TDownloadImageReadyEvent; AUserData：指针）;
开始
继承创建（假）;
FreeOnTerminate：= TRUE;
卷起：= AUrl;
FOnImageReady：= AOnImageReady;
FUserData：= AUserData;
结束;程序TDownloadImage.Execute;
VAR
AMS：内存流;
aIdHttp：TIdHttp;
开始
FGif：= TGifImage.Create;
尝试
AMS：= TMemoryStream.Create;
尝试
aIdHttp：= TIdHttp.Create（无）;
尝试
aIdHttp.Request.UserAgent：='的Mozilla / 5.0（Windows NT的6.1; WOW64; RV：12.0）的Gecko / 20100101火狐/ 12.0';
aIdHttp.Get（卷起，AMS）;
最后
aIdHttp.Free;
结束;
aMs.Position：= 0;
FGif.LoadFromStream（AMS）;
FGif.Transparent：= TRUE;
最后
aMs.Free;
结束;
如果分配（FOnImageReady），然后
同步（DoImageReady）;
结束;
最后
FGif.Free;
结束;
结束;程序TDownloadImage.DoImageReady;
开始
如果分配（FOnImageReady），然后
FOnImageReady（自考，FUserData，FGif）;
结束;
程序TForm1.Add_Item（常量strCaption，strFile，strUniqueID：字符串）;
VAR
项目：TListItem;
开始
项目：= ListView1.Items.Add;
Item.Caption：='';
Item.SubItems.Add（strCaption）; // 0分项目
Item.SubItems.Add（'IMA'）; //子项目1
Item.SubItems.Add（strUniqueID）; //子项目2 //客户端ID
Item.SubItems.Add（' - '）; //子项目3 //下一步并按Idx用户（旁）
Item.Data：=零;
TDownloadImage.Create（strFile，ImageReady中，项目）;
结束;程序TForm1.ListView1Deletion（发件人：TObject的;项目：TListItem）;
开始
TGifImage（Item.Data）。免费;
结束;过程TForm1.Button1Click（发件人：TObject的）;
VAR
STRNAME，图像，strUniqueID：字符串;
开始
STRNAME：='苦参碱';
图片：= ...;
strUniqueID：= ...;
Add_Item（STRNAME，图像，strUniqueID）;
结束;程序TForm1.ImageReady（发件人：TObject的; AUserData：指针; VAR AImage：TGifImage）;
VAR
项目：TListItem;
我：整数;
sClientID：字符串;
开始
项目：= TListItem（AUserData）; 如果ListView1.Items.IndexOf（项目）= -1，那么
出口; Item.Data：= AImage;
AImage：=零; 如果Streamin然后
开始
sClientID：= IntToStr（IDCLIENT）;
对于i：= 0 ListView1.Items.Count - 1做
开始
如果ListView.Items [Ⅰ] .SubItems [3] = sClientID然后
开始
ExchangeItems（ListView1的，Item.Index，0）;
出口;
结束;
结束;
结束;
结束;
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] <> '-') 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.
解决方案
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;
这篇关于如何更新内螺纹ListView项指标的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
查看全文
