Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2013.04.14;
Скачать: CL | DM;

Вниз

TreeView и системные иконки   Найти похожие ветки 

 
qwerty123   (2012-10-04 23:30) [0]

Компилировал на 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 не сглаженные углы, ступеньчатые. Что посоветуете сделать ?


 
kilkennycat ©   (2012-10-05 11:08) [1]


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

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


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


> qwerty123   (04.10.12 23:30) 

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

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


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

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



Страницы: 1 вся ветка

Текущий архив: 2013.04.14;
Скачать: CL | DM;

Наверх




Память: 0.48 MB
Время: 0.009 c
15-1356035402
Юрий
2012-12-21 00:30
2013.04.14
С днем рождения ! 21 декабря 2012 пятница


15-1355571069
OLEG1963LORA
2012-12-15 15:31
2013.04.14
Аппаратное обеспечение


15-1355814263
alexdn
2012-12-18 11:04
2013.04.14
Фон в пхп


15-1355847254
dummy_user
2012-12-18 20:14
2013.04.14
Как сделать удобный Dispose TList?


15-1355754563
Vegeta
2012-12-17 18:29
2013.04.14
Проблема с доступом к этому сайту