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]