| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

TreeView и системные иконки [D7, XP]

qwerty123 ©   (2012-10-04 23:30:00) 

Компилировал на win7 отображались системные иконки дисков, сейчас на хр скомпилировал - пусто.
В чём может быть причина ?

function GetIcon(const FileName: string; const IconType: TIconType = itSmall):
 TIcon;
var
 FileInfo: TShFileInfo;
 ImageList: TImageList;
 IT: DWORD;
begin
 IT := SHGFI_SMALLICON;
 Result := TIcon.Create;
 ImageList := TImageList.Create(nil);
 if (IconType = itLarge) then
 begin
   IT := SHGFI_LARGEICON;
   ImageList.Height := 32;
   ImageList.Width := 32;
 end;
 FillChar(FileInfo, Sizeof(FileInfo), #0);
 ImageList.ShareImages := true;
 ImageList.Handle := SHGetFileInfo(
   PChar(FileName),
   SFGAO_SHARE,
   FileInfo,
   sizeof(FileInfo),
   IT or SHGFI_SYSICONINDEX
   );
 ImageList.GetIcon(FileInfo.iIcon, Result);
 ImageList.Free;
end;


procedure TForm4.FormCreate(Sender: TObject);
var
 c : char;
 s : string;
 node: TTreeNode;
 DriveType: integer;
begin
 TreeView1.Items.BeginUpdate;
 TreeView1.Images := TImageList.CreateSize(16,16);
 for c := 'A' to 'Z' do
 begin
   s := c + ':';
   DriveType := GetDriveType(PChar(s));
   if DriveType = 1 then
     continue;
   node := TreeView1.Items.AddChild(nil, s);
   node.ImageIndex := TreeView1.Images.AddIcon(GetIcon(s));
   node.SelectedIndex := TreeView1.Images.AddIcon(GetIcon(s));
   node.HasChildren := true;
 end;
 TreeView1.Items.EndUpdate;
end;

procedure NextLevel(ParentNode: TTreeNode);

 function DirectoryName(name: string): boolean;
 begin
   result := (name > '.') and (name > '..');
 end;

var
 sr, srChild: TSearchRec;
 node: TTreeNode;
 path: string;
begin
 node := ParentNode;
 path := '';
 repeat
   path := node.Text + '\' + path;
   node := node.Parent;
 until
   node = nil;
 if FindFirst(path + '*.*', faDirectory, sr) = 0 then
 begin
   repeat
     if (sr.Attr and faDirectory > 0) and DirectoryName(sr.name) then
     begin
       node := Form4.TreeView1.Items.AddChild(ParentNode, sr.name);
       node.ImageIndex := 0;
       node.SelectedIndex := 1;
       node.HasChildren := false;
       if FindFirst(path + sr.name + '\*.*', faDirectory, srChild) = 0 then
       begin
         repeat
           if (srChild.Attr and faDirectory > 0) and
           DirectoryName(srChild.name) then
             node.HasChildren := true;
         until
           (FindNext(srChild) > 0) or node.HasChildren;
       end;
       FindClose(srChild);
     end;
   until
     FindNext(sr) > 0;
 end
 else
 ParentNode.HasChildren := false;
 FindClose(sr);
end;

И еще вопрос. Выводил в win7 системную иконку в tpicture, края объекта иконки сглаженные, а при выводе в treeview не сглаженные углы, ступеньчатые. Что посоветуете сделать ?

---

qwerty123   (2012-10-08 20:49:00) [1]

вообщем разобрался с "исчезновением", теперь второй вопрос почему теряется сглаженность значка при ассоциации его с древом ? Вывел Tpicture, всё нормально.
http://s019.radikal.ru/i629/1210/26/6b43870eb8ac.jpg

---

DVM   (2012-10-05 12:41:00) [2]

> qwerty123   (04.10.12 23:30) 

Возьми вот этот потомок TImageList реализующий доступ к SysImageList:

http://www.delphiarea.com/products/delphi-components/sysimage/

---

kilkennycat   (2012-10-05 11:08:00) [3]

> на win7 отображались системные иконки дисков, сейчас на
> хр скомпилировал - пусто.

пусто- это неинформативно. SHGetFileInfo что возвращает?
и зачем так мучать имаджелист?
ну и http://msdn.microsoft.com/en-us/library/windows/desktop/bb762179%28v=vs.85%29.aspxчитай

---

Наверх