Delphi SysListView32 Component?

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 : https://www.experts-exchange.com/questions/27301770/Need-working-code-for-getting-TProgressBar-on-TListView.html

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.

Select allOpen 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

Select allOpen 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.

Select allOpen in new window

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.

Select allOpen in new window

Thanks VahaC.

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

https://www.experts-exchange.com/questions/27301770/Need-working-code-for-getting-TProgressBar-on-TListView.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 :)

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

remove '.txt' appended to file names which extensions are not allowed by ExEx (what a pain in the @$$ by the way)

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.