Bitmap в memory (only) mapped file
От: LastDoorBy  
Дата: 20.08.05 11:23
Оценка:
здравствуйте все... вопрос такой нужно запихать битмап в 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.... Что не так? Может кто — то что — то подобное делал? Буду рад любым предложениям....
 
Подождите ...
Wait...
Пока на собственное сообщение не было ответов, его можно удалить.