Форум: "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