Сохранение иконки

← →
Tahion (2003-01-11 02:38) [0]

Есть файл, который содержит в себе несколько 32bpp иконок (icl, dll, exe). Нужно сохранить из него иконку с номером Х в отдельный ico файл. Как такое делается?

P.S. Желательно, чтоб при сохранении не терялось 32bpp (даже не в ХР) и сохранялись все форматы иконок (т.е. 16*16, 24*24...) которые есь в иконке.

← →
Бандерлоги (2003-01-11 04:17) [1]

ExtractIconEx (ExtractIcon) =>
GetIconInfo => _IconInfo => 2*Bitmap = Bitmap

← →
Tahion (2003-01-11 07:08) [2]

А подробнее можно?

← →
Tahion (2003-01-11 15:52) [3]

Ну, народ, очень надо.

← →
Набережных С. (2003-01-11 18:24) [4]

Icon: TIcon;
Icon.Handle:=LoadIcon
Icon.SaveToFile

← →
Бандерлоги © (2003-01-11 22:23) [5]

procedure TMainForm.Button1Click(Sender: TObject);
var
IconIndex: Integer;
AnIconHandle: HICON;
AnIcon: TIcon;
Old: Pointer;
begin
AnIcon := TIcon.Create;
Old := AnIcon; // сомневаюсь чего-то, правильно ли здесь with TOpenDialog.Create(Self) do
try
if Execute then
begin
IconIndex := 0;
repeat
AnIconHandle := ExtractIcon(HInstance,PChar(FileName), IconIndex);
if (AnIconHandle <> 1) and (AnIconHandle <> 0) then
begin
AnIcon.Handle := AnIconHandle;
Canvas.StretchDraw(Bounds(IconIndex*64,0,64,64),AnIcon);
AnIcon.SaveToFile("F:\Documents\" + ExtractFileName(FileName)
+ " Icon#" + IntToStr(IconIndex) + ".ico");
Inc(IconIndex);
end
until (AnIconHandle = 0) or (AnIconHandle = 1);
end;
finally
Free;
AnIcon := Old; // сомневаюсь чего-то, правильно ли здесь
AnIcon.Free;
end;
end;

← →
Tahion (2003-01-11 22:32) [6]

Описание:
function LoadIcon(Instance: THandle; IconName: PChar): HIcon;

Загpужает поименованный pесуpс пиктогpаммы.

Паpаметpы:
Instance: Экземпляp модуля, исполнимый файл котоpого содеpжит пиктогpамму или 0 для пpедопpеделенной пиктогpаммы.
IconName: Стpока или имя целочисленного идентификатоpа или пpедопpеделенная пиктогpамма, опpеделенная одной из констант idi_.

Возвpащаемое значение:
В случае успешного завеpшения - идентификатоp пиктогpаммы; 0 - в пpотивном случае. Для получения расширенной информации об ошибке вызовите функцию GetLastError.

idi_:
IDI_APPLICATION - стандартная пиктограмма для приложения
IDI_HAND - "стоп"
IDI_QUESTION - "вопросительный знак"
IDI_EXCLAMATION - "восклицательный знак"
IDI_ASTERISK - "информация"
IDI_WINLOGO - "Лого Windows"

И все! А мне надо иконку из файла, а не стандартную для диалога...

← →
Tahion (2003-01-11 23:31) [7]

Спасибо Бандерлоги, но теперь нужно круче: так чтоб иконки охранялись в том цвете, в котором они есть, и так, чтоб сохранялись все размеры, которые есть в иконке (если их несколько)

Если кто может помочь с переводом из Си в Делфи, то у меня есть пример. Напишите на tahion@ukrpost.net - я вышлю.

← →
Бандерлоги © (2003-01-12 13:20) [8]

> так чтоб иконки охранялись в том цвете, в котором они есть

??? Дак и так...

> чтоб сохранялись все размеры, которые есть в иконке (если их
> несколько)

Должно подойти:

procedure TMainForm.Button1Click(Sender: TObject);
var
IconIndex: Integer;
IconLarge: HICON;
IconSmall: HICON;
AnIcon: TIcon;
Old: Pointer;

procedure SaveIcon(H: HICON; FileName: string; Large: boolean = true);
const Prfx: array [False..True] of string = (" Small", " Large");
begin
AnIcon.Handle := H;
Canvas.StretchDraw(Bounds(IconIndex*64,64*Ord(Large),64,64),AnIcon);
AnIcon.SaveToFile("F:\Documents\" + ExtractFileName(FileName) + Prfx[Large] + " Icon#" + IntToStr(IconIndex) + ".ico");
end;

begin
AnIcon := TIcon.Create;
Old := AnIcon;
with TOpenDialog.Create(Self) do
try
if Execute then
begin
IconIndex := 0;
while
ExtractIconEx(PChar(FileName), IconIndex, IconLarge, IconSmall,1) <> 0 do
begin
SaveIcon(IconLarge, FileName);
SaveIcon(IconSmall, FileName, False);
Inc(IconIndex);
end;
end;
finally
Free;
AnIcon := Old;
AnIcon.Free;
end;
end;

← →
Tahion (2003-01-12 22:23) [9]

> так чтоб иконки охранялись в том цвете, в котором они есть

>>??? Дак и так...

У меня из 32bpp извратил в 16-ти цветные

Tahion: Лови.

← →
Tahion (2003-01-15 07:51) [11]

Спасибо. Но не совсем то. См ответ в письме

← →
Tahion (2003-01-21 20:33) [12]

Может еще кто-то процедуру знает?

← →
Tahion (2003-01-26 06:07) [13]

Ау

Сохранение иконки Найти похожие ветки