TVirtualDrawtree

[mrmarman]

when i back to hotel i handle it for you.

[mia]

thank you very much mrmarman , here is the latest work to save your time when you come back to hotel

[mrmarman]

Hi again...

This is the rebuilded and tested code by me.

Kod: Tümünü seç

Var
  xGIF : TGIFImage;
    MS : TMemoryStream;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  ListView1.OwnerDraw := True;
  MS   := TMemoryStream.Create;
  if xGIF = nil then begin
    xGif := TGIFImage.Create;
    try
      IdHTTP1.get('http://i1236.photobucket.com/albums/ff447/mrmarman/avatar4zs.gif',MS);
      Ms.Seek(0, soFromBeginning);
      xGIF.LoadFromStream(MS);
      xGIF.Animate := True;
    finally
      FreeAndNil(MS);
    end;
  end;
  Caption := 'Animation Disabled';
  Timer1.Interval := 100;
  Timer1.Enabled  := NOT Timer1.Enabled;
end;

procedure TForm1.ListView1CustomDraw(Sender: TCustomListView;
  const ARect: TRect; var DefaultDraw: Boolean);
Const
  aLeftMargin = 10;
  aTopMargin  = 30;
  aWidth      = 50;
  aHeight     = 50;
begin
  if xGIF <> Nil
    then Sender.Canvas.StretchDraw(Rect(aLeftMargin, aTopMargin, aWidth+aLeftMargin, aHeight+aTopMargin), xGIF );
end;

The code below is ratio fixed enlarge or small image.

Kod: Tümünü seç

Var
  xGIF : TGIFImage;
    MS : TMemoryStream;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  ListView1.OwnerDraw := True;
  MS   := TMemoryStream.Create;
  if xGIF = nil then begin
    xGif := TGIFImage.Create;
    try
      IdHttp1.Get('http://laughingsquid.com/wp-content/uploads/tumblr_mekph2vuHq1rllcopo1_500.gif', MS);
    //IdHTTP1.get('http://i1236.photobucket.com/albums/ff447/mrmarman/avatar4zs.gif',MS);
      Ms.Seek(0, soFromBeginning);
      xGIF.LoadFromStream(MS);
      xGIF.Animate := True;
      xGIF.PaletteModified := True;
    finally
      FreeAndNil(MS);
    end;
  end;
  Caption := 'Animation Disabled';
  Timer1.Interval := 100;
  Timer1.Enabled  := NOT Timer1.Enabled;
end;

procedure TForm1.ListView1CustomDraw(Sender: TCustomListView;
  const ARect: TRect; var DefaultDraw: Boolean);
Const
  aLeftMargin = 10;
  aTopMargin  = 10;
  aWidth      = 120;  // 74 x 67
Var
  aHeight : Integer;
  aRatio : Real;
begin
  if xGIF <> Nil then
  begin
    aRatio  := xGIF.Width / xGIF.Height;
    aHeight := Trunc( aWidth / aRatio );
    Sender.Canvas.StretchDraw(Rect(aLeftMargin, aTopMargin, aWidth+aLeftMargin, aHeight+aTopMargin), xGIF );
  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if TTimer(Sender).Enabled
    then Caption := 'Animation Enabled';
  ListView1.Repaint;
end;

[mia]

thats not working mrmarman take time when you finish your real life i know you much busy iam not harry for solve . when you go home please check up the attachment up there

[mrmarman]

Try this message attachment please...

[mia]

but i tried to combine this with project attached up there i got no changes weird

[mia]

i dont get it do i have to get ride of this ? and make on on draw custome ?

Kod: Tümünü seç

procedure TForm1.ListView1DrawItem(Sender: TCustomListView; Item: TListItem;
  Rect: TRect; State: TOwnerDrawState);
Var
  xOff, yOff : Integer;
  R: TRect;
  i : Integer;
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 ) );
      GradientFillCanvas(Sender.Canvas, SlightlyDark(panel1.Color), SlightlyDark(panel1.Color), R, gdhorizontal); // GraphUtil
      SetRect(R, Rect.Left, Rect.Bottom-( (Rect.Bottom-Rect.Top) div 2 ), Rect.Right, Rect.Bottom );
      GradientFillCanvas(Sender.Canvas, SlightlyDark(panel1.Color), SlightlyDark(panel1.Color), R, gdhorizontal);
      Sender.Canvas.Brush.Style := bsClear;
      Sender.Canvas.Pen.Color   := SlightlyDark(panel1.Color);
      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;
    Sender.Canvas.Brush.Style := bsClear;
    // Image
    xOff := Rect.Left + ((TListView(Sender).Columns[0].Width  - TGIFImage( Item.SubItems.Objects[1]).Width ) div 2);
    yOff := Rect.Top  + ((ImageList1.Height - TGIFImage( Item.SubItems.Objects[1]).Height) div 2);
      Draw( xOff, yOff, TGIFImage( Item.SubItems.Objects[1]) );

    // Caption and Text
    xOff := Rect.Left;
    for i := 1 to TListView(sender).Columns.Count - 1 do
    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 TextOut( xOff, yOff, Item.SubItems[i-1] );
    end;

  end;
end;

[mrmarman]

Please try this, make under remark the DRAW statement to replace STRETCHDRAW statement showing below.

EDIT :project is attached to the message.

Kod: Tümünü seç

Var
  NewRect : TRect;
begin
...
...
...
...
    //Sender.Canvas.Draw( xOff, yOff, TGIFImage( Item.SubItems.Objects[1]) );
    NewRect := Rect;
    NewRect.Right := ImageList1.Width;
      Sender.Canvas.StretchDraw( NewRect, TGIFImage( Item.SubItems.Objects[1]) );
...
...     

[mia]

yes its get small but selection is out of image its only select the text and there is no spacing between items

[mrmarman]

If you want to add indent, change NewRect values like this...

Kod: Tümünü seç

    NewRect := Rect;
      NewRect.Right  := Sender.Column[0].Width - 4;
      NewRect.Top    := NewRect.Top    + 4;
      NewRect.Left   := NewRect.Left   + 4;
      NewRect.Bottom := NewRect.Bottom - 4;
    Sender.Canvas.StretchDraw( NewRect, TGIFImage( Item.SubItems.Objects[1]) );

[mrmarman]

You only change the ImageList1's width and height the other ones resizes automatically also according their width/height ratio

[mia]

it wooooorkssss you are a herooooooooooooooooooooooo its enough for today i have too many question coming up in my mind now i will ask it later i really thank your Patience you are a great person in this world

[mrmarman]

You're welcome.
You were a good student and you also have worked very well on this work.

[mia]

you are great teacher , now i have to circle back to the questions , lets say i use listbox for many users and some user dont have image url can i put default image for him from imagelist1 as exampe i store an icon in imagelist1 called 0 can i define image to the item if images empty here is the current add item procedure

Kod: Tümünü seç

Procedure TForm1.Add_Item( strCaption: String; ListView : TListView; strFile: String; boolBlink : Boolean );
Var
  MS : TMemoryStream;
begin
  MS := TMemoryStream.Create;
  download.get(strFile, ms);// start downloading file to stream
  Ms.Seek(0,soFromBeginning);
  if ExtractFileExt(strFile) = '.gif' then  // if image is gif
begin
  aGIF := TGifImage.Create;
  aGIF.LoadFromStream(MS);
  aGIF.Transparent := True;
  With ListView.Items.Add do
  begin
    Caption   := '';
    SubItems.Add( strCaption ); // subitem 0
    SubItems.AddObject( 'IMA', TObject( aGif ) ); // subitem 1
    if boolBlink
      then  SubItems.Add( 'blink' ) // subitem 2
      else  SubItems.Add( '' );     // subitem 2
      SubItems.Add('123456');
  end;
end;


if ExtractFileExt(strFile) = '.jpg' then // if image jpg
begin
  jpg := TJPEGImage.Create;
  jpg.LoadFromStream(MS);
  With ListView.Items.Add do
  begin
    Caption   := '';
    SubItems.Add( strCaption ); // subitem 0
    SubItems.AddObject( 'IMA', TObject( jpg ) ); // subitem 1
    if boolBlink
      then  SubItems.Add( 'blink' ) // subitem 2
      else  SubItems.Add( '' );     // subitem 2
      SubItems.Add('123456');
  end;
end;

if ExtractFileExt(strFile) = '.png' then //if image png
begin
  png := TPngImage.Create;
  png.LoadFromStream(MS);
  With ListView.Items.Add do
  begin
    Caption   := '';
    SubItems.Add( strCaption ); // subitem 0
    SubItems.AddObject( 'IMA', TObject( png ) ); // subitem 1
    if boolBlink
      then  SubItems.Add( 'blink' ) // subitem 2
      else  SubItems.Add( '' );     // subitem 2
      SubItems.Add('123456');
  end;
end;

  // DO NOT Free this image because now it is a SubItems[1] Object
  FreeAndNil(MS);
end;

[mrmarman]

lets say i use listbox for many users and some user dont have image url can i put default image for him from imagelist1 as exampe i store an icon in imagelist1 called 0 can i define image to the item if images empty here is the current add item procedure

Sure you can.
You may add an image as resource to your project. instead of ReadFromStream you can use ReadFromResource to access that image every where you want.