VPF::Как из BMP или JPG сделать ICO? - Форум программистов

ACMilian

Дата 19.4.2007, 11:10 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 189
Регистрация: 5.9.2006
Где: Беларусь

Репутация: нет
Всего: нет

Не могу сделать иконку. персмотрел факи там, нашёл это:

Код


procedure TForm1.Button1Click(Sender: TObject);
var
winDC, srcdc, destdc: HDC;
oldBitmap: HBitmap;
iinfo: TICONINFO;
begin
GetIconInfo(Image1.Picture.Icon{bitmap}.Handle, iinfo);
WinDC := getDC(handle);
srcDC := CreateCompatibleDC(WinDC);
destDC := CreateCompatibleDC(WinDC);
oldBitmap := SelectObject(destDC, iinfo.hbmColor);
oldBitmap := SelectObject(srcDC, iinfo.hbmMask);
BitBlt(destdc, 0, 0, Image1.picture.icon.width,
   Image1.picture.icon.height,
   srcdc, 0, 0, SRCPAINT);
Image2.picture.bitmap.handle := SelectObject(destDC, oldBitmap);
DeleteDC(destDC);
DeleteDC(srcDC);
DeleteDC(WinDC);
image2.Picture.icon{Bitmap}.savetofile(ExtractFilePath(Application.ExeName) + 'myfile.ico');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
image1.picture.bitmap.loadfromfile('D:\SExpress\FutStat\SOCCER.BMP');
end;

но оно не работае. может кто знает как сделать иконку из BMP или JPG?

Alexeis

Дата 19.4.2007, 11:59 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 55
Всего: 459

Правильно не работает ведь загружается битмапка, а работа производиться с иконкой, это же разные объекты!
ACMilian, вынужден разочаровать, но даже при правильной работе этого кода иконка будет сохраняться в 16 цветах, такой уж убогий этот компонент. Единственное решение это разбор поочередная запись всех нужных структур иконки (т.е. разбор битмапника заполнение заголовком ICO и запись всех этих данных в файл.) В одной теме я уже производил разбор ICO для создания ресурса, если очень нужно могу и собрать smile

--------------------

Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать

ama_kid

Дата 19.4.2007, 12:02 (ссылка)

(нет голосов)

Загрузка ...

АСУТП-кодер

Профиль
Группа: Комодератор
Сообщений: 1460
Регистрация: 5.3.2007
Где: Москва

Репутация: нет
Всего: 95

ACMilian,
Попробуй такой код, может будет полезным:

Код

procedure TForm1.Button1Click(Sender: TObject);
var
 tIcn:TIcon;
 tBmp:Graphics.TBitmap;
 tIml:TImageList;
begin
  tIcn:=TIcon.Create;
  tBmp:=Graphics.TBitmap.Create;
  tBmp.LoadFromFile('myico.bmp');
  tIml:=TImageList.Create(Self);
  tIcn.Width:=16; tIcn.Height:=16;
  tIml.Add(tBmp,tBmp);
  tIml.GetIcon(0,tIcn);
  tIcn.SaveToFile('myico.ico');
end;

--------------------

самурай без меча подобен самураю с мечом, но только без меча

ACMilian

Дата 19.4.2007, 12:23 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 189
Регистрация: 5.9.2006
Где: Беларусь

Репутация: нет
Всего: нет

всем спасиба, последний код пригодлися. =)

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Звук, графика и видео \| Следующая тема »