Solved

Delphi SysListView32 Component?

Posted on 2011-09-11
9
939 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 36

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
 
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
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 
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

Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

Join & Write a Comment

Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
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…
It is a freely distributed piece of software for such tasks as photo retouching, image composition and image authoring. It works on many operating systems, in many languages.
This video demonstrates how to create an example email signature rule for a department in a company using CodeTwo Exchange Rules. The signature will be inserted beneath users' latest emails in conversations and will be displayed in users' Sent Items…

706 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

Need Help in Real-Time?

Connect with top rated Experts

18 Experts available now in Live!

Get 1:1 Help Now