Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2002.02.04;
Скачать: CL | DM;

Вниз

Вывод 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 вся ветка

Текущий архив: 2002.02.04;
Скачать: CL | DM;

Наверх




Память: 0.46 MB
Время: 0.011 c
1-8809
Alexsum
2002-01-17 09:59
2002.02.04
Ошибка при открытии формы.


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


6-8963
Begemoth
2001-11-10 18:30
2002.02.04
Счетчик посещений Web-страницы


14-8979
Hermit
2001-12-11 20:06
2002.02.04
Interbase


1-8858
Chak
2002-01-19 15:48
2002.02.04
Как убить DLL-ку, находящуюся в памяти?