Пишу ФТП-браузер (курсач себе такой придумал) Необходимо отображать при выводе файлов сервера соответствующию иконку. Пытаюсь вытащить иконки из реестра(DefaultIcon), но:
1) Не для всех расширений существует данное свойство.
2) При формировании списка в TImageList происходит нечто странное - часть иконок имеет совсем не тот вид, который должен быть на самом деле(Скорее всего я где то ошибся, но голова сейчас уже не соображает ни чего).
Вот код поиска иконок:
| Код |
type
PExtInfo = ^TExtInfo;
TExtInfo = record
Ext, IconPath: string[255];
IconIndex: integer;
end;
TExtentionsInfo = class(TList)
private
function Get(Index: Integer): PExtInfo;
procedure Put(Index: Integer; const Value: PExtInfo);
public
procedure Clear; override;
function Add(const Ext, IconPath: string; const IconIndex: integer): Integer;
function Extract(Item: Pointer): PExtInfo;
function First: PExtInfo;
function Last: PExtInfo;
property Items[Index: Integer]: PExtInfo read Get write Put; default;
end;
TExistExtentions = class(TObject)
private
FReg: TRegistry;
protected
FResult: TExtentionsInfo;
public
constructor Create;
destructor Destroy; override;
procedure EnumExtentions; virtual;
property ExistExtentionsInfo: TExtentionsInfo read FResult;
end;
TIconSize = (is16, is32);
TExistExtentionsIconList = class(TExistExtentions)
private
FIconList: TImageList;
FIconSize: TIconSize;
procedure SetIconSize(const Value: TIconSize);
public
constructor Create;
destructor Destroy; override;
procedure EnumExtentions; override;
property IconList: TImageList read FIconList;
property IconSize: TIconSize read FIconSize write SetIconSize;
end;
...
procedure TExistExtentions.EnumExtentions;
function PathExists(const List: TList; const Path: string): Boolean;
var
i: integer;
begin
Result := False;
for i := 0 to List.Count - 1 do
if AnsiCompareStr(PExtInfo(List.Items[i]).IconPath, Path) = 0 then
begin
Result := True;
Break;
end;
end;
var
Keys: TStringList;
Counter, SeparatorPos,
IconIndex, PathLen: integer;
DefValue, DefIconPath: string;
begin
FResult.Clear;
with FReg do
begin
RootKey := HKEY_CLASSES_ROOT;
Keys := TStringList.Create;
try
if OpenKeyReadOnly('') then
begin
GetKeyNames(Keys);
CloseKey;
Counter := Keys.Count - 1;
while (Counter >= 0) do
begin
if (AnsiCompareStr(Keys[Counter][1], '.') = 0) and
(OpenKeyReadOnly(Keys[Counter])) then
try
DefValue := ReadString('');
if (DefValue <> '') and
(not PathExists(FResult, DefValue)) then
FResult.Add(Keys[Counter], DefValue, 0);
finally
CloseKey;
end;
Dec(Counter);
end;
Counter := FResult.Count - 1;
while Counter >= 0 do
begin
if OpenKeyReadOnly(PExtInfo(FResult[Counter]).IconPath) then
try
if KeyExists('DefaultIcon') then
begin
CloseKey;
if OpenKeyReadOnly(FResult[Counter].IconPath + '\DefaultIcon\') then
begin
DefIconPath := ReadString('');
if (DefIconPath <> '') and
(not PathExists(FResult, DefIconPath)) then
begin
SeparatorPos := Pos(',', DefIconPath);
IconIndex := 0;
if SeparatorPos <> 0 then
begin
Inc(SeparatorPos);
PathLen := Length(DefIconPath);
IconIndex := StrToInt(Copy(DefIconPath, SeparatorPos, PathLen - SeparatorPos + 1));
Dec(SeparatorPos, 2);
DefIconPath := Copy(DefIconPath, 1, SeparatorPos);
end;
FResult[Counter].IconPath := DefIconPath;
FResult[Counter].IconIndex := IconIndex;
end;
end;
end
else
FResult.Delete(Counter);
finally
CloseKey;
end;
Dec(Counter);
end;
end;
finally
FreeAndNil(Keys);
end;
end;
end;
...
procedure TExistExtentionsIconList.EnumExtentions;
var
i: integer;
Icon, DefaultIcon: TIcon;
IconPath: PAnsiChar;
begin
inherited;
FIconList.Clear;
Icon := TIcon.Create;
DefaultIcon := TIcon.Create;
DefaultIcon.Handle := ExtractIcon(hInstance, 'shell32.dll', 0);
GetMem(IconPath, 256);
ZeroMemory(IconPath, 256);
try
for i := 0 to FResult.Count - 1 do
if FileExists(FResult[i].IconPath) then
begin
StrPCopy(IconPath, FResult[i].IconPath);
Icon.Handle := ExtractIcon(hInstance, IconPath,
FResult[i].IconIndex);
FIconList.AddIcon(Icon);
end
else
FIconList.AddIcon(DefaultIcon);
finally
FreeMem(IconPath, 256);
FreeAndNil(DefaultIcon);
FreeAndNil(Icon);
end;
end;
|
Где я ошибся?
P.S. Шорошо бы иметь возможность найти все иконки(Может какая WinAPI функция есть для этого?). |
И не возится с системными а забить свои тем более есть свобода выбора.