Delphi SysListView32 Component?

I'm trying to write nice applications which allow me to use Progress bars in List Views, and I've noticed using WinSpy that FileZilla uses the SysListView32 Class for its queue list, and eMule uses it for it's active uploads.  I'm wondering if it's possible for me to use the SysListView32 class in my Delphi applications, and if it is possible, how I'd go about doing it.

I'm running Delphi XE2.

Thanks in Advance.
LVL 9
Lester_ClaytonAsked:
Who is Participating?
 
Geert GOracle dbaCommented:
just get a good component pack like DevExpress or TMS
http://www.devexpress.com
http://www.tmssoftware.com/site/

check the quantumgrid ... progressbar or almost any component available in any cell
  even a dropdown quantumgrid inside a cell of the quantumgrid
0
 
Lester_ClaytonAuthor Commented:
Thanks.  I already own the TMS Component Suite.  Unfortunately, the Progress Bar is one it draws using CustomDraw rather than a TProgressBar component.  I'm using this right now.  The downside to this is that TMS Component Suite at time of writing does not compile to 64 bit, and the Progress Bar is not as good looking as the Win32 themed Progress Bar.

This Quantumgrid sounds interesting, I'll check it out.

I have another question on EE which prompted this one : http://www.experts-exchange.com/Programming/Languages/Pascal/Delphi/Q_27301770.html
0
 
Emmanuel PASQUIERFreelance Project ManagerCommented:
here is a post about how to use sysListView32 and other shell components with Delphi.

They are part of samples that come with Delphi

http://stackoverflow.com/questions/6956995/updates-for-controls-in-win3-1-palette/6957661#6957661
0
Get your problem seen by more experts

Be seen. Boost your question’s priority for more expert views and faster solutions

 
VahaCCommented:
try this example

mainU.pas

unit mainU;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    ListView1: TListView;
    Timer1: TTimer;
    procedure ListView1AdvancedCustomDrawSubItem(Sender: TCustomListView;
      Item: TListItem; SubItem: Integer; State: TCustomDrawState;
      Stage: TCustomDrawStage; var DefaultDraw: Boolean);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses drawprogressU;

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
  I: Integer;
begin
  for I := 0 to 99 do
    with ListView1.Items.Add do
    begin
      Caption := Format('Item %d', [I]);
      SubItems.Add(Format('Description %d', [I]));
      SubItems.Add(Format('%d', [I]));
    end;
end;

procedure TForm1.ListView1AdvancedCustomDrawSubItem(Sender: TCustomListView;
  Item: TListItem; SubItem: Integer; State: TCustomDrawState;
  Stage: TCustomDrawStage; var DefaultDraw: Boolean);
var r, pr: TRect;
    ratio: cardinal;
    psz: Int64;
    txt: string;
    percent: Integer;
begin
  if (SubItem = 2) and (Stage = cdPostPaint) then
  begin
    Percent := StrToIntDef(Item.SubItems[SubItem - 1], 0);

    SetBkMode(Sender.Canvas.Handle, TRANSPARENT);

    r := Item.DisplayRect(drBounds);
    r.Left := Sender.Column[0].Width + Sender.Column[1].Width;
    r.Right := r.Left + Sender.Column[2].Width;
    Sender.Canvas.TextOut(r.Left + Sender.Canvas.TextWidth('1'), r.Top + 2, IntToStr(Percent) + '%');

    pr.Left := r.Left + Sender.Canvas.TextWidth('100% ');
    pr.Right := r.Right - 2;
    pr.Top := r.Top + 2;
    pr.Bottom := r.Bottom - 2;

    DrawProgress(Sender.Canvas, pr, Percent, clLime);
    Exit;
  end;
end;

end.

Open in new window


mainU.dfm

object Form1: TForm1
  Left = 719
  Top = 185
  Caption = 'Form1'
  ClientHeight = 352
  ClientWidth = 473
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  DesignSize = (
    473
    352)
  PixelsPerInch = 96
  TextHeight = 13
  object ListView1: TListView
    Left = 4
    Top = 4
    Width = 465
    Height = 345
    Anchors = [akLeft, akTop, akRight, akBottom]
    Columns = <
      item
        Caption = 'Name'
        Width = 80
      end
      item
        Caption = 'Desc'
        Width = 150
      end
      item
        AutoSize = True
        Caption = 'Progress'
      end>
    DoubleBuffered = True
    ReadOnly = True
    RowSelect = True
    ParentDoubleBuffered = False
    TabOrder = 0
    ViewStyle = vsReport
    OnAdvancedCustomDrawSubItem = ListView1AdvancedCustomDrawSubItem
  end
  object Timer1: TTimer
    Interval = 200
    Left = 232
    Top = 180
  end
end

Open in new window


drawprogressU.pas

unit drawprogressU;

interface

uses
  SysUtils, Classes, Windows, Graphics;

procedure DrawProgress(Canvas: TCanvas; dr: TRect; Pos: integer; Color: TColor);

implementation

function Blend(Color1, Color2: TColor; Value: Byte): TColor;
var
  i: LongInt;
  r1, g1, b1, r2, g2, b2: Byte;
begin
  Value := Round(2.56 * Value);
  i := ColorToRGB(Color2);
  r1 := Byte(i);
  g1 := Byte(i shr 8);
  b1 := Byte(i shr 16);
  i := ColorToRGB(Color1);
  r2 := Byte(i);
  g2 := Byte(i shr 8);
  b2 := Byte(i shr 16);
  r1 := Byte((Value * (r2 - r1)) shr 8 + r1);
  g1 := Byte((Value * (g2 - g1)) shr 8 + g1);
  b1 := Byte((Value * (b2 - b1)) shr 8 + b1);
  Result := (b1 shl 16) + (g1 shl 8) + r1;
end;

procedure SmoothGradient(Canvas: TCanvas; const ARect: TRect; const c1: TColor;
  const Gray: boolean);
type
  PRGB = ^TRGB;

  TRGB = record
    b, g, r: Byte;
  end;

  PRGBArray = ^TRGBArray;
  TRGBArray = array [0 .. 65565] of TRGB;
var
  rc1, gc1, bc1, rc2, gc2, bc2, rc3, gc3, bc3, rc4, gc4, bc4: integer;
  x, y, w, h: integer;
  i, w1, w2, h1, sp, sm: integer;
  Row: PRGBArray;
  C, AC: TRGB;
  slMain, slSize, slPtr: integer;
  Color, tc: integer;
  Profil: array of TRGB;
  r, g, b: integer;
  bmp: TBitmap;
begin
  if ((ARect.Right - ARect.Left) - 1 <= 0) or
    ((ARect.Bottom - ARect.Top) - 1 <= 1) then
    Exit;
  bmp := TBitmap.Create;
  bmp.PixelFormat := pf24Bit;
  bmp.Width := (ARect.Right - ARect.Left) - 1;
  bmp.Height := (ARect.Bottom - ARect.Top) - 1;
  h := bmp.Height;
  w := bmp.Width;
  SetLength(Profil, h);
  Color := ColorToRGB(c1);
  if Gray then
  begin
    rc1 := 253;
    gc1 := 253;
    bc1 := 253;
    rc2 := 218;
    gc2 := 218;
    bc2 := 218;
    rc3 := 160;
    gc3 := 160;
    bc3 := 160;
    rc4 := 213;
    gc4 := 213;
    bc4 := 213;
  end
  else
  begin
    tc := Blend(Color, clWhite, 5);
    rc1 := Byte(tc);
    gc1 := Byte(tc shr 8);
    bc1 := Byte(tc shr 16);
    tc := Blend(Color, clWhite, 50);
    rc2 := Byte(tc);
    gc2 := Byte(tc shr 8);
    bc2 := Byte(tc shr 16);
    tc := Blend(Color, clBlack, 60);
    rc3 := Byte(tc);
    gc3 := Byte(tc shr 8);
    bc3 := Byte(tc shr 16);
    tc := Blend(Color, clBlack, 80);
    rc4 := Byte(tc);
    gc4 := Byte(tc shr 8);
    bc4 := Byte(tc shr 16);
  end;
  sp := Trunc(h / 2.5);
  y := sp;
  for i := 0 to y - 1 do
  begin
    C.r := Byte(rc1 + (((rc2 - rc1) * (i)) div y));
    C.g := Byte(gc1 + (((gc2 - gc1) * (i)) div y));
    C.b := Byte(bc1 + (((bc2 - bc1) * (i)) div y));
    Profil[i] := C;
  end;
  for i := y to h - 1 do
  begin
    C.r := Byte(rc3 + (((rc4 - rc3) * (i)) div h));
    C.g := Byte(gc3 + (((gc4 - gc3) * (i)) div h));
    C.b := Byte(bc3 + (((bc4 - bc3) * (i)) div h));
    Profil[i] := C;
  end;
  if Gray then
  begin
    rc1 := 200;
    gc1 := 200;
    bc1 := 200;
    rc2 := 253;
    gc2 := 253;
    bc2 := 253;
  end
  else
  begin
    tc := Blend(Color, clBlack, 50);
    rc1 := Byte(tc);
    gc1 := Byte(tc shr 8);
    bc1 := Byte(tc shr 16);
    tc := Blend(Color, clWhite, 50);
    rc2 := Byte(tc);
    gc2 := Byte(tc shr 8);
    bc2 := Byte(tc shr 16);
  end;
  w1 := w - 1;
  w := (w shr 1) + (w and 1);
  slMain := integer(bmp.ScanLine[0]);
  slSize := integer(bmp.ScanLine[1]) - slMain;
  h1 := h shr 1;
  w2 := 25;
  for x := 0 to w - 1 do
  begin
    if x < w2 then
    begin
      C.b := Byte(bc1 + (((bc2 - bc1) * x) div w2));
      C.g := Byte(gc1 + (((gc2 - gc1) * x) div w2));
      C.r := Byte(rc1 + (((rc2 - rc1) * x) div w2));
    end
    else
    begin
      C.b := bc2;
      C.g := gc2;
      C.r := rc2;
    end;
    slPtr := slMain;
    for y := 0 to h - 1 do
    begin
      Row := PRGBArray(slPtr);
      r := Profil[y].r;
      g := Profil[y].g;
      b := Profil[y].b;
      if (x = 0) or ((y < sp) or (y = h - 1)) then
      begin
        if x = 0 then
          sm := 3
        else
          sm := 2;
        Row[x].r := Byte((C.r - r) shr sm + r);
        Row[x].g := Byte((C.g - g) shr sm + g);
        Row[x].b := Byte((C.b - b) shr sm + b);
      end
      else
      begin
        Row[x].r := Byte((C.r - r) div 2 + r);
        Row[x].g := Byte((C.g - g) div 2 + g);
        Row[x].b := Byte((C.b - b) div 2 + b);
      end;
      if (x < (w1 - x)) then
        Row[w1 - x] := Row[x];
      slPtr := slPtr + slSize;
    end;
  end;
  Profil := nil;
  Canvas.Draw(ARect.Left, ARect.Top, bmp);
  FreeAndNil(bmp);
end;

procedure DrawProgress(Canvas: TCanvas; dr: TRect; Pos: integer; Color: TColor);
const
  FPercentage=true;
var
  r: TRect;
  TempBmp: TBitmap;
  C: TColor;
begin
  TempBmp := TBitmap.Create;
  C := Blend(clWhite, clSilver, 50);

  With TempBmp do
  begin
    PixelFormat := pf24Bit;
    Width := dr.Right - dr.Left;
    Height := dr.Bottom - dr.Top;
    Canvas.Brush.Style := bsSolid;
    Canvas.Pen.Color := $00A0A0A0;
    r := Rect(0, 0, Width, Height);
    Canvas.Rectangle(r);
    Canvas.Pen.Color := clSilver;
    Canvas.MoveTo(1, 0);
    Canvas.LineTo(r.Right - 1, r.Top);
    Canvas.Pixels[r.Left, r.Top] := C;
    Canvas.Pixels[r.Left, r.Bottom - 1] := C;
    Canvas.Pixels[r.Right - 1, r.Top] := C;
    Canvas.Pixels[r.Right - 1, r.Bottom - 1] := C;
  end;

  r.Left := 1;
  r.Top := 1;
  SmoothGradient(TempBmp.Canvas, r, Color, True);
  r.Right := Round((dr.Right - dr.Left) / 100 * Pos);
  if r.Right > 0 then SmoothGradient(TempBmp.Canvas, r, Color, False);
  TempBmp.Canvas.Brush.Style := bsSolid;
  Canvas.CopyMode := cmSrcCopy;
  Canvas.Draw(dr.Left, dr.Top, TempBmp);

  TempBmp.Free;
end;

end.

Open in new window

0
 
VahaCCommented:
i`ve modified  mainU.pas

here is new one

unit mainU;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    ListView1: TListView;
    Timer1: TTimer;
    procedure ListView1AdvancedCustomDrawSubItem(Sender: TCustomListView;
      Item: TListItem; SubItem: Integer; State: TCustomDrawState;
      Stage: TCustomDrawStage; var DefaultDraw: Boolean);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses drawprogressU;

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
  I: Integer;
begin
  for I := 0 to 100 do
    with ListView1.Items.Add do
    begin
      Caption := Format('Item %d', [I]);
      SubItems.Add(Format('Description %d', [I]));
      Data := Pointer(I);
    end;
end;

procedure TForm1.ListView1AdvancedCustomDrawSubItem(Sender: TCustomListView;
  Item: TListItem; SubItem: Integer; State: TCustomDrawState;
  Stage: TCustomDrawStage; var DefaultDraw: Boolean);
const
  ProgressBarCol = 2;
var
  Rct, PBRct: TRect;
  Percent: Integer;
  I: Integer;
begin
  if (SubItem = ProgressBarCol) and (Stage = cdPostPaint) then
  begin
    Percent := Integer(Item.Data);
    SetBkMode(Sender.Canvas.Handle, TRANSPARENT);

    Rct := Item.DisplayRect(drBounds);
    for I := 0 to SubItem - 1 do
      Rct.Left := Rct.Left + Sender.Column[I].Width;
    Rct.Right := Rct.Left + Sender.Column[SubItem].Width;
    Sender.Canvas.TextOut(Rct.Left + 2, Rct.Top + 2, IntToStr(Percent) + '%');

    PBRct.Left := Rct.Left + Sender.Canvas.TextWidth('1000% ');
    PBRct.Right := Rct.Right - 2;
    PBRct.Top := Rct.Top + 2;
    PBRct.Bottom := Rct.Bottom - 2;

    if PBRct.Right > PBRct.Left then
      DrawProgress(Sender.Canvas, PBRct, Percent, clLime);
  end
end;

end.

Open in new window

0
 
Lester_ClaytonAuthor Commented:
Thanks VahaC.

Can you please do me a favour and post this answer on my other question.

http://www.experts-exchange.com/Programming/Languages/Pascal/Delphi/Q_27301770.html

I'll award you the full 500 points on that question.

This question however specifically asked if it's possible to implement sysListView32.  There's been some really good replies and I think it's only fair to share the points with other posters, who have been very helpful.  You on the other hand, will get the full points on the other question :)
0
 
Emmanuel PASQUIERFreelance Project ManagerCommented:
Hi Lester, I'm wondering if you still need help here on this subject. Have you found vclshlctrls.dpk and linked source files ?

for me it's there :
E:\Documents\RAD Studio\Samples\Delphi\VCL\ShellControls

Here, I suppose I can post it, it's par of DEMO source from Borland, no one should complain
ShellControls.zip
0
 
Emmanuel PASQUIERFreelance Project ManagerCommented:
remove '.txt' appended to file names which extensions are not allowed by ExEx (what a pain in the @$$ by the way)
0
 
Lester_ClaytonAuthor Commented:
Both selected comments were very helpful in finding components which helped me with some great ideas, so I've split the points evenly.

I ended up however using VahaC's solution, for which he was awarded in a related question I had asked.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.