здравствуйте все... вопрос такой нужно запихать битмап в memory mapped file...
делаю это вот так :
function SaveMonoBitmapToMMFile(BI : Tbitmap; Var hFile : Longint):Boolean;
type
RGB = array [0..1] of tagRGBQUAD;
PRGB = ^RGB;
ByteArray = array [0..maxint-1] of byte;
parraybyte = ^ByteArray;
Var LineSize:Longint;
lpMap : pointer; // pointer to mapped file
lp : pointer; // pointer
hDCMem : LongInt; // handle to a memory device context
hbmpOld : LongInt; // handle to a bitmap
FileHandle:LongINt;
bmi :PBitmapInfo;
Bit :BitmapInfo;
bufer : parraybyte;
Colors : Prgb;
NumBytes : Longint;
ert:TPixelFormat;
CopyBit:BitmapInfo;
Resultat : LongINt;
begin
//CopyBit:BitmapInfo;
result := false;
hFile := 0;
getmem(bufer,SizeOf(BitmapInfo)+2*SizeOf(integer));
bmi := PBitmapInfo(pointer(bufer));
Colors := PRGB( @Bufer[SizeOf(BitmapInfo)] );
With bmi.bmiHeader do
begin
biSize := SizeOf(bmi.bmiHeader);
biWidth := BI.Width;
biHeight := BI.Height;
biXPelsPerMeter := 13780; //BI.XPelsPerMeter;
biYPelsPerMeter := 13780; //BI.YPelsPerMeter;
biPlanes := 1;
biBitCount := 1;
biCompression := BI_RGB;
biClrUsed := 2;
biClrImportant := 0;
LineSize := Round((BI.Width + 31) / 32) * 4;
biSizeImage := LineSize * BI.Height;
End ;
with Colors[0] do
begin
rgbRed := 0;
rgbGreen := 0;
rgbBlue := 0;
rgbReserved := 0;
end;
with Colors[1] do
begin
rgbRed := 255;
rgbGreen := 255;
rgbBlue := 255;
rgbReserved := 0;
end;
BI.Monochrome := true;
//ert := BI.PixelFormat;
NumBytes := SizeOf(bmi.bmiHeader);
NumBytes := NumBytes + SizeOf(bmi.bmiColors[0]) * 2;
NumBytes := NumBytes + bmi.bmiHeader.biSizeImage;
hFile := CreateFileMappingA( $FFFFFFFF , nil, PAGE_READWRITE, 0, LineSize, nil);
if(hFile <> 0) then
begin
lpMap := MapViewOfFile(hFile, FILE_MAP_WRITE, 0, 0, 0);
if(lpMap <> nil) then
begin
lp := lpMap;
CopyMemory (lp, @bmi.bmiHeader, SizeOf(bmi.bmiHeader));
lp := @parraybyte(lp)[SizeOf(bmi.bmiHeader)];
CopyMemory (lp, @bmi.bmiColors[0], SizeOf(bmi.bmiColors[0]) * 2);
lp := @parraybyte(lp)[SizeOf(bmi.bmiColors[0])*2 ];
hDCMem := CreateCompatibleDC(0);
if(hDCMem <> 0 ) then
begin
hbmpOld := SelectObject(hDCMem, BI.Handle);
if(hbmpOld <> 0) then
begin
copybit:= TBitmapInfo(lpMap^);
IF( GetDIBits(hDCMem, BI.Handle, 0, BI.Height,lp,copybit, DIB_PAL_COLORS)<>0 )
Then
result:=true
else
ShowMessage(SysErrorMessage(GetLastError));
result:=true ;
BI.Handle := SelectObject(hDCMem, hbmpOld);
end;
DeleteDC(hDCMem);
end;
UnmapViewOfFile(lpMap)
end;
end
else
begin
If not result Then
begin
CloseHandle(hFile);
hFile := 0
end;
end;
end;
второй день бьюсь уже, не могу никак заставить GetDIBits вернуть результат, все время возвращает 0. Ловлю код ошибки, говорит, что — Not enough storage is avaolable to process this command.... Что не так? Может кто — то что — то подобное делал? Буду рад любым предложениям....