Показать сообщение отдельно
  #1  
Старый 04.10.2012, 23:16
pylsar pylsar вне форума
Прохожий
 
Регистрация: 11.02.2012
Сообщения: 18
Репутация: 10
По умолчанию TreeView и системные иконки

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