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