Api Bitmap память окно
В общем суть вопроса: есть битмап, хранящийся в памяти по указателю Pointer, есть хэндл нужного окна, вопрос, как отрисовать картинку в окне, используя только АПИ функции
п.с. пытался выдрать ReadDIB, но ни к чему хорошему это не привело.
Код:
procedure ReadDIB(Stream: Pointer; ImageSize: LongWord; bmf: PBitmapFileHeader);
var
ReadPos:cardinal;
procedure Read(var Buf;Count:integer);
begin
Move(Pointer(Cardinal(Stream)+ReadPos)^,Buf,Count);
inc(ReadPos,Count);
end;
function GetDInColors(BitCount: Word): Integer;
begin
case BitCount of
1, 4, 8: Result := 1 shl BitCount;
else
Result := 0;
end;
end;
procedure RGBTripleToQuad(var ColorTable);
type
PRGBTripleArray = ^TRGBTripleArray;
TRGBTripleArray = array [Byte] of TRGBTriple;
PRGBQuadArray = ^TRGBQuadArray;
TRGBQuadArray = array [Byte] of TRGBQuad;
var
I: Integer;
P3: PRGBTripleArray;
P4: PRGBQuadArray;
begin
P3 := PRGBTripleArray(@ColorTable);
P4 := Pointer(P3);
for I := 255 downto 1 do // don't move zeroth item
with P4^[i], P3^[i] do
begin // order is significant for last item moved
rgbRed := rgbtRed;
rgbGreen := rgbtGreen;
rgbBlue := rgbtBlue;
rgbReserved := 0;
end;
P4^[0].rgbReserved := 0;
end;
function SystemPaletteOverride(var Pal: TMaxLogPalette): Boolean;
var
DC: HDC;
SysPalSize: Integer;
begin
Result := False;
if SystemPalette16 <> 0 then
begin
DC := GetDC(0);
try
SysPalSize := GetDeviceCaps(DC, SIZEPALETTE);
if SysPalSize >= 16 then
begin
{ Ignore the disk image of the palette for 16 color bitmaps.
Replace with the first and last 8 colors of the system palette }
GetPaletteEntries(SystemPalette16, 0, 8, Pal.palPalEntry);
GetPaletteEntries(SystemPalette16, 8, 8, Pal.palPalEntry[Pal.palNumEntries - 8]);
Result := True;
end
finally
ReleaseDC(0,DC);
end;
end;
end;
procedure ByteSwapColors(var Colors; Count: Integer);
var // convert RGB to BGR and vice-versa. TRGBQuad <-> TPaletteEntry
SysInfo: TSystemInfo;
begin
GetSystemInfo(SysInfo);
asm
MOV EDX, Colors
MOV ECX, Count
DEC ECX
JS @@END
LEA EAX, SysInfo
CMP [EAX].TSystemInfo.wProcessorLevel, 3
JE @@386
@@1: MOV EAX, [EDX+ECX*4]
BSWAP EAX
SHR EAX,8
MOV [EDX+ECX*4],EAX
DEC ECX
JNS @@1
JMP @@END
@@386:
PUSH EBX
@@2: XOR EBX,EBX
MOV EAX, [EDX+ECX*4]
MOV BH, AL
MOV BL, AH
SHR EAX,16
SHL EBX,8
MOV BL, AL
MOV [EDX+ECX*4],EBX
DEC ECX
JNS @@2
POP EBX
@@END:
end;
end;
function PaletteFromDIBColorTable(DIBHandle: THandle; ColorTable: Pointer;
ColorCount: Integer): HPalette;
var
DC: HDC;
Save: THandle;
Pal: TMaxLogPalette;
begin
Result := 0;
Pal.palVersion := $300;
if DIBHandle <> 0 then
begin
DC := CreateCompatibleDC(0);
Save := SelectObject(DC, DIBHandle);
Pal.palNumEntries := GetDIBColorTable(DC, 0, 256, Pal.palPalEntry);
SelectObject(DC, Save);
DeleteDC(DC);
end
else
begin
Pal.palNumEntries := ColorCount;
Move(ColorTable^, Pal.palPalEntry, ColorCount * 4);
end;
if Pal.palNumEntries = 0 then Exit;
if (Pal.palNumEntries <> 16) or not SystemPaletteOverride(Pal) then
ByteSwapColors(Pal.palPalEntry, Pal.palNumEntries);
Result := CreatePalette(PLogPalette(@Pal)^);
end;
const
DIBPalSizes: array [Boolean] of Byte = (sizeof(TRGBQuad), sizeof(TRGBTriple));
var
DC, MemDC: HDC;
BitsMem: Pointer;
OS2Header: TBitmapCoreHeader;
BitmapInfo: PBitmapInfo;
ColorTable: Pointer;
HeaderSize: Integer;
OS2Format: Boolean;
BMHandle, OldBMP: HBITMAP;
DIB: TDIBSection;
Pal, OldPal: HPalette;
// RLEStream: TStream;
vbmf: TBitmapFileHeader;
{$IFDEF LINUX}
I: Integer;
{$ENDIF}
begin
Pal := 0;
BMHandle := 0;
// RLEStream := nil;
ReadPos:=0;
Read(HeaderSize, sizeof(HeaderSize));
OS2Format := HeaderSize = sizeof(OS2Header);
if OS2Format then HeaderSize := sizeof(TBitmapInfoHeader);
GetMem(BitmapInfo, HeaderSize + 12 + 256 * sizeof(TRGBQuad));
with BitmapInfo^ do
try
try
if OS2Format then // convert OS2 DIB to Win DIB
begin
Read(Pointer(Longint(@OS2Header) + sizeof(HeaderSize))^,
sizeof(OS2Header) - sizeof(HeaderSize));
FillChar(bmiHeader, sizeof(bmiHeader), 0);
with bmiHeader, OS2Header do
begin
biWidth := bcWidth;
biHeight := bcHeight;
biPlanes := bcPlanes;
biBitCount := bcBitCount;
end;
Dec(ImageSize, sizeof(OS2Header));
end
else
begin // support bitmap headers larger than TBitmapInfoHeader
Read(Pointer(Longint(BitmapInfo) + sizeof(HeaderSize))^,
HeaderSize - sizeof(HeaderSize));
Dec(ImageSize, HeaderSize);
if (bmiHeader.biCompression <> BI_BITFIELDS) and
(bmiHeader.biCompression <> BI_RGB) then
begin // Preserve funky non-DIB data (like RLE) until modified
// source stream could be unidirectional. don't reverse seek
if bmf = nil then
begin
FillChar(vbmf, sizeof(vbmf), 0);
vbmf.bfType := $4D42;
vbmf.bfSize := ImageSize + Cardinal(HeaderSize);
bmf := @vbmf;
end;
end;
end;
with bmiHeader do
begin
biSize := HeaderSize;
ColorTable := Pointer(Longint(BitmapInfo) + HeaderSize);
{ check number of planes. DIBs must be 1 color plane (packed pixels) }
if biPlanes <> 1 then exit;//InvalidBitmap;
// 3 DWORD color element bit masks (ie 888 or 565) can precede colors
// TBitmapInfoHeader sucessors include these masks in the headersize
if (HeaderSize = sizeof(TBitmapInfoHeader)) and
((biBitCount = 16) or (biBitCount = 32)) and
(biCompression = BI_BITFIELDS) then
begin
Read(ColorTable^, 3 * sizeof(DWORD));
Inc(Longint(ColorTable), 3 * sizeof(DWORD));
Dec(ImageSize, 3 * sizeof(DWORD));
end;
// Read the color palette
if biClrUsed = 0 then
biClrUsed := GetDInColors(biBitCount);
Read(ColorTable^, biClrUsed * DIBPalSizes[OS2Format]);
Dec(ImageSize, biClrUsed * DIBPalSizes[OS2Format]);
// biSizeImage can be zero. If zero, compute the size.
if biSizeImage = 0 then // top-down DIBs have negative height
biSizeImage := BytesPerScanLine(biWidth, biBitCount, 32) * Abs(biHeight);
if biSizeImage < ImageSize then ImageSize := biSizeImage;
end;
{ convert OS2 color table to DIB color table }
if OS2Format then RGBTripleToQuad(ColorTable^);
DC := GetDC(0);
try
if ((bmiHeader.biCompression <> BI_RGB) and
(bmiHeader.biCompression <> BI_BITFIELDS)) or DDBsOnly then
begin
MemDC := 0;
GetMem(BitsMem, ImageSize);
try
Read(BitsMem^, ImageSize);
MemDC := CreateCompatibleDC(DC);
OldBMP := SelectObject(MemDC, CreateCompatibleBitmap(DC, 1, 1));
OldPal := 0;
if bmiHeader.biClrUsed > 0 then
begin
Pal := PaletteFromDIBColorTable(0, ColorTable, bmiHeader.biClrUsed);
OldPal := SelectPalette(MemDC, Pal, False);
RealizePalette(MemDC);
end;
try
BMHandle := CreateDIBitmap(MemDC, BitmapInfo^.bmiHeader, CBM_INIT, BitsMem,
BitmapInfo^, DIB_RGB_COLORS);
if (BMHandle = 0) then
if GetLastError = 0 then exit{InvalidBitmap} else RaiseLastOSError;
finally
if OldPal <> 0 then
SelectPalette(MemDC, OldPal, True);
DeleteObject(SelectObject(MemDC, OldBMP));
end;
finally
if MemDC <> 0 then DeleteDC(MemDC);
FreeMem(BitsMem);
end;
end
else
begin
BMHandle := CreateDIBSection(DC, BitmapInfo^, DIB_RGB_COLORS, BitsMem, 0, 0);
if (BMHandle = 0) or (BitsMem = nil) then
if GetLastError = 0 then exit{InvalidBitmap} else RaiseLastOSError;
try
Read(BitsMem^, ImageSize);
except
DeleteObject(BMHandle);
raise;
end;
end;
finally
ReleaseDC(0, DC);
end;
// Hi-color DIBs don't preserve color table, so create palette now
if (bmiHeader.biBitCount > 8) and (bmiHeader.biClrUsed > 0) and (Pal = 0)then
Pal := PaletteFromDIBColorTable(0, ColorTable, bmiHeader.biClrUsed);
FillChar(DIB, sizeof(DIB), 0);
GetObject(BMHandle, Sizeof(DIB), @DIB);
// GetObject / CreateDIBSection don't preserve these info values
DIB.dsBmih.biXPelsPerMeter := bmiHeader.biXPelsPerMeter;
DIB.dsBmih.biYPelsPerMeter := bmiHeader.biYPelsPerMeter;
DIB.dsBmih.biClrUsed := bmiHeader.biClrUsed;
DIB.dsBmih.biClrImportant := bmiHeader.biClrImportant;
except
raise;
end;
finally
FreeMem(BitmapInfo);
end;
end;
в результате получаю BMHandle, Pal, DIB, OS2Format но дальше ничего апишного на ум не приходит, не знаю как впихнуть их в нужный хендл, хотя может просто туплю, помогите)
|