Bitmap 16bit R5G6B5

[JZS]

Hi all,

How to convert any bitmap image to 16bit R5 G6 B5 please?

[Thaddy]

for rgb32

Code: Pascal  [Select][+][-]

1. function RGB32ToRGB565(R, G, B: Byte): Word;
2. begin
3.   Result := ((R and $F8) shl 8) or ((G and $FC) shl 3) or (B shr 3);
4. end;

Other conversions are similar. This is a per pixel conversion.

[JZS]

Other conversions are similar. This is a per pixel conversion.

Thank you Thaddy.

So there is no general rule to apply to any PixelFormat (16, 24, 32) to generate the 16bit 565? Or is it more complex than I thought?

For simple example can I apply this to Canvas.Pixels[x,y]?

something like:

Code: Pascal  [Select][+][-]

1.   dst_bitmap.width:= src_bitmap.width;
2.   dst_bitmap.height:= src.bitmap.height;
3.   dst_bitmap.PixelFormat := pf16bit;
4.  
5.    for i:= 0 to src_bitmap.Width-1 do
6.      for j:= 0 to src_bitmap.Height-1 do                                   //sure there might be a better way
7.          dst_bitmap.Canvas.Pixels[i, j]:= RGB32ToRGB565(GetRValue(src.Canvas.Pixels[i, j]),GetGValue(src.Canvas.Pixels[i, j]),GetGValue(src.Canvas.Pixels[i, j]));

Sorry I haven't got much knowledge about the conversion between the Bitmap types programmatically. Although I have spent many hours today but it seems like there is no documentation or even clear examples to show the method of accomplishing such task.

[Thaddy]

Yes, you can.
But you maybe misunderstood this bit:
The 32 and 24 bit format have full 8 bit depth per color.
What I did is adjust and scaled  so that the colors are weigted as 5 bits red, 6 bits green and 5 bits blue for a total of 16 bits instead of 24/32 bit, ignoring the transparancy bit (which can't be stored in a 16 bit color)

[JZS]

What am I missing in the above example to produce 16bit 565?

[Thaddy]

Maybe how the scaling works, but I guess I was over cautious.

[domasz]

Perhaps pf16bit doesn't work in Lazarus. It has problems with some modes.
If you just want to save to 16bit BMP you can do something like:

Code: Pascal  [Select][+][-]

1. var Buffer: array of Word;
2. begin
3. BufSize := src_bitmap.Width*src_bitmap.Height;
4. SetLength(Buffer, BufSize);
5.  
6.  
7. k := 0;
8.  
9. //here you need to put 54 bytes of BMP header data
10. //http://www.ue.eti.pg.gda.pl/fpgalab/zadania.spartan3/zad_vga_struktura_pliku_bmp_en.html
11.  
12. for i:= 0 to src_bitmap.Width-1 do
13.      for j:= 0 to src_bitmap.Height-1 do begin                                  //sure there might be a better way
14.          Buffer[k] := RGB32ToRGB565(GetRValue(src.Canvas.Pixels[i, j]),GetGValue(src.Canvas.Pixels[i, j]),GetGValue(src.Canvas.Pixels[i, j]));
15.          Inc(k);
16.    end;
17.  
18. F := TFileStream.Create('res.bmp', fmCreate);
19. F.Write(Buffer[0], BufSize);
20. F.Free;
21.  

[circular]

What am I missing in the above example to produce 16bit 565?

pf16bit means that the internal storage is supposed to be 16 bit (but in practice that may not be the case).

The pixels properties are either TFPColor or an index to the palette. So it is not possible to assign the 16 bit encoding. This could be done though with a TLazIntfImage with proper initialization. Or by having the image writing quantize the RGB channels.

With a 32bit image, which is the default with TBitmap, you can simulate 16 bit by reducing the number of colors you're using and avoiding antialiasing. For this, you would quantize the RGB channels. The generic way for this would be as follows:

Code: Pascal  [Select][+][-]

1. maxEncodedRed := 1 shl bitDepth - 1; // with bitDepth = 5, maxEncodedRed = 31
2. encodedRed := (red16bit * maxEncodedRed + 32767) div 65535;
3. quantizedRed := (encodedRed * 65535 + (maxEncodedRed shr 1)) div maxEncodedRed;

Which route would you rather take?

Regards

[JZS]

Thank you Circular.

I have no idea how to quantize the RGB channels or educing the number of colors
I do not know much about this subject and was hoping to find a working example that can simplify the concept, but now it seems like I have to go back to college

Can this be done with BGRABitmap in less complexity?

[Thaddy]

Circular's formula is about the same as mine, but uses more expensive operations: divide and multiply. This depends on cpu, though, but usually the boolean operations are faster.

[circular]

Circular's formula is about the same as mine, but uses more expensive operations: divide and multiply. This depends on cpu, though, but usually the boolean operations are faster.

Yes, I was giving the general way, that would work as well for another format.

I have no idea how to quantize the RGB channels or educing the number of colors
I do not know much about this subject and was hoping to find a working example that can simplify the concept, but now it seems like I have to go back to college

Well, it depends a bit what your objectives are. If you just want to write a BMP file, then you can simply initialize the BMP writer to use 16 bits per pixel. That would be the BitsPerPixel property of TFPWriterBMP of FPWriteBMP unit. You don't need BGRABitmap for that.

The image writer can be supplied as a parameter to the SaveToFile method.

[jamie]

why does this need to be so difficult?

Code: Pascal  [Select][+][-]

1. unit Unit1;
2.  
3. {$mode Delphi}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls;
9.  
10. type
11.   T16BitColor = bitPacked Record
12.     R:0..4;
13.     G:5..10;
14.     B:11..15;
15.   end;
16.  
17.   { TForm1 }
18.  
19.   TForm1 = class(TForm)
20.     Button1: TButton;
21.     procedure Button1Click(Sender: TObject);
22.   private
23.  
24.   public
25.  
26.   end;
27.  
28. var
29.   Form1: TForm1;
30. implementation
31.  
32. {$R *.lfm}
33.  
34. { TForm1 }
35.  
36. procedure TForm1.Button1Click(Sender: TObject);
37. Var
38.   A:WORD; //Simulate a 16bit color
39.   C:TCOlor;
40. begin
41.   A := RanDom(65535);
42.   With T16BitColor(A) do
43.   Begin
44.   Caption := Byte(R).ToString+','+
45.    Byte(G).ToString+','+
46.    Byte(B).ToString;
47.    C:= RGBToCOlor(R,g,b); //Do this also while we are in here.
48.   end;
49. end;
50.  
51. end.
52.  
53.  
54.  

Use the Bit masking to convert a 16 bit over to a rgb. etc.

P.S>
 The R and B maybe backwards.
Btw, I forgot to shift upwards the R,G,B Values, but you can figure that out.

[wp]

Try this, using two TLazIntfImages to explicitely convert pixel format:

Code: Pascal  [Select][+][-]

1. uses
2.   FPWriteBMP, IntfGraphics, GraphType;
3.  
4. procedure SaveBitmapToStream16bpp(ABitmap: TBitmap; AStream: TStream);
5. var
6.   srcImg, destImg: TLazIntfImage;
7.   rawImg: TRawImage;
8.   writer: TFPWriterBMP;
9.   x, y: Integer;
10. begin
11.   // Convert source bitmap to a TLazIntfImage
12.   srcImg := ABitmap.CreateIntfImage;
13.  
14.   // Prepare destination image for 16bpp
15.   destImg := TLazIntfImage.Create(0, 0);
16.   try
17.     rawImg.Init;
18.     rawImg.Description.Init_BPP16_R5G6B5(srcImg.Width, srcImg.Height);
19.     rawImg.CreateData(false);
20.     destImg.SetRawImage(rawImg);
21.  
22.     // Copy pixels from source to destination image (and convert them to 16bpp automatically)
23.     for y := 0 to destImg.Height-1 do
24.       for x := 0 to destImg.Width-1 do
25.         destImg.Colors[x, y] := srcImg.Colors[x, y];
26.  
27.     //Save destination image to stream
28.     writer := TFPWriterBMP.Create;
29.     try
30.       writer.BitsPerPixel := 16;   // important!
31.       destImg.SaveToStream(AStream, writer);
32.     finally
33.       writer.Free;
34.     end;
35.   finally
36.     destImg.Free;
37.     srcImg.Free;
38.   end;
39. end;
40.  
41. procedure SaveBitmapToFile16bpp(ABitmap: TBitmap; AFileName: String);
42. var
43.   stream: TFileStream;
44. begin
45.   stream := TFileStream.Create(AFileName, fmCreate);
46.   try
47.     SaveBitmapToStream16bpp(ABitmap, stream);
48.   finally
49.     stream.Free;
50.   end;
51. end;
52.  
53. { TForm1, contains a button and two images }
54.  
55. procedure TForm1.Button1Click(Sender: TObject);
56. begin
57.   Image1.Picture.LoadFromFile(SRC_FILENAME);
58.   SaveBitmapToFile16bpp(Image1.Picture.Bitmap, DEST_FILENAME);
59.   Image2.Picture.LoadFromFile(DEST_FILENAME);
60. end;

Or this, using implicit conversion by setting the destination bitmap's pixelformat and drawing the original bitmap onto its canvas (still a LazIntfImage is needed for saving the 16bpp bitmap):

Code: Pascal  [Select][+][-]

1. procedure SaveBitmapToStream16bpp(ABitmap: TBitmap; AStream: TStream);
2. var
3.   bmp: TBitmap;
4.   img: TLazIntfImage;
5.   writer: TFPWriterBMP;
6. begin
7.   bmp := TBitmap.Create;
8.   try
9.     // Convert source bitmap to 16bpp
10.     bmp.PixelFormat := pf16bit;
11.     bmp.SetSize(ABitmap.Width, ABitmap.Height);
12.     bmp.Canvas.Draw(0, 0, ABitmap);
13.  
14.     // Save the destination bitmap to stream, retaining the 16bpp
15.     img := bmp.CreateIntfImage;
16.     try
17.       writer := TFPWriterBMP.Create;
18.       try
19.         writer.BitsPerPixel := 16;  // Important
20.         img.SaveToStream(AStream, writer);
21.       finally
22.         writer.Free;
23.       end;
24.     finally
25.       img.Free;
26.     end;
27.   finally
28.     bmp.Free;
29.   end;
30. end;

[JZS]

Circular's formula is about the same as mine, but uses more expensive operations: divide and multiply. This depends on cpu, though, but usually the boolean operations are faster.

Yes, I was giving the general way, that would work as well for another format.

I have no idea how to quantize the RGB channels or educing the number of colors
I do not know much about this subject and was hoping to find a working example that can simplify the concept, but now it seems like I have to go back to college

Well, it depends a bit what your objectives are. If you just want to write a BMP file, then you can simply initialize the BMP writer to use 16 bits per pixel. That would be the BitsPerPixel property of TFPWriterBMP of FPWriteBMP unit. You don't need BGRABitmap for that.

The image writer can be supplied as a parameter to the SaveToFile method.

This is what I tried but I do not get correct result:

Code: Pascal  [Select][+][-]

1. procedure RGB565(const ASrc, ADest: String);
2. var
3.   img: TFPMemoryImage;
4.   reader: TFPCustomImageReader;
5.   writer: TFPWriterBMP;
6.   i, j: Integer;
7.   clr: TFPColor;
8. begin
9.   img := TFPMemoryImage.Create(0, 0);
10.   try
11.     reader := TFPReaderbmp.Create;
12.     try
13.       img.LoadFromFile(ASrc, reader);
14.     finally
15.       reader.Free;
16.     end;
17.  
18.     for j := 0 to img.Height - 1 do
19.       for i := 0 to img.Width - 1 do
20.       begin
21.         clr := img.Colors[i, j];
22.         clr:= TColorToFPColor(((clr.Red and $F8) shl 8) or ((clr.Green and $FC) shl 3) or (clr.Blue shr 3));
23.         img.Colors[i, j] := clr;
24.       end;
25.  
26.     writer := TFPWriterbmp.Create;
27.     writer.BitsPerPixel:= 16;
28.     try
29.       img.SaveToFile(ADest, writer);
30.     finally
31.       writer.Free;
32.     end;
33.   finally
34.     img.Free;
35.   end;
36. end;

I haven't tried Jamie and WP code yet. Will do and come back again.

[circular]

Hi JZS,

We may have overcomplicated things here. You don't need to quantize yourself the values if you're using the image writer to do that. So in the code your propose, just keep the following:

Code: Pascal  [Select][+][-]

1. procedure RGB565(const ASrc, ADest: String);
2. var
3.   img: TFPMemoryImage;
4.   reader: TFPCustomImageReader;
5.   writer: TFPWriterBMP;
6. begin
7.   img := TFPMemoryImage.Create(0, 0);
8.   try
9.     reader := TFPReaderbmp.Create;
10.     try
11.       img.LoadFromFile(ASrc, reader);
12.     finally
13.       reader.Free;
14.     end;
15.  
16.     writer := TFPWriterbmp.Create;
17.     writer.BitsPerPixel:= 16;
18.     try
19.       img.SaveToFile(ADest, writer);
20.     finally
21.       writer.Free;
22.     end;
23.   finally
24.     img.Free;
25.   end;
26. end;

The manual quantization is only if you want to do something with the data as 16 bits.

Regards