Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "WinAPI";
Текущий архив: 2002.02.04;
Скачать: [xml.tar.bz2];

Вниз

Вывод bitmap из ресурса   Найти похожие ветки 

 
Evgeny   (2001-11-27 07:37) [16]

Существует такой же вариант и на Delphi, попробуй может подойдет. Код не мой и я его не проверял, так что за работоспособность не ручаюсь.

procedure XLoadBitmap(Instance: THandle; BitmapName: PChar;
var HB: HBitmap; var HP: HPalette);
var
DC: HDC;
BI: PBitMapInfo;
Pal: PLogPalette;
I: Integer;
ResIdHandle: THandle;
ResDataHandle: THandle;
Bitmap: HBitmap;
C: HWnd;
OldPalette, Palette: HPalette;

begin
Bitmap:= 0; Palette:=0;
HB:=0; HP:=0;
{Получить ресурс из модуля}
ResIDHandle := FindResource(Instance, BitmapName, rt_BitMap);
if ResIDHandle<>0 then begin
ResDataHandle := LoadResource(Instance, ResIDHandle);
if ResDataHandle<>0 then begin
BI:= LockResource(ResDataHandle);
if BI <> nil then begin
{256-цветный битмап?}
if BI^.bmiHeader.biBitCount = 8 then begin
{Создать палитру}
GetMem(Pal, SizeOf(TLogPalette) + 256 * SizeOf(TPaletteEntry));
for I:= 0 to 255 do
with Pal^.palPalEntry[I] do begin
peRed := BI^.bmiColors[I].rgbRed;
peGreen:= BI^.bmiColors[I].rgbGreen;
peBlue := BI^.bmiColors[I].rgbBlue;
peFlags:= 0;
end;
Pal^.palNumEntries:= 256;
Pal^.palVersion := $300;
Palette:= CreatePalette(Pal^);
FreeMem(Pal, SizeOf(TLogPalette) + 256 * SizeOf(TPaletteEntry));

{Привести цвета палитры в системные}
DC:= CreateDC("Display", nil, nil, nil);
OldPalette:= SelectPalette(DC, Palette, False);
UnrealizeObject(Palette);
RealizePalette(DC);

{Создать битмап}
BitMap:= CreateDIBitmap(DC, BI^.bmiHeader, CBM_INIT,
@PByteArray(BI)^[SizeOf(TBitMapInfo) + SizeOf(TRGBQuad) * 256 - 4],
BI^, DIB_RGB_COLORS);

{Освободить ресурсы}
UnlockResource(ResDataHandle);
FreeResource(ResDataHandle);
SelectPalette(DC, OldPalette, False);
DeleteDC(DC);
end else begin
{Не 256-цветный битмап}
UnlockResource(ResDataHandle);
FreeResource(ResDataHandle);
BitMap:= LoadBitmap(Instance, BitmapName);
end;
HB := Bitmap;
HP := Palette;
end; {BI <> nil }
end; {ResDataHandle <> 0}
end; {ResIDHandle <> 0 }
end;


procedure TForm1.FormCreate(Sender: TObject);
var
HB: HBitmap;
HP: HPalette;
begin
xLoadBitmap(hInstance, "PHOTO", HB, HP);
Image1.Picture.Bitmap.Handle :=HB;
Image1.Picture.Bitmap.Palette:=HP;
end;




Страницы: 1 вся ветка

Форум: "WinAPI";
Текущий архив: 2002.02.04;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.44 MB
Время: 0.005 c
3-8753
sos
2002-01-04 16:53
2002.02.04
Компонента для работы с файлами типа *.btr


3-8782
Pete
2002-01-03 09:57
2002.02.04
InterBase


1-8939
Socol
2002-01-18 07:14
2002.02.04
Поиск файла


3-8790
Ura
2001-12-28 11:02
2002.02.04
BDE


1-8916
Лана Розанова
2002-01-17 15:39
2002.02.04
Memo





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский