2 respuestas en este tema

[escafandra]

Como ya sabréis, Lazarus no soporta formatos de Bitmap indexados, solo soporta color verdadero. Esto implica que no sirve de nada usar PixelFormat para cambiar el formato de un TBitmap, como en delphi.
 
Como curiosidad y ejercicio he hecho una función que devuelve en un TMemoryStream el formato de un Bitmap tipo DIB, tal como se escribe en un archivo. Cuando Lazarus carga un Bitmap indexado desde un archivo o un TStream, respeta su formato hasta que trabaja con él, momento en el que lo convierte a color real prescindiendo de la paleta y escribiendo en el buffer de la imagen los tripletes RGB.
 
Cuando queremos reducir una imagen a blanco y negro (escala de 256 grises) siguiendo el código publicado en el tema "Convertir una imagen de Color a Escala de Grises" nos llevamos la desagradable sorpresa de que no podemos pasarlo a una imagen indexada usando TBitmap. Si nos vamos a bajo nivel, podemos hacerlo pero el Handle del bitmap creado no lo podremos asignar a un TBitmap Lazarus, aunque si hacerle cargarse desde un TStream.
 
Este truco presenta dos funciones, la primera es como crear un TStream desde un Bitmap y una Paleta, la función que os presento es válida en Lazarus y delphi:
 

delphi

function BitmapToStream(Bitmap: HBITMAP; Palette: HPALETTE): TMemoryStream;
var
  bmp: BITMAP;
  bmpFileHeader: PBITMAPFILEHEADER;
  bmiHeader: PBITMAPINFOHEADER;
  bmiColors: PRGBQUAD;
  nColors: WORD;
  SizeImage: DWORD;
begin
  // Obteniendo datos del Bitmap
  GetObject(Bitmap, sizeof(bmp), @bmp);
  GetObject(Palette, 2, @nColors);
  SizeImage:= bmp.bmWidthBytes * bmp.bmHeight;
 
  // Preparando Memoria TMemoryStream y punteros
  Result:= TMemoryStream.Create;
  Result.Size:= sizeof(BITMAPFILEHEADER) + sizeof(BITMAPINFOHEADER) + nColors * sizeof(RGBQUAD) + SizeImage;
  bmpFileHeader:= Result.Memory;
  bmiHeader:= Result.Memory; inc(PBYTE(bmiHeader), sizeof(BITMAPFILEHEADER));
  bmiColors:= PRGBQUAD(bmiHeader); inc(PBYTE(bmiColors), sizeof(BITMAPINFOHEADER));
 
  // Escribiendo FileHeader (BITMAPFILEHEADER)
  bmpFileHeader^.bfType:= PWORD(PCHAR('BM'))^;
  bmpFileHeader^.bfSize:= sizeof(BITMAPFILEHEADER) + sizeof(BITMAPINFOHEADER) + nColors * sizeof(RGBQUAD) + SizeImage;
  bmpFileHeader^.bfReserved1:= 0;
  bmpFileHeader^.bfReserved2:= 0;
  bmpFileHeader^.bfOffBits:= sizeof(BITMAPFILEHEADER) + sizeof(BITMAPINFOHEADER) + nColors * sizeof(RGBQUAD);
 
  // Escribiendo InfoHeader (BITMAPINFOHEADER)
  bmiHeader^.biSize:= sizeof(BITMAPINFOHEADER);
  bmiHeader^.biWidth:= bmp.bmWidth;
  bmiHeader^.biHeight:= bmp.bmHeight;
  bmiHeader^.biPlanes:= bmp.bmPlanes;
  bmiHeader^.biBitCount:= bmp.bmBitsPixel;
  bmiHeader^.biCompression:= BI_RGB;
  bmiHeader^.biSizeImage:=  SizeImage;
  bmiHeader^.biXPelsPerMeter:= 0;
  bmiHeader^.biYPelsPerMeter:= 0;
  bmiHeader^.biClrUsed:= nColors;
  bmiHeader^.biClrImportant:= 0;
 
  // Escribiendo la paleta: bmiColors (RGBQUAD)
  GetPaletteEntries(Palette, 0, nColors, bmiColors^);
 
  // Escribiendo la imagen de bits
  Result.Position:= bmpFileHeader^.bfOffBits;
  Result.Write(bmp.bmBits^, bmiHeader^.biSizeImage);
  Result.Position:= 0;
end;

Ahora podemos reescribir la función BitmapToGrayscale usando el bajo nivel de la GDI y obligar a que devuelva un TMemoryStream compatible con los TBitmap de Lazarus. Esta función también funciona en delphi

delphi

// Creando de forma directa en una sola pasada.
function BitmapToGrayscale(Bitmap: TBitmap): TMemoryStream;
var
  TempBitmap: HANDLE;
  bmp: BITMAP;
  X,Y,i: Integer;
  Gray: Byte;
  Color: DWORD;
  bmpInfo: BITMAPINFO;
  TempBits, D: PBYTE;
  Pixel: PRGBTRIPLE;
  LPalette: PLOGPALETTE;
  Palette: HPALETTE;
  DC: HDC;
begin
 
  // Creando una paleta de grises
  GetMem(LPalette, sizeof(LOGPALETTE) + 255*sizeof(DWORD));
  LPalette^.palVersion:= $300;
  LPalette^.palNumEntries:= 256;
  for i:= 0 to 255 do
  begin
    Color:= $FF000000 or i or (i shl 8) or (i shl 16);
    LPalette^.palPalEntry[i]:= PPALETTEENTRY(@Color)^;
  end;
 
  // Creando un bitmap temporal de 8 bits
  bmpInfo.bmiHeader.biSize:= sizeof(BITMAPINFOHEADER);
  bmpInfo.bmiHeader.biWidth:= Bitmap.Width;
  bmpInfo.bmiHeader.biHeight:= Bitmap.Height;
  bmpInfo.bmiHeader.biPlanes:= 1;
  bmpInfo.bmiHeader.biBitCount:= 8;
  bmpInfo.bmiHeader.biCompression:= BI_RGB;
  bmpInfo.bmiHeader.biSizeImage:= (((bmpInfo.bmiHeader.biWidth * (bmpInfo.bmiHeader.biBitCount shr 3)) + 3) and $FFFFFFFC) * bmpInfo.bmiHeader.biHeight;
 
  GetMem(TempBits, bmpInfo.bmiHeader.biSizeImage);
  TempBitmap:= CreateDIBSection(0, bmpInfo, DIB_RGB_COLORS, TempBits, 0, 0);
  GetObject(TempBitmap, sizeof(bmp), @bmp);
 
  // Pasando la imagen a escala de grises
  for Y := 0 to Bitmap.Height - 1 do
  begin
    Pixel := Bitmap.ScanLine[Y];
    D:= TempBits; inc(D, bmp.bmWidthBytes * (Bitmap.Height-1-Y));
    for X := 0 to Bitmap.Width - 1 do
    begin
      Gray := Round((0.299 * Pixel^.rgbtRed) + (0.587 * Pixel^.rgbtBlue) + (0.114 * Pixel^.rgbtGreen));
      for i:= 0 to 255 do
        if Gray = LPalette^.palPalEntry[i].peRed then break;
      D^:= i;
      Inc(Pixel); inc(D);
    end;
  end;
 
  Result:= BitmapToStream(TempBitmap, CreatePalette(LPalette^));
 
  // Limpiando
  DeleteObject(TempBitmap);
  FreeMem(LPalette);
end;

Un ejemplo de uso puede ser el siguiente:

delphi

var
  Stream: TStream;
begin
  Stream:= BitmapToGrayscale(Image2.Picture.Bitmap);
  Image1.Picture.Bitmap.LoadFromStream(Stream);
 
  // Ahora si se guarda una imagen con formato indexado de 8 bits 
  Image1.Picture.Bitmap.SaveToFile('prueba.bmp');
 
  Stream.free;
end;

Como BitmapToGrayscale devuelve un TMemoryStream, se puede guardar en un archivo directamente o usarlo para cargar un Bitmap tranquilamente, eso sí, habrá que liberarlo cuando no nos haga más falta.

 

Espero que sea de utilidad.

 

 

 

Saludos.

[Delphius]

Asi es amigo, en Lazarus no existe por defecto el bmp basado en paletas o indexados.

No estoy seguro pero creo que se debe a una cuestión de multiplataforma.

 

No me puse a revisar como es que logra hacer este trabajo la suite BGRABitmap. Esta es 100% multiplataforma y ofrece de base muchos filtros y variados métodos de tratamiento de imagenes. Y si no me falla la memoria, hasta da soporte a OpenGL. Es la suite más recomendada en los foros de Lazarus.

 

Esta suite es algo diferente en algunos aspectos a como lo conocemos el tBitmap tradicional. Por empezar siempre trabaja en formato BGRA, independientemente si uno abre una imagen BMP, o un PNG. Y esto hace que cualquier intento de establecer el formato de bits sea inútil, como tu comentas.

 

Saludos,

[escafandra]

Es curioso que Lazarus no soporte BMP indexado con paletas cuando no es el único formato que lo usa, sin ir muy lejos Gif es multiplataforma y se en paleta de colores y un mapa comprimido.

 

 

Saludos.