Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
?
Solved

Delphi SysListView32 Component?

Posted on 2011-09-11
9
Medium Priority
?
1,023 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 38

Accepted Solution

by:
Geert Gruwez earned 1000 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 1000 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
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
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

Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

Question has a verified solution.

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

Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
Introduction The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small print…
this video summaries big data hadoop online training demo (http://onlineitguru.com/big-data-hadoop-online-training-placement.html) , and covers basics in big data hadoop .
Despite its rising prevalence in the business world, "the cloud" is still misunderstood. Some companies still believe common misconceptions about lack of security in cloud solutions and many misuses of cloud storage options still occur every day. …

569 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