Mega Code Archive
Graying Bitmaps and Graphics
<![CDATA[
Title: Graying Bitmaps and Graphics
Question: This article shows how to gray a color bitmap. It reduces true-color bitmaps to 256 shades of gray paletted bitmaps, which reduces memory requirements.
The article also provides a function for graying any TGraphic descendant which is assignable to a TBitmap (or who knows how to assign itself to one: AssignTo method)
Answer:
After a while without posting I've came up with this article which explores a simple yet (non)colorful subject: changing color images to gray scale.
Writting a function to do that is easy: one could simply get a bitmap, promote it to 32 or 24 bit true-color, and then get the pixel components, one by one, and change them to the arithmetic avarage (red+green+blue component div 3) for every pixel. Something like:
Bitmap.PixelFormat := pf24Bit;
for y := 0 to Bitmap.Height - 1 do
for x := 0 to Bitmap.Width div 3 do
begin
C := PChar(ScanLine[y])[x*3]+PChar(ScanLine[y])[x*3+1]+PChar(ScanLine[y])[x*3+2] div 3;
FillChar(PChar(SCanLine[y])[x*3],3,C);
end;
And you will get a grayed bitmap wich is stored as a 24 bit depth true-color picture. What a wast of space and memory... (Attention: I didn't tested the above code, it is much more an algorithm than an implementation... I've written it directly here while writting the article :-)
But using this technique is not a good approach! First, every grayscale image can only have 256 shades of gray in current Windows based computers, since the Red, Green and Blue component each can only vary from 0 to 255. A gray scale image is one where R=G=B, so there can only be 256 possible levels of gray (or intensity). So using true color images to store a gray one is waste of space.
The code bellow in an excerpt from my work on progress DGL (Delphi Graphics Library), which I think I will never finish due to my load on work and at home (I am a Jiu-Jitsu fighter and have to attend to the trainning every day!!!! :-). This code was encapsulated in one filter class (TGrayFilter), because the DGL uses filters to apply effects and transformations on images. Here I've stripped the object orientation completely and wrote two simple functions to do it for you.
It is supposed that you have some familiarity with Bitmap scanlines to fully understand what is going on, and with the methods I use here to manipulate Scanlines. If you didn't have that knowledge, you could take a look at my article "BitmapToRegion (Delphi-like version - very fast) (UPDATE: Bug fix!)", Article # 944. There I enter in more detail about Scanlines and the methods I will use here.
The project bellow is very simple. To test it all you need to do is to save the DFM (which I suplly in text format) by copying and pasting in Notepad and saving the file as Unit1.dfm. After that open the form in Delphi and copy and past the code bellow in the entire unit. After that add this unit to a project and run it.
---- CODE -----
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, JPEG,
ExtDlgs, StdCtrls, Buttons, ExtCtrls;
type
TForm1 = class(TForm)
Image1: TImage;
btnOpen: TBitBtn;
OpenPic: TOpenPictureDialog;
btnGrayBitmap: TBitBtn;
btnGrayGraphic: TBitBtn;
procedure btnOpenClick(Sender: TObject);
procedure btnGrayBitmapClick(Sender: TObject);
procedure btnGrayGraphicClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
{ general routines - They are in a separate unit in my on progress Delphi
Graphics Library, but for this example I will put them here }
procedure GetScanLineProperties(Bitmap: TBitmap; var Start: Pointer;
var Dif: Integer);
begin
Start := Bitmap.ScanLine[0];
if Bitmap.Height 1 then
Dif := Integer(Bitmap.ScanLine[1]) - Integer(Start)
else
Dif := 0;
end;
function BuildGrayPalette(PixelFormat: TPixelFormat): HPalette;
var
Pal: TMaxLogPalette;
i, step: Integer;
C: Integer;
begin
Pal.palVersion := $300;
step := 1;
case PixelFormat of
pf1bit: step := 255;
pf4bit: step := 16;
pf8bit: step := 1;
end;
if step else Pal.palNumEntries := 2;
if PixelFormat = pf4bit then
begin
C := step-1;
for i := 0 to Pal.palNumEntries - 1 do
begin
FillChar(Pal.palPalEntry[i],3,C);
Pal.palPalEntry[i].peFlags := 0;
Inc(C, step);
end;
end
else
begin
C := 0;
for i := 0 to Pal.palNumEntries - 1 do
begin
FillChar(Pal.palPalEntry[i],3,C);
Pal.palPalEntry[i].peFlags := 0;
Inc(C, step);
end;
end;
Result := CreatePalette(PLogPalette(@Pal)^);
end;
function GrayPaletteEntries(Pal: HPALETTE): HPALETTE;
var
PaletteSize: Cardinal;
LogPal: TMaxLogPalette;
i: Integer;
begin
Result := 0;
if Pal = 0 then Exit;
PaletteSize := 0;
if GetObject(Pal, SizeOf(PaletteSize), @PaletteSize) = 0 then Exit;
if PaletteSize = 0 then Exit;
with LogPal do
begin
palVersion := $0300;
palNumEntries := PaletteSize;
GetPaletteEntries(Pal, 0, PaletteSize, palPalEntry);
for i := 0 to palNumEntries-1 do
FillChar(palPalEntry[i],3, (palPalEntry[i].peRed+
palPalEntry[i].peGreen+
palPalEntry[i].peBlue) div 3);
end;
Result := CreatePalette(PLogPalette(@LogPal)^);
end;
procedure GrayBitmap(Bitmap: TBitmap);
var
Dest: TBitmap;
SrcRow, DstRow: PByteArray;
DstDif, SrcDif, x, y, bpp: Integer;
begin
GetScanLineProperties(Bitmap, Pointer(SrcRow), SrcDif);
case Bitmap.PixelFormat of
{ palette - need only to gray the palette entries }
pf1Bit, pf4Bit, pf8Bit:
begin
Bitmap.Palette := GrayPaletteEntries(Bitmap.Palette);
end;
{ true color - will reduce to 8-bit palette (slower but saves memory) }
pf15Bit, pf16Bit:
begin
raise Exception.Create('Not implemented! I am tired! Try promoting the bitmap to pf24/32bit before calling the function!');
end;
pf24Bit, pf32Bit:
begin
Dest := TBitmap.Create;
try
Dest.PixelFormat := pf8Bit;
Dest.Width := Bitmap.Width;
Dest.Height := Bitmap.Height;
Dest.Palette := BuildGrayPalette(pf8bit);
GetScanLineProperties(Dest, Pointer(DstRow), DstDif);
if Bitmap.PixelFormat = pf24bit then bpp := 3 else bpp := 4;
for y := 0 to Pred(Bitmap.Height) do
begin
for x := 0 to Pred(Bitmap.Width) do
DstRow[x] := (SrcRow[x*bpp]+SrcRow[x*bpp+1]+SrcRow[x*bpp+2]) div 3;
Inc(Integer(SrcRow), SrcDif);
Inc(Integer(DstRow), DstDif);
end;
Bitmap.Assign(Dest);
finally
Dest.Free;
end;
end;
end;
end;
procedure GrayGraphic(Graphic: TGraphic);
var
Work: TBitmap;
begin
Work := TBitmap.Create;
try
// the majority of TGraphic class knows how to assign itself to bitmaps (method AssignTo)
Work.Assign(Graphic);
if Work.PixelFormat in [pf15Bit, pf16Bit] then
Work.PixelFormat := pf32Bit; // 32-bit bitmaps are the fastest true color
GrayBitmap(Work);
Graphic.Assign(Work);
Graphic.Modified := True;
finally
Work.Free;
end;
end;
{ TForm1 }
procedure TForm1.btnOpenClick(Sender: TObject);
begin
if OpenPic.Execute then
Image1.Picture.LoadFromFile(OpenPic.FileName);
end;
procedure TForm1.btnGrayBitmapClick(Sender: TObject);
begin
GrayBitmap(Image1.Picture.Graphic as TBitmap);
end;
procedure TForm1.btnGrayGraphicClick(Sender: TObject);
begin
GrayGraphic(Image1.Picture.Graphic);
end;
end.
---- FORM AS TEXT ----- COPY AND PAST IT TO NOTEPAD AND SAVE AS UNIT1.DFM -----
object Form1: TForm1
Left = 290
Top = 129
Width = 696
Height = 480
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object Image1: TImage
Left = 88
Top = 8
Width = 225
Height = 209
AutoSize = True
end
object btnOpen: TBitBtn
Left = 8
Top = 8
Width = 75
Height = 25
Caption = '&Open Picture'
TabOrder = 0
OnClick = btnOpenClick
end
object btnGrayBitmap: TBitBtn
Left = 8
Top = 40
Width = 75
Height = 25
Caption = '&Gray Bitmap'
TabOrder = 1
OnClick = btnGrayBitmapClick
end
object btnGrayGraphic: TBitBtn
Left = 8
Top = 72
Width = 75
Height = 25
Caption = '&Gray Graphic'
TabOrder = 2
OnClick = btnGrayGraphicClick
end
object OpenPic: TOpenPictureDialog
Left = 32
Top = 136
end
end
-------
The form has three buttons. The first will load a picture and show it in the Image control. The second will try to gray the graphic stored in the picture property of the TImage as if it was a Bitmap (it will fail if it isn't a Bitmap). And the third will call the GrayGraphic which will work for bitmaps and other compatible TGraphic descendants.
Try to load Jpegs to see taht the code work even with other TGraphics. If you have other third-party supplied, and fully working TGraphic descendant, try adding them to the unit1 (TGifImage for example), and you'll see that it also works with them.
I hope that you can get some good things out of this article (ScanLine manipulation, bitmap format information, TGraphic relationships, etc.) or that it proves useful to you.
]]>