Lazarus

Programming => General => Topic started by: bobonwhidbey on June 19, 2017, 11:59:29 pm

Title: [Solved] Change background color of a BMP
Post by: bobonwhidbey on June 19, 2017, 11:59:29 pm

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 

Title: Re: Change background color of a BMP
Post by: PatBayford on June 20, 2017, 02:36:08 am

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;)

Title: Re: Change background color of a BMP
Post by: Mr.Madguy on June 20, 2017, 08:40:01 am

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.

Title: Re: Change background color of a BMP
Post by: Ñuño_Martínez on June 20, 2017, 09:52:24 am

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 (http://wiki.lazarus.freepascal.org/Graphics_libraries) at the wiki, including game libraries and game engines.  If you only need to do color changes, BGRABitmap may be your best choice.

Title: Re: Change background color of a BMP
Post by: Handoko on June 20, 2017, 01:14:22 pm

@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.

Title: Re: Change background color of a BMP
Post by: Mr.Madguy on June 20, 2017, 02:29:23 pm

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):

Title: Re: Change background color of a BMP
Post by: Handoko on June 20, 2017, 02:40:39 pm

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.

Title: Re: Change background color of a BMP
Post by: Mr.Madguy on June 20, 2017, 02:57:25 pm

Quote from: Handoko on June 20, 2017, 02:40:39 pm

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.

Title: Re: Change background color of a BMP
Post by: Handoko on June 20, 2017, 04:48:08 pm

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.

Title: Re: Change background color of a BMP
Post by: bobonwhidbey on June 20, 2017, 05:01:20 pm

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.

Title: Re: Change background color of a BMP
Post by: Handoko on June 20, 2017, 05:07:20 pm

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.

Title: Re: Change background color of a BMP
Post by: Handoko on June 20, 2017, 05:10:18 pm

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

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

Title: Re: Change background color of a BMP
Post by: Mr.Madguy on June 20, 2017, 05:57:28 pm

Quote from: Handoko on June 20, 2017, 04:48:08 pm

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.

Title: Re: Change background color of a BMP
Post by: Handoko on June 20, 2017, 06:13:06 pm

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

Title: Re: Change background color of a BMP
Post by: Mr.Madguy on June 20, 2017, 06:21:05 pm

Quote from: bobonwhidbey on June 20, 2017, 05:01:20 pm

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.  

Quote from: Handoko on June 20, 2017, 06:13:06 pm

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. :'(

Title: Re: Change background color of a BMP
Post by: bobonwhidbey on June 20, 2017, 06:39:59 pm

I see that MaskEdit is a bitmap with either black or white pixels, and the goal is to have the white pixels of the Mask show up Red in the Image.Bitmap, while the black pixels of the mask should show the original pixel in the Image.Bitmap.

It doesn't look like MaskEdit is used when you fill the Image with
    Bitmap.Canvas.Draw(0, 0, CardBitmap);
When I run your Test app, all I get is a red card.

Title: Re: Change background color of a BMP
Post by: bobonwhidbey on June 20, 2017, 06:42:00 pm

I am using Win10. Do you think that's why we are getting different results?

Title: Re: Change background color of a BMP
Post by: Handoko on June 20, 2017, 06:51:04 pm

So, the results of Linux and Wndows are different?

Have you tried the my very first example and OP's code? With some modifications I think it will give you the result that you want.

Title: Re: Change background color of a BMP
Post by: Mr.Madguy on June 20, 2017, 06:57:33 pm

Quote from: bobonwhidbey on June 20, 2017, 06:39:59 pm

I see that MaskEdit is a bitmap with either black or white pixels, and the goal is to have the white pixels of the Mask show up Red in the Image.Bitmap, while the black pixels of the mask should show the original pixel in the Image.Bitmap.

It doesn't look like MaskEdit is used when you fill the Image with
    Bitmap.Canvas.Draw(0, 0, CardBitmap);
When I run your Test app, all I get is a red card.

1) This example doesn't work on Windows due to some unknown reasons - I have red card too. As I remember, such code worked in Delphi. Trying to fix it.
2) No, Lazarus uses weird algorithm like Dest = Dest xor Src; Dest = Dest and Mask; Dest = Dest xor Src; instead of MaskBlt. Therefore white means keeping dest (i.e. background) color and black means replacing it with src one.
3) You use wrong algorithm - you should use Alpha-blend, I described in my previous post. It puts transparent red film over your card.

Title: Re: Change background color of a BMP
Post by: Handoko on June 20, 2017, 07:22:56 pm

How about this result?

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.  
10. type
11.  
12.   { TForm1 }
13.  
14.   TForm1 = class(TForm)
15.     Button1: TButton;
16.     Button2: TButton;
17.     Image1: TImage;
18.     Image2: TImage;
19.     OpenDialog1: TOpenDialog;
20.     procedure Button1Click(Sender: TObject);
21.     procedure Button2Click(Sender: TObject);
22.   end;
23.  
24. var
25.   Form1: TForm1;
26.  
27. implementation
28.  
29. const
30.   RedShift = 40;
31.   GreenShift = -40;
32.   BlueShift = -40;
33.  
34. {$R *.lfm}
35.  
36. { TForm1 }
37.  
38. procedure TForm1.Button1Click(Sender: TObject);
39. var
40.   AJpg:  TJPEGImage;
41. begin
42.   if not(OpenDialog1.Execute) then Exit;
43.   AJpg := TJpegImage.Create;
44.   AJpg.LoadFromFile(OpenDialog1.FileName);
45.   Image1.Picture.Bitmap.Assign(AJpg);
46.   AJpg.Free;
47.   Button2.Enabled := True;
48. end;
49.  
50. procedure ChangeColor(var Data: Byte; Shift: Integer);
51. var
52.   Temp: Integer;
53. begin
54.   Temp := Data + Shift;
55.   if (Temp > 255) then Temp := 255
56.     else
57.       if (Temp < 0) then Temp := 0;
58.   Data := Temp;
59. end;
60.  
61. procedure TForm1.Button2Click(Sender: TObject);
62. var
63.   ScanData: PRGBQuad;
64.   X, Y: Integer;
65. begin
66.   Image2.Picture.Clear;
67.   Image2.Picture.Assign(Image1.Picture);
68.   Image2.Picture.Bitmap.BeginUpdate;
69.   for Y := 0 to (Image1.Picture.Bitmap.Height-1) do
70.   begin
71.     ScanData := Image2.Picture.Bitmap.ScanLine[Y];
72.     for X:= 0 to (Image1.Picture.Bitmap.Width-1) do
73.     begin
74.       ChangeColor(ScanData^.rgbRed, RedShift);
75.       ChangeColor(ScanData^.rgbGreen, GreenShift);
76.       ChangeColor(ScanData^.rgbBlue, BlueShift);
77.       Inc(ScanData);
78.     end;
79.   end;
80.   Image2.Picture.Bitmap.EndUpdate;
81. end;
82.  
83. end.

Title: Re: Change background color of a BMP
Post by: Mr.Madguy on June 20, 2017, 07:42:16 pm

Quote from: Handoko on June 20, 2017, 07:22:56 pm

How about this result?

Alpha-blend does almost the same, but it's more universal - you can even blend one picture over another. 8-)

Title: Re: Change background color of a BMP
Post by: Handoko on June 20, 2017, 07:44:31 pm

I agree alpha blend is more universal. I use it a lot on GIMP. But for less accuracy solutions, mine works good. It's very simple, so it is performance wise. :D

Title: Re: Change background color of a BMP
Post by: Mr.Madguy on June 20, 2017, 07:53:09 pm

Quote from: Handoko on June 20, 2017, 07:44:31 pm

I agree alpha blend is more universal. I use it a lot on GIMP. But for less accuracy solutions, mine works good. It's very simple, so it is performance wise. :D

It works fine with white background, but result may not be so nice in case of more complex pictures. Two extra integer multiplications aren't much slower on modern hardware. Also it's accelerated in most graphic libraries. Most SIMD extensions are designed with exactly such kind of operations in mind. For example, as I know, in 3D libraries texture color is mixed with vertex color by default, so all you need - to set desired vertex colors and that's it.

Title: Re: Change background color of a BMP
Post by: Handoko on June 20, 2017, 07:56:35 pm

Quote from: Mr.Madguy on June 20, 2017, 07:53:09 pm

... result may not be so nice in case of more complex pictures.

That's why I called it less accuracy solution.

Yours is good too, perhaps the best solution. Unfortunately it still has some bugs needed to fix. Maybe you can use may code but change the ChangeColor procedure with your MyAlphaBlend function.

Title: Re: Change background color of a BMP
Post by: Mr.Madguy on June 20, 2017, 08:23:23 pm

Quote from: Handoko on June 20, 2017, 07:56:35 pm

That's why I called it less accuracy solution.

Yours is good too, perhaps the best solution. Unfortunately it still has some bugs needed to fix. Maybe you can use may code but change the ChangeColor procedure with your MyAlphaBlend function.

Yeah, all, that is needed - to replace ChangeColor with MyAlphaBlend. With only once exception - MyAlphaBlend is function, that takes source color as first parameter and returns color as result, instead of passing color as var. Second color - can be constant or even color of pixel from another picture. Alpha - is 0..255. 0 means "take Color1", 255 means "take Color2". All other values - linear interpolation of this two.

Title: Re: Change background color of a BMP
Post by: bobonwhidbey on June 20, 2017, 09:17:24 pm

Thank you very much Madguy and Handoko. This all seems to work fine with JPG files. For some strange reason, not with BMPs.

This works in Button1
  AJpg.LoadFromFile('Jack.jpg');
  Image1.Picture.Bitmap.Assign(AJpg);     

This bombs when I click Button2, although it looks perfect after clicking Button1.
  Image1.Picture.Bitmap.LoadFromFile('Jack.bmp');

I'm not sure why it bombs.

Title: Re: Change background color of a BMP
Post by: Handoko on June 21, 2017, 04:15:52 am

I investigated your problem. What I got is, for bmp files you need to change how the data stored internally. So you have use:

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

1. var
2.   ScanData: PRGBTriple;

I tested it on Linux64, it worked.

Title: Re: Change background color of a BMP
Post by: bobonwhidbey on June 21, 2017, 06:41:34 am

This code, which is similar to my original, works perfectly. Thank you for your help.

If I comment out the  aJPG.Assign(CardBMP)  line, it does not work. This seems especially strange to me because the aJPG image is not being assigned to BMP. Just the process of assigning the JPG image seems to be necessary. Weird!

Unlike the fading approach you used, I prefer replacing the almost white pixels with the light red. This approach leaves all the non white colors, yellows and other colors, still as vibrant as before.

I tried PRGBTriple, also changing the colors to rgbTred, etc. but to no success.

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

1.   procedure ColorHilite;
2.   const
3.     delta = 50;  // from trial and error
4.     maxd = 255 - delta;
5.   var
6.     Row: PRGBQuad;
7.     x, y: integer;
8.     R, G, B: integer;
9.   begin
10.     aJPG.Assign(CardBMP);   // unknown why this is necessary
11.     BMP.Assign((CardBMP);  // weird, aJPG is not being assigned
12.     R := GetRValue(HiliteColor);
13.     G := GetGValue(HiliteColor);
14.     B := GetBValue(HiliteColor);
15.     BMP.BeginUpdate;
16.     for y := 0 to BMP.Height - 1 do
17.     begin
18.       Row := BMP.ScanLine[Y];
19.       for X := 0 to (BMP.Width - 1) do
20.       begin
21.         if (Row^.rgbRed > MaxD) and (Row^.rgbGreen > MaxD) and
22.           (Row^.rgbBlue > MaxD) then
23.         begin
24.           Row^.rgbRed := R;
25.           Row^.rgbGreen := G;
26.           Row^.rgbBlue := B;
27.         end;
28.         Inc(Row);
29.       end;   // for X
30.     end; // for Y
31.  
32.     BMP.EndUpdate;
33.     CardBMP.Assign(BMP);
34.   end; // ColorHilite  

Title: Re: Change background color of a BMP
Post by: Handoko on June 21, 2017, 07:06:00 am

Can you please provide the compilable code for me to test? Copy all the necessary files (exclude binary, *.exe, *.bak, images and lib folder) to a new folder. Compress that folder and send the zip file to this forum.

Title: Re: Change background color of a BMP
Post by: Mr.Madguy on June 21, 2017, 08:24:38 am

May be problem caused by the fact, that when you access raw JPG image - it's actually packed, so you can't access colors directly? That's, why I use BMPs.

Title: Re: Change background color of a BMP
Post by: Mr.Madguy on June 21, 2017, 08:51:11 am

I did it! Key to success - is ReleaseHandle.

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 = 100;
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.   {Can be loaded from file too}
65.   MaskBitmap := TBitmap.Create;
66.   MaskBitmap.Width := CardBitmap.Width;
67.   MaskBitmap.Height := CardBitmap.Height;
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.   CardBitmap.MaskHandle := MaskBitmap.ReleaseHandle;
80.   MaskBitmap.Free;
81.   DrawBitmap;
82. end;
83.  
84. procedure TCardTestForm.FormDestroy(Sender: TObject);
85. begin
86.   CardBitmap.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.  

Variant with simply loading pre-baked mask from file (Mask.bmp is saved in previous example via SaveToFile before ReleaseHandle):

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. procedure TCardTestForm.FormCreate(Sender: TObject);
37.   var MaskBitmap:TBitmap;
38. begin
39.   Randomize;
40.   with Image1.Picture do begin
41.     Bitmap.Assign(TBitmap.Create);
42.     Bitmap.Width := 640;
43.     Bitmap.Height := 640;
44.     Bitmap.Canvas.FillRect(0, 0, Bitmap.Width, Bitmap.Height);
45.   end;
46.   CardBitmap := TBitmap.Create;
47.   CardBitmap.LoadFromFile('Card.bmp');
48.   {Can be loaded from file too}
49.   MaskBitmap := TBitmap.Create;
50.   MaskBitmap.LoadFromFile('Mask.bmp');
51.   CardBitmap.MaskHandle := MaskBitmap.ReleaseHandle;
52.   MaskBitmap.Free;
53.   DrawBitmap;
54. end;
55.  
56. procedure TCardTestForm.FormDestroy(Sender: TObject);
57. begin
58.   CardBitmap.Free;
59. end;
60.  
61. procedure TCardTestForm.Image1Click(Sender: TObject);
62. begin
63.   DrawBitmap;
64. end;
65.  
66. procedure TCardTestForm.DrawBitmap;
67. begin
68.   with Image1.Picture do begin
69.     {Random background color}
70.     Bitmap.Canvas.Brush.Color := Random(clWhite);
71.     Bitmap.Canvas.FillRect(0, 0, CardBitmap.Width, CardBitmap.Height);
72.     Bitmap.Canvas.Draw(0, 0, CardBitmap);
73.   end;
74. end;
75.  
76. end.
77.  

Title: Re: Change background color of a BMP
Post by: Handoko on June 21, 2017, 09:03:54 am

That's great.

You're good in graphics programming, please consider to join the Graphics Contest 2017:
http://forum.lazarus.freepascal.org/index.php/topic,35313.0.html

Title: Re: Change background color of a BMP
Post by: Mr.Madguy on June 21, 2017, 09:30:07 am

Quote from: Handoko on June 21, 2017, 09:03:54 am

That's great.

You're good in graphics programming, please consider to join the Graphics Contest 2017:
http://forum.lazarus.freepascal.org/index.php/topic,35313.0.html

Eh. Sad thing about me - is that now I have to focus on other area in order to prepare tools for my application. I'm developing and testing my own custom data containers (yeah, I know, that inventing bicycle is bad thing, but I'm not satisfied with standard ones) - it's long and hard process, so I've already become hungry for programming of graphics. :'(

Title: Re: Change background color of a BMP
Post by: bobonwhidbey on June 21, 2017, 04:04:29 pm

Very nice Mr. Madguy.

Title: Re: [Solved] Change background color of a BMP
Post by: Handoko on June 21, 2017, 04:45:59 pm

Have you solved the issue?
Will you join the contest?
See you there.