Solved

Delphi SysListView32 Component?

Posted on 2011-09-11
9
953 Views
Last Modified: 2012-05-12
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.
0
Comment
Question by:Lester_Clayton
  • 3
  • 3
  • 2
  • +1
9 Comments
 
LVL 37

Accepted Solution

by:
Geert Gruwez earned 250 total points
ID: 36519355
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
 
LVL 9

Author Comment

by:Lester_Clayton
ID: 36519414
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
 
LVL 25

Assisted Solution

by:epasquier
epasquier earned 250 total points
ID: 36519867
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
PRTG Network Monitor: Intuitive Network Monitoring

Network Monitoring is essential to ensure that computer systems and network devices are running. Use PRTG to monitor LANs, servers, websites, applications and devices, bandwidth, virtual environments, remote systems, IoT, and many more. PRTG is easy to set up & use.

 
LVL 3

Expert Comment

by:VahaC
ID: 36527767
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
 
LVL 3

Expert Comment

by:VahaC
ID: 36528114
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
 
LVL 9

Author Comment

by:Lester_Clayton
ID: 36528503
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
 
LVL 25

Expert Comment

by:epasquier
ID: 36529290
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
 
LVL 25

Expert Comment

by:epasquier
ID: 36529301
remove '.txt' appended to file names which extensions are not allowed by ExEx (what a pain in the @$$ by the way)
0
 
LVL 9

Author Closing Comment

by:Lester_Clayton
ID: 36529403
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

Featured Post

Complete VMware vSphere® ESX(i) & Hyper-V Backup

Capture your entire system, including the host, with patented disk imaging integrated with VMware VADP / Microsoft VSS and RCT. RTOs is as low as 15 seconds with Acronis Active Restore™. You can enjoy unlimited P2V/V2V migrations from any source (even from a different hypervisor)

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Introduction I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi database…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
Along with being a a promotional video for my three-day Annielytics Dashboard Seminor, this Micro Tutorial is an intro to Google Analytics API data.
Email security requires an ever evolving service that stays up to date with counter-evolving threats. The Email Laundry perform Research and Development to ensure their email security service evolves faster than cyber criminals. We apply our Threat…

777 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question