Using the Win95 Shell functions (eg IShellLink)

I have just writen some code which uses the ShellObj and ShellUtl units
- download from (http://ourworld.compuserve.com/homepages/PRitchey/delphipg.htm)
to implement a "Send To" menu like the MS office products.  Unfortunately I have been unable
to extract the icons from a Shortcut with any degree of success. The following code does it,
but the icons come out looking rather poor. Any Ideas ?

Matthew Holmes

---
type
  TSHFileInfo = record
    hIcon : HICON;
    iIcon : integer;
    dwAttributes : DWORD;
    szDisplayName : array [1..MAX_PATH] of Char;
    szTypeName : array[1..80] of Char;
    end;
  PTSHFileInfo = ^TSHFileInfo;
const
  NO_TILES = 18;
  sUntitled  = 'Untitled.MAP';
  SHGFI_ICON              = $000000100;     // get icon
  SHGFI_DISPLAYNAME       = $000000200;     // get display name
  SHGFI_TYPENAME          = $000000400;     // get type name
  SHGFI_ATTRIBUTES        = $000000800;     // get attributes
  SHGFI_ICONLOCATION      = $000001000;     // get icon location
  SHGFI_EXETYPE           = $000002000;     // return exe type
  SHGFI_SYSICONINDEX      = $000004000;     // get system icon index
  SHGFI_LINKOVERLAY       = $000008000;     // put a link overlay on icon
  SHGFI_SELECTED          = $000010000;     // show icon in selected state
  SHGFI_LARGEICON         = $000000000;     // get large icon
  SHGFI_SMALLICON         = $000000001;     // get small icon
  SHGFI_OPENICON          = $000000002;     // get open icon
  SHGFI_SHELLICONSIZE     = $000000004;     // get shell size icon
  SHGFI_PIDL              = $000000008;     // pszPath is a pidl
  SHGFI_USEFILEATTRIBUTES = $000000010;     // use passed dwFileAttribute

function SHGetFileInfo(szPath : PChar;FileAttr : DWORD; pSHFI : PTSHFileInfo;
           cbSHFI,uFlags :integer ) : integer; stdcall;
           external 'SHELL32.DLL' name 'SHGetFileInfoA';

function  ExtractIconA(hInst : LongInt;szExeName : PChar;nIconIndex : UINT)
    : HICON; stdcall; external 'Shell32.DLL';

procedure TForm1.BuildSendToMenu;
  var
    I,J,nSavedDC : integer;
    miTemp : TMenuItem;
    hres : HResult;
    iidSendTo : PITEMIDLIST;
    szPath : Array [0..MAX_PATH] of Char;
    sName : string;
    SearchRec : TSearchRec;
    SHFI : TSHFILEINFO;
    pSHFI : PTSHFileInfo;
    hbmIcon : HBITMAP;
    hdcMem : HDC;
    hbr  : HBRUSH;
    hIcon : HICON;
    il : integer;
  begin
  {build the Send To Menu}
  hres := SHGetSpecialFolderLocation(Handle,CSIDL_SENDTO,iidSendTo);
  hbr := CreateSolidBrush(GetSysColor(COLOR_MENU));
  ssSendTo := TStringList.Create;
  if (SHGetPathFromIDList(iidSendTo, szPath)) then
    begin
    I := FindFirst(szPath + '\*.LNK',faAnyFile,SearchRec);
    J := 0;
    while (I = 0) do
      begin
      sName := StrPas(szPath) + '\' + SearchRec.Name;
      miTemp := TMenuItem.Create(FileSendTo);
      miTemp.Caption := ChangeFileExt(ExtractFileName(sName),'');
      miTemp.Tag := J;
      miTemp.OnClick := EvSendToClick;
      miTemp.Visible := True;
      FileSendTo.Add(miTemp);

      { Now create the icon bitmap }
      pSHFI := @SHFI;
      SHGetFileInfo(PChar(sName),0,pSHFI,sizeof(TSHFileInfo),
        SHGFI_ICONLOCATION);

      hIcon := ExtractIconA(hInstance,@(SHFI.szDisplayName[1]),SHFI.iIcon);
      if (hIcon <> 0) then
        begin
        hbmIcon := CreateCompatibleBitmap(Canvas.Handle,16,16);
        hdcMem := CreateCompatibleDC(Canvas.Handle);
        nSavedDC := SaveDC(hdcMem);
        SelectObject(hdcMem,hbmIcon);
        SelectObject(hdcMem,GetStockObject(NULL_PEN));
        SelectObject(hdcMem,hbr);
        Rectangle(hdcMem,0,0,16,16);
        DrawIconEx(hdcMem,0,0,hIcon,16,16,0,hbr,0);
        DestroyIcon(hIcon);
        RestoreDC(hdcMem,nSavedDC);
        DeleteDC(hdcMem);

        ssSendTo.AddObject(ResolveIt(Handle,PChar(sName)),Pointer(hbmIcon));
        end;
      INC(J);
      I := FindNext(SearchRec);
      end;
    for J := 0 to ssSendTo.Count - 1 do
      SetMenuItemBitmaps(FileSendTo.Handle,J,MF_BYPOSITION,
        HBITMAP(ssSendTo.Objects[J]),HBITMAP(ssSendTo.Objects[J]));
    FileSendTo.Enabled := True;
    end;
  DeleteObject(hbr);
  end;