Solved

If you do this, you get the points.

Posted on 2000-04-15
9
153 Views
Last Modified: 2010-04-04
This is a rephrase of a previous question. I have a COMBOBOX Vcl that I'm set on using in my project. I will be using it. I'm aware there are components that do this, and I'm aware there are examples of this certain places. See the two example pictures at:
http://www.users.uswest.net/~psyreal/delphi/

I want to do this (through code) with a normal combobox.

If you don't want to do the work please don't answer. If you can make a form look like this with a normal combobox, then that is the code I need. It can't just "look" like it. It needs to function the same.

Thanks people!

-Psylord
0
Comment
Question by:Psylord
9 Comments
 
LVL 1

Expert Comment

by:DValery
ID: 2719951
I saw like this freeware component on:
http://www.torry.ru/
0
 

Author Comment

by:Psylord
ID: 2719986
hehe
You don't understand. I don't WANT a component. I WANT to use the one I already have. But thanks for the try.

-Psylord
0
 
LVL 10

Expert Comment

by:Lischke
ID: 2720057
Hi Psylord,

despite you rephrased the question, it hasn' become clearer... Actually, what you want (I think) is code to enumerate the shell's name space. Is this so? All the other stuff (icons, indentation etc.) is just some additional execercise.

Ciao, Mike
0
Networking for the Cloud Era

Join Microsoft and Riverbed for a discussion and demonstration of enhancements to SteelConnect:
-One-click orchestration and cloud connectivity in Azure environments
-Tight integration of SD-WAN and WAN optimization capabilities
-Scalability and resiliency equal to a data center

 

Author Comment

by:Psylord
ID: 2720113
Mike,
Well... Some people were trying to point me to components etc... I don't want to use a special component for this, and I have my reasons why. Y=ou said exactly what I wanted (I think).

THe problem is I'm not good enough to sort through piles of code and try to decipher them for my own needs... I can expect a lexure at this point but I assure you it's not needed.

I realize it's a lot of work to do... And I'm taking my chances trying to get someone to genrously donate some time to me. I will increase the points to this question as soon as my other ones are gone and I get the points back I'm not trying to rip anyone off.

You seem to have quite a bit of knowledge about the subject and I would appreciate any attempts you can make at answering this how I've explained.

Regards,
-Psylord
0
 
LVL 2

Expert Comment

by:hhamster
ID: 2720250
Have you looked at other components with source code?

I often (re)write components by my own, but there is realy a lot of them with the source code, so you can see whats the job to do and what are the directions to go when writing your own.

One of the best freeware collection is the Rx Library (www.rxlib.com) which is all in source code.

Such things you are attending to do are to complex to to it by this way (on an advice site). It's not one specific question which can be answered in some liitle code example (look at the guidelines on asking questions on this site). So, you can find a person here which will help you in doing this job or look at the sugested thinkgs (in this case - components) that people suggest to you.

Best whishes in solving your problem.
0
 
LVL 10

Expert Comment

by:ptmcomp
ID: 2720859
If you want to, you can write a owner draw combobox. In the Delphi help there is a good example.
To fill up your combo you have to call some shell commands, e.g: SHGetFileInfo.
ptm.
0
 
LVL 3

Expert Comment

by:bryan7
ID: 2721498
yep it's not a short code.. you have to manage getting all the drives etc ( as I saw in the gif ) and the icons using SHGetFileInfo, unless you want to use your own icons.. it's not so easy, not too difficult though
0
 
LVL 2

Accepted Solution

by:
mullet_attack earned 20 total points
ID: 2721643
Ok, here's some code that may help you out.

Form1 has button2, Imagelist1, and combobox1 on it.

It's not great code, but it works. I cheated on the icons for the drives, i should have used GetNormalIcon(ProperPath), instead of hardcoding GetNormalIcon('c:\') for each drive.

However, the code does show the use of SHGetFileInfo and owner-draw combo as ptmcomp mentioned.

Mark






unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, ShellAPI, ShlObj,ActiveX, ImgList, Spin, ExtCtrls ;

type
  PComboItem = ^TComboItem;
  TComboItem = record
    IconIndex : integer;
    sFolder : IShellFolder;
    id : PItemIDList;
    Level : integer;
  end;

  TForm1 = class(TForm)
    imaglst: TImageList;
    ComboBox1: TComboBox;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure ComboBox1DrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
  private
    FWinDir: string;
    procedure DoSubItems(ParentItem: PComboItem);
    function GetNormalIcon(Path: string): integer;
    function GetIcon(pidl: PItemIDList): integer;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Desktop : IShellFolder;
  ppMalloc: IMalloc;

implementation

{$R *.DFM}


procedure TForm1.FormCreate(Sender: TObject);
var
  sfi: TShFileInfo;
begin
  try
    SetLength(FWinDir, MAX_PATH);
    Setlength(FWinDir, GetWindowsDirectory(PChar(FWinDir), MAX_PATH));
    FWinDir := FWinDir + '\';
    ImagLst.Handle := SHGetFileInfo(PChar(FWinDir), 0, sfi, sizeOf(sfi),
      SHGFI_SYSICONINDEX or SHGFI_SMALLICON or SHGFI_ICONLOCATION);
    ImagLst.ShareImages := True;
    ImagLst.BlendColor := clHighLight;
  finally
  end;

end;

function TForm1.GetIcon(pidl: PItemIDList): integer;
var
  sfi: TShFileInfo;
begin
  SHGetFileInfo(PChar(PIDL), 0, sfi, SizeOf(TSHFileInfo),
    SHGFI_SYSICONINDEX or SHGFI_SMALLICON or SHGFI_PIDL);
  Result := sfi.iIcon;
end; {GetNormalIcon}


function TForm1.GetNormalIcon(Path: string): integer;
var
  sfi: TShFileInfo;
begin
  SHGetFileInfo(Pchar(Path), 0, sfi, SizeOf(TSHFileInfo),
    SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
  Result := sfi.iIcon;
end; {GetNormalIcon}

procedure TForm1.Button2Click(Sender: TObject);
var
 DesktopItem : PComboItem;
 idDesktop : PItemIDList;
 sfi: TSHFileInfo;
begin
  SHGetMalloc(ppMalloc);
  SHGetDesktopFolder( Desktop );
  DesktopItem := new(PComboItem);
  DesktopItem^.sFolder := Desktop;
  DesktopItem^.Level := 0;
  combobox1.items.AddObject('Desktop',TObject(DesktopItem));
  if SHGetSpecialFolderLocation(Handle, CSIDL_DESKTOP, idDesktop) = NOERROR then
    if SHGetFileInfo(PChar(idDesktop), 0, Sfi, SizeOf(TSHFileInfo), SHGFI_PIDL
      or
      SHGFI_SYSICONINDEX or SHGFI_SMALLICON or SHGFI_DISPLAYNAME) <> 0 then
    begin
      DesktopItem^.IconIndex := Sfi.iIcon;
    end;
   DoSubItems(DeskTopItem);
end;

procedure TForm1.ComboBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  Icon : TBitmap;
  ComboItem : TComboItem;
  srcRect, destRect : TRect;
begin
  with control as TComboBox do
    begin
      ComboItem := PComboItem(items.Objects[Index])^;
      try
        icon := tbitmap.create;
      ImagLst.GetBitmap(ComboItem.IconIndex, Icon);
     canvas.fillrect(rect);
     srcRect.left := 0;
     srcRect.top := 0;;
     srcRect.right := ImagLst.width;
     srcRect.bottom := ImagLst.Height;
     destRect := Rect;
     destRect.left :=  (ComboItem.level * 16);
     destRect.right := destRect.left + srcRect.right;
     destRect.bottom := destRect.top + srcRect.bottom;

      Canvas.Copyrect(destRect,Icon.canvas,srcRect);
      canvas.textout(destRect.right, destRect.top, items[index]);
      finally
      icon.free;
      end;
    end;
end;


procedure TForm1.DoSubItems(ParentItem: PComboItem);
var
  EnumIDList : IEnumIDList;
  fetched : ULONG;
  pidl : PItemIDList;
  MyNode : TTreeNode;
  Name: TStrRet;
  DisplayName : string;
  psfi: TSHFileInfo;
  ShellFolder : IShellFolder;
  tempComboItem : PComboItem;
  fullpath : array[0..Max_path] of char;
      idNetwork: PItemIDList;
  IndentLevel : integer;
type
  PSTRRet = ^TStrRet;
  _STRRET = record
     uType: UINT;              { One of the STRRET_* values }
     case Integer of
       0: (pOleStr: LPWSTR);                    { must be freed by caller of GetDisplayNameOf }
//       1: (pStr: LPSTR);                        { NOT USED }
       1: (uOffset: UINT);                      { Offset into SHITEMID (ANSI) }
       2: (cStr: array[0..MAX_PATH-1] of Char); { Buffer to fill in }
    end;
  TStrRet = _STRRET;
begin
  IndentLevel := pComboItem(ParentItem)^.Level + 1;
 ShellFolder := IShellFolder(pComboItem(ParentItem)^.sFolder);
 if ShellFolder.EnumObjects(handle,SHCONTF_FOLDERS,EnumIDList) = NOERROR then
   begin
     While EnumIDList.next(1, pidl, Fetched) <> S_FALSE do
       begin
         ShellFolder.GetDisplayNameOf(pidl,SHGDN_NORMAL, Name);
         case Name.uType of
            STRRET_WSTR : DisplayName := name.pOLEStr;
            STRRET_OFFSET :
              begin
                SHGetFileInfo(PChar(pidl), 0, psfi, sizeof(TSHFileInfo), SHGFI_PIDL
                      or SHGFI_SYSICONINDEX or SHGFI_SMALLICON or SHGFI_DISPLAYNAME);
                DisplayName := psfi.szDisplayName;
              end;
            STRRET_CSTR : DisplayName := name.cStr;
         end;
         ppMalloc.free(Name.pOleStr); // just in case
         Application.processmessages;
         tempComboItem := new(PComboItem);
         tempComboItem^.Level := IndentLevel;
         ShellFolder.BindToObject(pidl, nil, IID_IShellFolder, tempComboItem^.sFolder);
         ComboBox1.items.addObject(DisplayName, TObject(tempComboItem));
         if Pos(':',DisplayName) > 0 then
           begin
             tempComboItem^.IconIndex := GetNormalIcon('c:\');
           end
         else
         tempComboItem^.IconIndex := GetIcon(pidl);
         if DisplayName = 'My Computer' then
           DoSubItems(tempComboItem);
      end;
    end;
end;


end.

0
 

Author Comment

by:Psylord
ID: 2724326
mullet_attack,

MUCH APPRECIATED. Thanks millions. This is exactly what I've been looking for... It needs a bit of work, but it's a start... I think I can figure the rest out after a bit of reading etc. If not, I'll just port here again. :)

Thanks for actually taking the time to do the work.
0

Featured Post

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usua…
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…

821 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