Получение иконки из любого файла и сохранение в .BMP произвольного размера.

Может пригодится например для ListBox и пр.

Получение иконки из любого файла и сохранение в .BMP произвольного размера.

DECLARE INTEGER GetDC IN Win32API INTEGER HWND
DECLARE INTEGER CreateCompatibleDC IN Win32API INTEGER
*DECLARE INTEGER CreateCompatibleBitmap IN Win32API INTEGER,INTEGER,INTEGER
DECLARE INTEGER GetObject IN Win32API AS GetObject2 INTEGER,INTEGER,STRING
DECLARE INTEGER SelectObject IN Win32API INTEGER hdc,INTEGER
DECLARE DeleteObject IN Win32API INTEGER
*DECLARE INTEGER ReleaseDC IN Win32API INTEGER,INTEGER
DECLARE INTEGER DeleteDC IN Win32API INTEGER

DECLARE INTEGER ExtFloodFill IN Win32API INTEGER,INTEGER,INTEGER,INTEGER,INTEGER
*DECLARE INTEGER DrawIcon IN Win32API INTEGER,INTEGER,INTEGER,INTEGER
DECLARE INTEGER DrawIconEx IN Win32API INTEGER,INTEGER,INTEGER,INTEGER,;
INTEGER,INTEGER,INTEGER,INTEGER,INTEGER
DECLARE INTEGER ExtractAssociatedIcon IN Shell32 INTEGER,STRING @,INTEGER @
#define DI_MASK 0x0001
#define DI_IMAGE 0x0002
#define DI_NORMAL 0x0003
#define DI_COMPAT 0x0004
#define DI_DEFAULTSIZE 0x0008

Local ih,n,ic,hdc,mem1,x1,y1,ob,hb
s='example.doc' && любой выбранный файл по This.Value
n=0
* загружаем любой файл-шаблон .BMP например с размерами 20x20,
* чтобы не создавать новый по CreateCompatibleBitmap()
ic=LOADPICTURE('pap24.bmp')
ih=ExtractAssociatedIcon(GetFocus(),@s,@n) && получаем иконку файла

hdc=GetDC(GetFocus())
mem1=CreateCompatibleDC(hdc) && заводим еще аналогичный HDC для копирования
hb=ic.Handle
SelectObject(mem1,hb) && выбираем в него обьект-шаблон
ob=Space(100)
GetObject2(hb,100,@ob) && получение размеров битмапа
x1=ASC(SUBSTR(ob,6,1))*256+ASC(SUBSTR(ob,5,1))
y1=ASC(SUBSTR(ob,10,1))*256+ASC(SUBSTR(ob,9,1))
ExtFloodFill(mem1,0,0,0xffff,0) && красим шаблон в белый цвет
*=StretchBlt(mem1,0,0,20,20,mem,0,0,32,32,13369376)

DrawIconEx(mem1,0,0,ih,x1,y1,0,0,DI_NORMAL) && копируем иконку на шаблон
SAVEPICTURE(ic,'temp.bmp') && пишем шаблон в .BMP
DeleteDC(hdc)
DeleteDC(mem1) && удаляем HDCы
*DeleteObject(ih)
*DeleteObject(hb) && по хорошему и обьекты тоже

Может пригодится например для ListBox и пр.
CLEAR RESOURCES &&[FileName] очистка кэша картинок, к сожалению раб. не всегда, даже в 7ке?!
o.Picture='temp.bmp'
o.Requery

Комментарий:
Если бы можно было добратся до Handle картинок тех-же Itemов, не пришлось бы так изгаляться 🙁

Автор: Sergey Filimonoff

Автор публикации

не в сети 21 год

Sergey Filimonoff

Комментарии: 0Публикации: 4Регистрация: 15-01-2003
Материалы по теме
Оставить комментарий
//////////////// ///////////////
Авторизация
*
*
Генерация пароля