(probably) found a bug with ShellObj.GetIcon

delphi package - easy access to shell apis
Post Reply
Logikmensch
Posts: 17
Joined: Fri Jun 30, 2006 4:26 am
Location: Germany

(probably) found a bug with ShellObj.GetIcon

Post by Logikmensch »

Hi!

I don't know for sure, but I have a problem with the icon size for some shell objects. They appear to be 32x32 even if I use GetIcon(16). Folders and some special objects work perfectly. Here is my updated TreeView listing which now works pretty much like Explorer, but it shows also the files.

I also found that Desktop.Description gives an empty string on my machine (WinXP Prof.), so I use .Name in that case.

Do you have any idea what's going wrong here?

Code: Select all

unit Unit1;

interface

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


type
  TForm1 = class(TForm)
    TreeView1: TTreeView;
    procedure TreeView1Expanding(Sender: TObject; Node: TTreeNode;
      var AllowExpansion: Boolean);
    procedure TreeView1AdvancedCustomDrawItem(Sender: TCustomTreeView;
      Node: TTreeNode; State: TCustomDrawState; Stage: TCustomDrawStage;
      var PaintImages, DefaultDraw: Boolean);
    procedure FormCreate(Sender: TObject);
  private
    { Private-Deklarationen }
    first:boolean;
    treeitems:array of IShellObj;
    procedure addnode(node:TTreeNode; ishell:IShellObj);
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.addnode;
//Creates a folder/file node and adds a ShellObj element in the TREEITEMS array
var
  index:integer;
  newnode:TTreeNode;
begin
  //add new item to TREEITEMS array
  index:=length(treeitems);
  setlength(treeitems,index+1);
  treeitems[index]:=ishell;
  //create a corresponding node and hold the index of the TREEITEMS-item in
  //node.data
  with treeitems[index] do
    if length(description)>0 then node:=TreeView1.Items.AddChild(node,Description)
      else node:=TreeView1.Items.AddChild(node,name); //** Desktop's description is empty! **
  if node<>nil then begin
    node.Data:=pointer(index);
    if treeitems[index].itemcount>0 then begin
      //Add a dummy child to the node to get a '+' before the tree item.
      //That dummy child is replaced by sub-items when the node is expanded.
      newnode:=TreeView1.Items.AddChild(node,'*');
      newnode.Data:=pointer(-1);
    end; {if}
  end; {if}
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  node,newnode:TTreeNode;
begin
  //initialize the tree and create any of the roots.
  setlength(treeitems,0);
  addnode(nil,Desktop);
end;

procedure TForm1.TreeView1AdvancedCustomDrawItem(Sender: TCustomTreeView;
  Node: TTreeNode; State: TCustomDrawState; Stage: TCustomDrawStage;
  var PaintImages, DefaultDraw: Boolean);
var
  rect:TRect;
  icon:TIcon;
  iss:IShellObj;
begin
  if node<>nil then begin
    rect:=node.DisplayRect(true);
    with treeview1.Canvas do begin
      brush.Color:=clYellow;
      brush.Style:=bsSolid;
      rect.Right:=rect.Right+16;
      textrect(rect,rect.Left+16+2,rect.Top+2,node.text);
      if integer(node.Data)>=0 then begin
        iss:=treeitems[integer(node.Data)];
        icon:=TIcon.Create;
        icon.Handle:=iss.geticon(16);
        draw(rect.Left,rect.Top,icon); //Sometimes 32x32!!!
        icon.Free;
      end; {if}
    end; {with}
  end; {if}
end;

procedure TForm1.TreeView1Expanding(Sender: TObject; Node: TTreeNode;
  var AllowExpansion: Boolean);
var
  i,index:integer;
  iss:IShellObj;
  newnode:TTreeNode;
begin
  if (not first) and (node<>nil) then begin
    //Zuerst den Dummy, falls vorhanden, löschen:
    if node.HasChildren and (node.getFirstChild.text='*') then begin
      node.DeleteChildren;
      if integer(node.data)>=0 then begin
        //Nun die Unter-Items bestimmen und anhängen:
        iss:=treeitems[integer(node.Data)];
        if iss.itemcount>0 then begin
          for i:=0 to iss.ItemCount-1 do
            addnode(node,iss.Items[i]);
        end; {if}
      end; {if}
    end; {if}
  end; {if}
end;

end.
madshi
Site Admin
Posts: 10753
Joined: Sun Mar 21, 2004 5:25 pm

Post by madshi »

What kind of shell objects do you get incorrect icon sizes for? Some examples? If I can reproduce it here, a fix should be no problem.

About description: Is it *always* empty or just sometimes?
Logikmensch
Posts: 17
Joined: Fri Jun 30, 2006 4:26 am
Location: Germany

Post by Logikmensch »

Hi madshi, :D

For example, DOC, XLS or MDB files, lying on my desktop, have 32x32 icons. Folders are okay. But PDF files, INI files, etc. have wrong icon. Seems to be anything that is a registered file. On the other hand, EXE files are okay; also - when I use GetIcon(32), all icons are coming okay with 32x32 pixels. BTW, the desktop has abviosly no icon anyway.

Well, I know how to get the correct sized icon from the ShellAPI, but as there's such a nice Function in madShell, it would be great if it works perfectly... :wink:

About the missing desktop description: Not really a problem, because the desktop is a fix point in the system. So also the missing Icon would be not a real problem - I can draw it for my own.

Kind regards,

Claus.

P.S.: Also the other madCollection routines are very, very professional and work fine. especially the string routines are very useful!
Logikmensch
Posts: 17
Joined: Fri Jun 30, 2006 4:26 am
Location: Germany

Post by Logikmensch »

If you want to see the wrong size effect, simply run my example Treeview program - you only need a VCL form and a Treeview-object on it and associate the object methods...
Logikmensch
Posts: 17
Joined: Fri Jun 30, 2006 4:26 am
Location: Germany

Post by Logikmensch »

Hello again!

I also tried a shrinking routine using a bitmap to shrink the icon from always 32x32 to 16x16, but very often this doesn't look like very nice...

Code: Select all

procedure TForm1.TreeView1AdvancedCustomDrawItem(Sender: TCustomTreeView;
  Node: TTreeNode; State: TCustomDrawState; Stage: TCustomDrawStage;
  var PaintImages, DefaultDraw: Boolean);
var
  rect:TRect;
  icon:TIcon;
  iss:IShellObj;
  bmp:TBitmap;
begin
  if node<>nil then begin
    rect:=node.DisplayRect(true);
    with treeview1.Canvas do begin
      brush.Color:=clWindow;
      brush.Style:=bsSolid;
      rect.Right:=rect.Right+16;
      textrect(rect,rect.Left+16+2,rect.Top+2,node.text);
      if integer(node.Data)>=0 then begin
        iss:=treeitems[integer(node.Data)];
        icon:=TIcon.Create;
        icon.Handle:=iss.geticon(32);
        bmp:=TBitmap.create;
        with bmp do begin
          canvas.Brush.Color:=clWindow;
          width:=32;
          height:=32;
          canvas.Draw(0,0,icon);
          canvas.StretchDraw(classes.rect(0,0,16,16),bmp);
          width:=16;
          height:=16;
        end; {with}
        draw(rect.left,rect.Top,bmp);
        bmp.Free;
        icon.Free;
      end; {if}
    end; {with}
  end; {if}
end;
Did you find any bug in your code already?

Thanks in advance for your help.

Claus.
Logikmensch
Posts: 17
Joined: Fri Jun 30, 2006 4:26 am
Location: Germany

Post by Logikmensch »

Here's my workaround to the GetSize(16) bug, which uses the ShellAPI unit and calculates the correct icons for all programs, folders, system folders etc. Also, Desktop gets it correct icon that way. :D :D But I still do not know for sure that this method works properly on all operating systems, but to the best of my knowledge it does. I'm using the SHGetFileInfo routine that calculates always the correct small-icons. Here is my final update of my Treeview program with correct displayed icons:

Code: Select all

procedure TForm1.TreeView1AdvancedCustomDrawItem(Sender: TCustomTreeView;
  Node: TTreeNode; State: TCustomDrawState; Stage: TCustomDrawStage;
  var PaintImages, DefaultDraw: Boolean);
var
  rect:TRect;
  icon:TIcon;
  iss:IShellObj;
  sfi:TSHFILEINFO;
begin
  if node<>nil then begin
    rect:=node.DisplayRect(true);
    with treeview1.Canvas do begin
      brush.Color:=clWindow;
      brush.Style:=bsSolid;
      rect.Right:=rect.Right+16;
      textrect(rect,rect.Left+16+2,rect.Top+2,node.text);
      if integer(node.Data)>=0 then begin
        iss:=treeitems[integer(node.Data)];
        if SHGetFileInfo(PChar(iss.path), 0, sfi, SizeOf(sfi), SHGFI_ICON or
          SHGFI_SMALLICON) <> 0 then begin
          icon:=TIcon.Create;
          Icon.Handle := sfi.hIcon;
          draw(rect.left,rect.Top,icon);
          icon.Free;
        end; {if}
      end; {if}
    end; {with}
  end; {if}
end;
Kindest regards,

Claus.
madshi
Site Admin
Posts: 10753
Joined: Sun Mar 21, 2004 5:25 pm

Post by madshi »

Problem fixed:

http://madshi.net/madCollectionBeta.exe

The problem was rather a bug in Windows' own behaviour. But I've worked around it now.
Logikmensch
Posts: 17
Joined: Fri Jun 30, 2006 4:26 am
Location: Germany

Post by Logikmensch »

Oh, thanks,

I'll download it today evening. I'm very happy you might fixed it!!! :D

Kind regards,

Claus.
madshi
Site Admin
Posts: 10753
Joined: Sun Mar 21, 2004 5:25 pm

Post by madshi »

Please check your spam filter. It seems that my emails don't come through to you - at least not all of them.
Logikmensch
Posts: 17
Joined: Fri Jun 30, 2006 4:26 am
Location: Germany

Post by Logikmensch »

Thanks for the tip. But indeed, the email did not came through my spam filter... May be filtered out by my provider. So my apologize for the inconveniences.

But good news: Anything works perfectly now. I also tested it on Windows 98 and XP. Correct icons and texts. I suppose you will make a regular release of madCollection next time.

So thanks for the good (and fast) work!

Claus.
Post Reply