[Solved] Change background color of a BMP

[bobonwhidbey]

My goal is to change all the pixels of a BMP that are "kinda" white to a new HiliteColor. I tried to adapt some code that worked in Delphi but it didn't convert well. The following is my "labor intensive" approach, but it's not working. I'd like to think that there's a better way. If not I'd like to get this code working in Laz.

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

1. const
2.   delta = 50;  // from trial and error
3.   maxd = 255 - delta;
4. var
5.   Row: PRGBQUAD;
6.   x, y: integer;
7.   R, G, B: cardinal;
8. begin
9.   BMP.Assign(CardBMP); // copy original to a BMP component
10.   R := GetRValue(HiliteColor);
11.   G := GetGValue(HiliteColor);
12.   B := GetBValue(HiliteColor);
13.   for y := 0 to BMP.Height - 1 do
14.   begin
15.     Row := BMP.Scanline[y]; // process one line at a time
16.     for x := 0 to BMP.Width - 1 do
17.       with Row[x] do // process one pixel at a time in each line
18.         if (rgbRed > maxd) and (rgbGreen > maxd) and (rgbBlue > maxd) then
19.         begin
20.           Row[x].rgbRed := R; //
21.           Row[x].rgbGreen := G;
22.           Row[x].rgbBlue := b;
23.         end;
24.   end;
25.   CardBMP.Assign(BMP);
26. end; // ColorHilite
27.  
28.  

it would seem that I need to overwrite the old row with this new changed Row.
 something like the opposite of Scanline 

[PatBayford]

In Delphi you would use the Pixels property of the BMP objects canvas to do this - not sure if this is available in Lazarus!
(property is : property Pixels[X, Y: Integer]: TColor;)

[Mr.Madguy]

Why do you need to do it at runtime? Can you use pre-baked bitmaps? If you really need to do it at runtime (for example if you need to change background color many times), then fastest way - to prepare mask bitmap first and then use it as mask, when filling background with desired color. GDI isn't good for per-pixel operations, so this thing is a little bit tricky. I'm busy now, but I'll show you example later, if you will be interested in this approach.

[Ñuño_Martínez]

As Mr.Madguy this would be a bit tricky using GDI and FCL.  Better use a graphics library.  Here you have the list of available grahpics libraries at the wiki, including game libraries and game engines.  If you only need to do color changes, BGRABitmap may be your best choice.

[Handoko]

@bobonwhidbey

I have not tried your code but because I recently posted an answer to a thread asking how to get bitmap color data, I improved that code, which I think it is maybe is what you want. Here is the previous thread:
http://forum.lazarus.freepascal.org/index.php/topic,37242.0.html

I have found, which I think a bug or maybe the documentation's bug. Using assign to copy bitmap data won't create a separate copy, but they will share same data location. I think it is the culprit that causing the issue.

Try my code, it works. After open the image, move your mouse pointer on the image and press 'C'. The target color is clGreen, it was harcoded, change it if you want. You can download the test.zip to try.

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

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Graphics, Dialogs, StdCtrls, ExtCtrls, LCLType,
9.   Spin;
10.  
11. type
12.  
13.   { TForm1 }
14.  
15.   TForm1 = class(TForm)
16.     Button1: TButton;
17.     Image1: TImage;
18.     Image2: TImage;
19.     Label1: TLabel;
20.     Label2: TLabel;
21.     Label3: TLabel;
22.     OpenDialog1: TOpenDialog;
23.     Shape1: TShape;
24.     SpinEdit1: TSpinEdit;
25.     procedure Button1Click(Sender: TObject);
26.     procedure Button1KeyPress(Sender: TObject; var Key: char);
27.     procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer
28.       );
29.   public
30.     procedure ChangeColor(oldColor, newColor: TColor; Tolerance: Byte);
31.   end;
32.  
33. var
34.   Form1: TForm1;
35.  
36. implementation
37.  
38. const
39.   SelectedColor: TColor = clWhite;
40.   TargetColor = clGreen; // Change target color here
41.  
42. {$R *.lfm}
43.  
44. { TForm1 }
45.  
46. procedure TForm1.Button1Click(Sender: TObject);
47. var
48.   AJpg:  TJPEGImage;
49. begin
50.   if not(OpenDialog1.Execute) then Exit;
51.   AJpg := TJpegImage.Create;
52.   AJpg.LoadFromFile(OpenDialog1.FileName);
53.   Image1.Picture.Bitmap.Assign(AJpg);
54.   AJpg.Free;
55.   Image1.Enabled := True;
56.   Image2.Enabled := True;
57. end;
58.  
59. procedure TForm1.Button1KeyPress(Sender: TObject; var Key: char);
60. begin
61.   if (Key = 'c') or (Key = 'C') then
62.     ChangeColor(SelectedColor, TargetColor, SpinEdit1.Value);
63. end;
64.  
65. procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
66.   Y: Integer);
67. var
68.   ScanData: PRGBQuad;
69.   ValR, ValG, ValB: Byte;
70. begin
71.  
72.   // Point to the pixel's data location
73.   ScanData := Image1.Picture.Bitmap.ScanLine[Y];
74.   Inc(ScanData, X);
75.  
76.   // Get RGB values of the pixel
77.   ValR := ScanData^.rgbRed;
78.   ValG := ScanData^.rgbGreen;
79.   ValB := ScanData^.rgbBlue;
80.   SelectedColor := RGBToColor(ValR, ValG, ValB);
81.  
82.   // Show information of the pixel
83.   Shape1.Brush.Color := RGBToColor(ValR, ValG, ValB);
84.   Label1.Caption := 'x'+IntToStr(X)+':y'+IntToStr(Y)+' = r'+
85.     IntToStr(ValR)+', g'+IntToStr(ValG)+', b'+IntToStr(ValB);
86.  
87. end;
88.  
89. procedure TForm1.ChangeColor(oldColor, newColor: TColor; Tolerance: Byte);
90. var
91.   ScanData, ResultData: PRGBQuad;
92.   CurR, CurG, CurB: Byte; // Current pixels' RGB
93.   ReqR, ReqG, ReqB: Byte; // Required RGB
94.   TarR, TarG, TarB: Byte; // Target RGB
95.   X, Y: Integer;
96. begin
97.  
98.   ReqR := Red(oldColor);
99.   ReqG := Green(oldColor);
100.   ReqB := Blue(oldColor);
101.   TarR := Red(newColor);
102.   TarG := Green(newColor);
103.   TarB := Blue(newColor);
104.  
105.   // Don't use assign to avoid sharing same data location
106.   Image2.Picture.Bitmap := TBitmap.Create;
107.   Image2.Picture.Bitmap.Height := Image1.Picture.Bitmap.Height;
108.   Image2.Picture.Bitmap.Width := Image1.Picture.Bitmap.Width;
109.  
110.   for Y := 0 to (Image1.Picture.Bitmap.Height-1) do
111.   begin
112.     ScanData := Image1.Picture.Bitmap.ScanLine[Y];
113.     ResultData := Image2.Picture.Bitmap.ScanLine[Y];
114.     for X:= 0 to (Image1.Picture.Bitmap.Width-1) do
115.     begin
116.       ResultData^ := ScanData^;
117.       CurR := ScanData^.rgbRed;
118.       CurG := ScanData^.rgbGreen;
119.       CurB := ScanData^.rgbBlue;
120.       if (abs(CurR-ReqR) < Tolerance) and
121.         (abs(CurG-ReqG) < Tolerance) and
122.         (abs(CurB-ReqB) < Tolerance) then
123.         begin
124.           ResultData^.rgbRed := TarR;
125.           ResultData^.rgbGreen := TarG;
126.           ResultData^.rgbBlue := TarB;
127.         end;
128.       Inc(ScanData);
129.       Inc(ResultData);
130.     end;
131.   end;
132.  
133. end;
134.  
135. end.

---edit---
Line #83 should use SelectedColor.

[Mr.Madguy]

I've written my example, but unfortunately it doesn't work. Main idea: to make mask, that would make background transparent. Then, all we would need - to fill background with any arbitrary color and then draw our transparent bitmap over it.

I have two variants:
1) First create default mask bitmap and then modify it
2) Create mask bitmap and then set it to bitmap

Both don't work. Once I touch mask bitmap - card stops being displayed, despite of all code being properly executed (according to debugging). 

Currently I have no time to solve this problem, but I'll try to do it later.

Variant 1:

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

1. unit TestMain;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls;
9.  
10. type
11.  
12.   { TCardTestForm }
13.  
14.   TCardTestForm = class(TForm)
15.     Image1: TImage;
16.     procedure FormCreate(Sender: TObject);
17.     procedure FormDestroy(Sender: TObject);
18.     procedure Image1Click(Sender: TObject);
19.   private
20.     { private declarations }
21.   public
22.     { public declarations }
23.     CardBitmap:TBitmap;
24.     procedure DrawBitmap;
25.   end;
26.  
27. var
28.   CardTestForm: TCardTestForm;
29.  
30. implementation
31.  
32. {$R *.lfm}
33.  
34. { TCardTestForm }
35.  
36. type
37.   TABGR = packed record
38.     R, G, B, A: Byte;
39.   end;
40.  
41.   TABGRColor = record
42.     case Boolean of
43.       False:(Color:TColor);
44.       True:(ABGR:TABGR);
45.   end;
46.  
47. const
48.   Delta = 60;
49.   MaxColor = 255 - Delta;
50.  
51. procedure TCardTestForm.FormCreate(Sender: TObject);
52.   var MaskBitmap:TBitmap;
53.   I, J:Integer;C:TABGRColor;
54. begin
55.   Randomize;
56.   with Image1.Picture do begin
57.     Bitmap.Assign(TBitmap.Create);
58.     Bitmap.Width := 640;
59.     Bitmap.Height := 640;
60.     Bitmap.Canvas.FillRect(0, 0, Bitmap.Width, Bitmap.Height);
61.   end;
62.   CardBitmap := TBitmap.Create;
63.   CardBitmap.LoadFromFile('Card.bmp');
64.   CardBitmap.Transparent := True;
65.   {Can be loaded from file too}
66.   MaskBitmap := TBitmap.Create;
67.   MaskBitmap.Handle := CardBitmap.MaskHandle;
68.   for I := 0 to CardBitmap.Width - 1 do begin
69.     for J := 0 to CardBitmap.Height - 1 do begin
70.       C.Color := CardBitmap.Canvas.Pixels[I, J];
71.       if (C.ABGR.R > MaxColor) and (C.ABGR.G > MaxColor) and (C.ABGR.B > MaxColor) then begin
72.         MaskBitmap.Canvas.Pixels[I, J] := clWhite;
73.       end
74.       else begin
75.         MaskBitmap.Canvas.Pixels[I, J] := clBlack;
76.       end;
77.     end;
78.   end;
79.   MaskBitmap.Free;
80.   DrawBitmap;
81. end;
82.  
83. procedure TCardTestForm.FormDestroy(Sender: TObject);
84. begin
85.   CardBitmap.Free;
86. end;
87.  
88. procedure TCardTestForm.Image1Click(Sender: TObject);
89. begin
90.   DrawBitmap;
91. end;
92.  
93. procedure TCardTestForm.DrawBitmap;
94. begin
95.   with Image1.Picture do begin
96.     {Random background color}
97.     Bitmap.Canvas.Brush.Color := Random(clWhite);
98.     Bitmap.Canvas.FillRect(0, 0, CardBitmap.Width, CardBitmap.Height);
99.     Bitmap.Canvas.Draw(0, 0, CardBitmap);
100.   end;
101. end;
102.  
103. end.
104.  

Variant 2:

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

1. unit TestMain;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls;
9.  
10. type
11.  
12.   { TCardTestForm }
13.  
14.   TCardTestForm = class(TForm)
15.     Image1: TImage;
16.     procedure FormCreate(Sender: TObject);
17.     procedure FormDestroy(Sender: TObject);
18.     procedure Image1Click(Sender: TObject);
19.   private
20.     { private declarations }
21.   public
22.     { public declarations }
23.     CardBitmap, MaskBitmap:TBitmap;
24.     procedure DrawBitmap;
25.   end;
26.  
27. var
28.   CardTestForm: TCardTestForm;
29.  
30. implementation
31.  
32. {$R *.lfm}
33.  
34. { TCardTestForm }
35.  
36. type
37.   TABGR = packed record
38.     R, G, B, A: Byte;
39.   end;
40.  
41.   TABGRColor = record
42.     case Boolean of
43.       False:(Color:TColor);
44.       True:(ABGR:TABGR);
45.   end;
46.  
47. const
48.   Delta = 60;
49.   MaxColor = 255 - Delta;
50.  
51. procedure TCardTestForm.FormCreate(Sender: TObject);
52.   var I, J:Integer;C:TABGRColor;
53. begin
54.   Randomize;
55.   with Image1.Picture do begin
56.     Bitmap.Assign(TBitmap.Create);
57.     Bitmap.Width := 640;
58.     Bitmap.Height := 640;
59.     Bitmap.Canvas.FillRect(0, 0, Bitmap.Width, Bitmap.Height);
60.   end;
61.   CardBitmap := TBitmap.Create;
62.   CardBitmap.LoadFromFile('Card.bmp');
63.   {Can be loaded from file too}
64.   MaskBitmap := TBitmap.Create;
65.   MaskBitmap.Width := CardBitmap.Width;
66.   MaskBitmap.Height := CardBitmap.Height;
67.   for I := 0 to CardBitmap.Width - 1 do begin
68.     for J := 0 to CardBitmap.Height - 1 do begin
69.       C.Color := CardBitmap.Canvas.Pixels[I, J];
70.       if (C.ABGR.R > MaxColor) and (C.ABGR.G > MaxColor) and (C.ABGR.B > MaxColor) then begin
71.         MaskBitmap.Canvas.Pixels[I, J] := clWhite;
72.       end
73.       else begin
74.         MaskBitmap.Canvas.Pixels[I, J] := clBlack;
75.       end;
76.     end;
77.   end;
78.   CardBitmap.MaskHandle := MaskBitmap.Handle;
79.   CardBitmap.Masked := True;
80.   DrawBitmap;
81. end;
82.  
83. procedure TCardTestForm.FormDestroy(Sender: TObject);
84. begin
85.   CardBitmap.Free;
86.   MaskBitmap.Free;
87. end;
88.  
89. procedure TCardTestForm.Image1Click(Sender: TObject);
90. begin
91.   DrawBitmap;
92. end;
93.  
94. procedure TCardTestForm.DrawBitmap;
95. begin
96.   with Image1.Picture do begin
97.     {Random background color}
98.     Bitmap.Canvas.Brush.Color := Random(clWhite);
99.     Bitmap.Canvas.FillRect(0, 0, CardBitmap.Width, CardBitmap.Height);
100.     Bitmap.Canvas.Draw(0, 0, CardBitmap);
101.   end;
102. end;
103.  
104. end.
105.  

When either MaskBitmap.Handle := CardBitmap.MaskHandle; or  CardBitmap.MaskHandle := MaskBitmap.Handle; is commented - program works this way (mask bitmap is ok, as you can see):

[Handoko]

I'm not sure the cause of your issue. But I did some inspections why OP's code didn't work. I found the missing thing. Before changing the bitmap data (directly), we have to use TBitmap.BeginUpdate:

http://lazarus-ccr.sourceforge.net/docs/lcl/graphics/trasterimage.html
http://lazarus-ccr.sourceforge.net/docs/lcl/graphics/trasterimage.beginupdate.html

Perhaps it can solve your puzzle too.

The strange is, in my example I didn't use TBitmap.BeginUpdate. Instead I created a new TBitmap and it worked.

[Mr.Madguy]

I'm not sure the cause of your issue. But I did some inspections why OP's code didn't work. I found the missing thing. Before changing the bitmap data (directly), we have to use TBitmap.BeginUpdate:

http://lazarus-ccr.sourceforge.net/docs/lcl/graphics/trasterimage.html
http://lazarus-ccr.sourceforge.net/docs/lcl/graphics/trasterimage.beginupdate.html

Perhaps it can solve your puzzle too.

The strange is, in my example I didn't use TBitmap.BeginUpdate. Instead I created a new TBitmap and it worked.

It doesn't help. First variant works the same way (no card - just background) and in second variant mask bitmap becomes black (i.e. opaque card), but card is being displayed this time.

[Handoko]

I managed to fix your first variant. I haven't tested your second variant.

To make it work, you have to remove (or comment) line #79.
That's all.

Because:
MaskBitmap.Handle := CardBitmap.MaskHandle;

then it means MaskBitmap is linked to CardBitmap, so you should not free MaskBitmap. If you really want to free MaskBitmap, I guess you may need to set the handle to nil before calling MaskBitmap.Free.

Try it, it works on my tests!

edit:
Pixels[x, y] is slow, you should consider to use ScanLine.

[bobonwhidbey]

Here's a view of what I'm trying to accomplish. This picture is taken from my Delphi program that I'm trying to reproduce in Laz. In the example, I've made the background of the 8D red. It's not possible to rely on changing just one color (eg. clWhite) because there are many pixels that are almost white, especially in the face cards.

[Handoko]

You can increase the red, perhaps something like this:

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

1. var
2.   Z: Integer;
3.  
4. // Increase Red
5. Z := OriginalRed + 10;
6. if (Z > 255) then Z := 255;
7. OriginalRed := Z;
8.  
9. // Reduce Green
10. Z := OriginalGreen - 10;
11. if (Z < 0) then Z := 0;
12. OriginalGreen := Z;
13.  
14. // Reduce Blue
15. Z := OriginalBlue - 10;
16. if (Z < 0) then Z := 0;
17. OriginalBlue := Z;

You need the Z (as Integer) because the original values are Byte, increasing it over 255 may cause overflow error.

[Handoko]

Your original code should work correctly if you use
TBitmap.BeginUpdate

http://lazarus-ccr.sourceforge.net/docs/lcl/graphics/trasterimage.beginupdate.html

[Mr.Madguy]

I managed to fix your first variant. I haven't tested your second variant.

To make it work, you have to remove (or comment) line #79.
That's all.

Because:
MaskBitmap.Handle := CardBitmap.MaskHandle;

then it means MaskBitmap is linked to CardBitmap, so you should not free MaskBitmap. If you really want to free MaskBitmap, I guess you may need to set the handle to nil before calling MaskBitmap.Free.

Try it, it works on my tests!

edit:
Pixels[x, y] is slow, you should consider to use ScanLine.

Strange, but I actually suspected it and tried to either comment this line or to use global MaskBitmap, that was destroyed in OnDestroy (like in second variant) - and it didn't help. I'll try it next time.

P. S. Nope, isn't working.

[Handoko]

I didn't remember what I have changed. But this is the code that works. Tested on Linux64 Lazarus 1.6.4.

[Mr.Madguy]

Here's a view of what I'm trying to accomplish. This picture is taken from my Delphi program that I'm trying to reproduce in Laz. In the example, I've made the background of the 8D red. It's not possible to rely on changing just one color (eg. clWhite) because there are many pixels that are almost white, especially in the face cards.

I think, such result is usually accomplished via Alpha-blending. It's something like this:

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

1. type
2.   TABGR = packed record
3.     A, B, G, R: Byte;
4.   end;
5.  
6. function MyAlphaBlend(Color1, Color2:TColor;Alpha:Byte):TColor;  //Alpha of Color2!!!
7. begin
8.   TABGR(Result).R := (Integer(TABGR(Color2).R) * Integer(Alpha) + Integer(TABGR(Color1).R) * Integer(not Alpha)) shr 8;
9.   TABGR(Result).G := (Integer(TABGR(Color2).G) * Integer(Alpha) + Integer(TABGR(Color1).G) * Integer(not Alpha)) shr 8;
10.   TABGR(Result).B := (Integer(TABGR(Color2).B) * Integer(Alpha) + Integer(TABGR(Color1).B) * Integer(not Alpha)) shr 8;
11. end;
12.  
13. //Example!!!
14.  
15. DestBitmap.Canvas.Pixel[I, J] := MyAlphaBlend(SrcBitmap.Canvas.Pixel[I, J], clRed, 64);
16.  

I didn't remember what I have changed. But this is the code that works. Tested on Linux64 Lazarus 1.6.4.

Lazarus 1.6.4 too, but Windows is completely different beast.