[pylsar]

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

[poli-smen]

Сообщение от pylsar

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

С этой проблемой я тоже когда-то столкнулся. Если один вариант кода нормально отображает иконки на XP, то на Win7 не отображает или отображает криво. А другой вариант кода наоборот - нормально отображает иконки на Win7, но не отображает иконки на XP. К сожалению универсального метода мне не удалось сделать. В той программе я просто проверял версию винды и выполнял соответствующий код, но если есть более корректное решение, мне бы тоже хотельось его узнать...

[angvelem]

Всё очень просто, замени при вызове GetIcon

Код:

    node.ImageIndex := TreeView1.Images.AddIcon(GetIcon(s));
    node.SelectedIndex := TreeView1.Images.AddIcon(GetIcon(s));

на

Код:

    node.ImageIndex := TreeView1.Images.AddIcon(GetIcon(s + '\'));
    node.SelectedIndex := TreeView1.Images.AddIcon(GetIcon(s + '\'));

[pylsar]

спасибо

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

И... хочу привязать nodы Treeview к PageControl, tabSheets (tabvisible) в false при этом. Возможно ли так сделать ? с видимыми tabaми легко.

Код:

 PageControl1.TabIndex:=TreeView2.Selected.Index;

[giv_main]

Мне помогла установка битности компонента ImageList

Код:

TreeView1.Images.ColorDepth := cd32Bit;