Recent

Author Topic: [SOLVED] Lose BackgroundColor - Similar to ChromeKey  (Read 288 times)

pixelink

  • Hero Member
  • *****
  • Posts: 1118
    • Pixelink Media
[SOLVED] Lose BackgroundColor - Similar to ChromeKey
« on: August 19, 2019, 05:58:18 pm »
Okay... this is kind of complicated so follow carefully.

1) I am able to add several "layers" to a Bitmap by using PutImage

This code WORKS....

Code: Pascal  [Select]
  1.  
  2. {Apply Changes button}
  3. procedure TForm1.btnDesignApplyClick(Sender: TObject);
  4. var
  5.   str: String;
  6.   TImg: TImage;
  7.  
  8. begin
  9.  
  10.   str:='';
  11.  
  12.   {discard current bitmap}
  13.   BGRAGraphicControl1.DiscardBitmap;
  14.  
  15.   if txtBGColor.Text = 'NONE' Then
  16.      begin
  17.         theBMP:= TBGRABitmap.Create(img1.Picture.Bitmap);
  18.      end
  19.   else
  20.      begin
  21.       //TheBMP.Free;
  22.       theImage1 := TBGRABitmap.Create(BGRAGraphicControl1.Width, BGRAGraphicControl1.Height, StringToColor(txtBGColor.Text));
  23.       theImage1.FillRect(0, 0, BGRAGraphicControl1.Width, BGRAGraphicControl1.Height, StringToColor(txtBGColor.Text), dmSet);
  24.       theBMP.PutImage(0, 0, TheImage1, dmDrawWithTransparency );
  25.      end;
  26.  
  27.   str:=txtStyle.Text;
  28.   TImg:=getImgControl(str);
  29.   if txtStyle.Text = 'NONE' Then
  30.      {skip}
  31.   else
  32.      begin
  33.        theImage2:= TBGRABitmap.Create(TImg.Picture.Bitmap);
  34.        theBMP.PutImage(0, 0, theImage2, dmDrawWithTransparency );
  35.      end;
  36.  
  37.   str:=txtMouth.Text;
  38.   TImg:=getImgControl(str);
  39.   if txtMouth.Text = 'NONE' Then
  40.      {skip}
  41.   else
  42.      begin
  43.        theImage3:= TBGRABitmap.Create(TImg.Picture.Bitmap);
  44.        theBMP.PutImage(0, 0, theImage3, dmDrawWithTransparency );
  45.      end;
  46.  
  47.   str:=txtEyes.Text;
  48.   TImg:=getImgControl(str);
  49.   if txtEyes.Text = 'NONE' Then
  50.      {skip}
  51.   else
  52.      begin
  53.        theImage4:= TBGRABitmap.Create(TImg.Picture.Bitmap);
  54.        theBMP.PutImage(0, 0, theImage4, dmDrawWithTransparency );
  55.      end;
  56.  
  57.   str:=txtClothes.Text;
  58.   TImg:=getImgControl(str);
  59.   if txtClothes.Text = 'NONE' Then
  60.      {skip}
  61.   else
  62.      begin
  63.        theImage5:= TBGRABitmap.Create(TImg.Picture.Bitmap);
  64.        theBMP.PutImage(0, 0, theImage5, dmDrawWithTransparency );
  65.      end;
  66.  
  67.   str:=txtHair.Text;
  68.   TImg:=getImgControl(str);
  69.   if txtHair.Text = 'NONE' Then
  70.      {skip}
  71.   else
  72.      begin
  73.        theImage6:= TBGRABitmap.Create(TImg.Picture.Bitmap);
  74.        theBMP.PutImage(0, 0, theImage6, dmDrawWithTransparency );
  75.      end;
  76.  
  77.   str:=txtFacialHair.Text;
  78.   TImg:=getImgControl(str);
  79.   if txtFacialHair.Text = 'NONE' Then
  80.      {skip}
  81.   else
  82.      begin
  83.        theImage7:= TBGRABitmap.Create(TImg.Picture.Bitmap);
  84.        theBMP.PutImage(0, 0, theImage7, dmDrawWithTransparency );
  85.      end;
  86.  
  87.   str:=txtGlasses.Text;
  88.   TImg:=getImgControl(str);
  89.   if txtGlasses.Text = 'NONE' Then
  90.      {skip}
  91.   else
  92.      begin
  93.        theImage7:= TBGRABitmap.Create(TImg.Picture.Bitmap);
  94.        theBMP.PutImage(0, 0, theImage7, dmDrawWithTransparency );
  95.      end;
  96.  
  97. // THIS ALL WORKS FINE. I GET MANY LAYERS PU INTO ONE "theBMP"
  98.  
  99. end;
  100.  

2) I Transfer "theBMP" to another BGRAGraphicControl on another notebook window.

This code WORKS

Code: Pascal  [Select]
  1.  
  2. procedure TForm1.mnuExportImgClick(Sender: TObject);
  3. begin
  4.   nb.PageIndex:=2;
  5.   BGRAGraphicControl2.DiscardBitmap;
  6.  
  7.   newBMP:= TBGRABitmap.Create(theBMP.Bitmap);
  8.   newBMP.PutImage(0, 0, theBMP, dmDrawWithTransparency );
  9.  
  10.  //resize bitmap
  11.  newBMP.ResampleFilter:= rfBestQuality;
  12.  BGRAReplace(newBMP, newBMP.Resample(400, 400));
  13.  
  14. // THIS CODE WORKS FINE
  15. end;
  16.  


3) However, when I resize the BMP to say a size of 300x300 the red background fill disappears, but leaves a thing anti-alias border... similar to what Chroma-Key does.
But, I don't do any chroma-key at all.

Why is this happenening??

This code DOES NOT WORK

Code: Pascal  [Select]
  1.  
  2. procedure TForm1.opt2Change(Sender: TObject);
  3. begin
  4.     if opt2.Checked Then;
  5.      begin
  6.        //resize visual controls
  7.        Image2.Width:=300;
  8.        Image2.Height:=300;
  9.        BGRAGraphicControl2.width:=300;
  10.        BGRAGraphicControl2.Height:=300;
  11.  
  12.        BGRAGraphicControl2.DiscardBitmap;
  13.        newBMP:= TBGRABitmap.Create(theBMP.Bitmap);
  14.  
  15.        //resize bitmap
  16.        newBMP.ResampleFilter:= rfBestQuality;
  17.        BGRAReplace(newBMP, newBMP.Resample(300, 300));
  18.      end;
  19. end;  
  20.  
  21.  

Thanks in advanced
« Last Edit: August 19, 2019, 08:53:59 pm by pixelink »
Can't Type - Forgetful - Had Stroke = Forgive this old man!

Pixelink Media
LAZ 2.02 • Win10 • 16G RAM • Nivida GForce RTX 2060

pixelink

  • Hero Member
  • *****
  • Posts: 1118
    • Pixelink Media
Re: Lose BackgroundColor - Similar to ChromeKey
« Reply #1 on: August 19, 2019, 06:00:56 pm »
Also... FYI...

The red background is draw on the control using FillRect

But, everything else you see are PNG images
Can't Type - Forgetful - Had Stroke = Forgive this old man!

Pixelink Media
LAZ 2.02 • Win10 • 16G RAM • Nivida GForce RTX 2060

pixelink

  • Hero Member
  • *****
  • Posts: 1118
    • Pixelink Media
Re: Lose BackgroundColor - Similar to ChromeKey
« Reply #2 on: August 19, 2019, 07:00:33 pm »
Okay.. I have it narrowed down to the code that causes the red BG to disappear...

Its the re-sampling code.. both lines cause it
And just resizing the control (in code) does it even when commenting the two lines below.

But, If I don't resize the control, and both lines below are commented out, it redraws correctly.

So, resizing in conjunction with re-sampling knocks out the red.


Code: Pascal  [Select]
  1.  
  2. //resize bitmap
  3.        newBMP.ResampleFilter:= rfBestQuality;
  4.        BGRAReplace(newBMP, newBMP.Resample(300, 300));
  5.  
  6.  


Now, how do i stop the re-sampling/re-sizing control from making Red background disappear??
« Last Edit: August 19, 2019, 07:17:56 pm by pixelink »
Can't Type - Forgetful - Had Stroke = Forgive this old man!

Pixelink Media
LAZ 2.02 • Win10 • 16G RAM • Nivida GForce RTX 2060

circular

  • Hero Member
  • *****
  • Posts: 2954
    • Personal webpage
Re: Lose BackgroundColor - Similar to ChromeKey
« Reply #3 on: August 19, 2019, 07:21:15 pm »
Hi
What about replacing
Code: Delphi  [Select]
  1.        newBMP:= TBGRABitmap.Create(theBMP.Bitmap);
by
Code: Delphi  [Select]
  1.        newBMP:= TBGRABitmap.Create(theBMP);
?

Also normally after
Code: Delphi  [Select]
  1.       theImage1 := TBGRABitmap.Create(BGRAGraphicControl1.Width, BGRAGraphicControl1.Height, StringToColor(txtBGColor.Text));
you don't need
Code: Delphi  [Select]
  1.       theImage1.FillRect(0, 0, BGRAGraphicControl1.Width, BGRAGraphicControl1.Height, StringToColor(txtBGColor.Text), dmSet);
Conscience is the debugger of the mind

pixelink

  • Hero Member
  • *****
  • Posts: 1118
    • Pixelink Media
Re: Lose BackgroundColor - Similar to ChromeKey
« Reply #4 on: August 19, 2019, 07:24:15 pm »
Okay... further discovery...

I commencement out the entire block of code that does the resizing.
And now it still disappears by the control just redrawing

Here is my redraw code...


Code: Pascal  [Select]
  1.  
  2. procedure TForm1.BGRAGraphicControl2Redraw(Sender: TObject; Bitmap: TBGRABitmap
  3.   );
  4. begin
  5.   BGRAGraphicControl2.Bitmap.Assign(newBMP);
  6.  
  7.   if assigned(newBMP) then
  8.   begin
  9.     newBMP.Draw(Canvas,0,0,false); //true makes it opaque - false makes transparen
  10.   end;
  11.  
  12. end;  
  13.  
  14.  

So how is the redraw knocking our rge red background, when it was there when I firs open this window.

Only if I click on some other control resize the form it invokes as redraw.
Can't Type - Forgetful - Had Stroke = Forgive this old man!

Pixelink Media
LAZ 2.02 • Win10 • 16G RAM • Nivida GForce RTX 2060

pixelink

  • Hero Member
  • *****
  • Posts: 1118
    • Pixelink Media
Re: Lose BackgroundColor - Similar to ChromeKey
« Reply #5 on: August 19, 2019, 07:25:17 pm »
Hi
What about replacing
Code: Delphi  [Select]
  1.        newBMP:= TBGRABitmap.Create(theBMP.Bitmap);
by
Code: Delphi  [Select]
  1.        newBMP:= TBGRABitmap.Create(theBMP);
?

Also normally after
Code: Delphi  [Select]
  1.       theImage1 := TBGRABitmap.Create(BGRAGraphicControl1.Width, BGRAGraphicControl1.Height, StringToColor(txtBGColor.Text));
you don't need
Code: Delphi  [Select]
  1.       theImage1.FillRect(0, 0, BGRAGraphicControl1.Width, BGRAGraphicControl1.Height, StringToColor(txtBGColor.Text), dmSet);

okay.. give me a minute to try that
Can't Type - Forgetful - Had Stroke = Forgive this old man!

Pixelink Media
LAZ 2.02 • Win10 • 16G RAM • Nivida GForce RTX 2060

pixelink

  • Hero Member
  • *****
  • Posts: 1118
    • Pixelink Media
Re: Lose BackgroundColor - Similar to ChromeKey
« Reply #6 on: August 19, 2019, 07:30:50 pm »
Okay... commenting out FillRect did't effect the disappearing Red either way.
But, I do see what you mean it is redundant. So, I removed it.

So, it was removing the ".bitmap" on the create event that worked.

It Works!!!
Once again... You're the BOMB!!
 :o


THANKS LAINZ  CIRCULAR
« Last Edit: August 19, 2019, 08:55:00 pm by pixelink »
Can't Type - Forgetful - Had Stroke = Forgive this old man!

Pixelink Media
LAZ 2.02 • Win10 • 16G RAM • Nivida GForce RTX 2060

circular

  • Hero Member
  • *****
  • Posts: 2954
    • Personal webpage
Re: Lose BackgroundColor - Similar to ChromeKey
« Reply #7 on: August 19, 2019, 07:32:58 pm »
You don't need to call Draw in the Redraw function. This is done by the control. You just need to set up the content of BGRAGraphicControl2.Bitmap.

So replace this
Code: Pascal  [Select]
  1. procedure TForm1.BGRAGraphicControl2Redraw(Sender: TObject; Bitmap: TBGRABitmap
  2.   );
  3. begin
  4.   BGRAGraphicControl2.Bitmap.Assign(newBMP);
  5.  
  6.   if assigned(newBMP) then
  7.   begin
  8.     newBMP.Draw(Canvas,0,0,false); //true makes it opaque - false makes transparen
  9.   end;
  10.  
  11. end;  
  12.  
by this
Code: Pascal  [Select]
  1. procedure TForm1.BGRAGraphicControl2Redraw(Sender: TObject; Bitmap: TBGRABitmap
  2.   );
  3. begin
  4.   Bitmap.Assign(newBMP);
  5. end;  
  6.  

Or even that would make more sense:
Code: Pascal  [Select]
  1. procedure TForm1.BGRAGraphicControl2Redraw(Sender: TObject; Bitmap: TBGRABitmap
  2.   );
  3. begin
  4.   Bitmap.PutImage(0,0,newBMP,dmSet);
  5. end;  
  6.  
Conscience is the debugger of the mind

circular

  • Hero Member
  • *****
  • Posts: 2954
    • Personal webpage
Re: Lose BackgroundColor - Similar to ChromeKey
« Reply #8 on: August 19, 2019, 07:35:23 pm »
Okay... commenting out FillRect did't effect the disappearing Red either way.
But, I do see what you mean it is redundant. So, I removed it.

So, it was removing the ".bitmap" on the create event.

It Works!!!
Once again... You're the BOMB!!
 :o


THANKS LAINZ
I am not Lainz, I am circular, but you're welcome.

So for the explanation, a TBitmap can have a color considered as transparent. By default it is a color in a corner.
Conscience is the debugger of the mind

pixelink

  • Hero Member
  • *****
  • Posts: 1118
    • Pixelink Media
Re: Lose BackgroundColor - Similar to ChromeKey
« Reply #9 on: August 19, 2019, 08:31:23 pm »
Okay... commenting out FillRect did't effect the disappearing Red either way.
But, I do see what you mean it is redundant. So, I removed it.

So, it was removing the ".bitmap" on the create event.

It Works!!!
Once again... You're the BOMB!!
 :o

THANKS LAINZ
I am not Lainz, I am circular, but you're welcome.

So for the explanation, a TBitmap can have a color considered as transparent. By default it is a color in a corner.

Sorry... you both have the same Avatar... my mistake Cicular. I know you and Lainz work on the BGRA... I am liking this system.
« Last Edit: August 19, 2019, 08:33:16 pm by pixelink »
Can't Type - Forgetful - Had Stroke = Forgive this old man!

Pixelink Media
LAZ 2.02 • Win10 • 16G RAM • Nivida GForce RTX 2060

circular

  • Hero Member
  • *****
  • Posts: 2954
    • Personal webpage
Re: [SOLVED] Lose BackgroundColor - Similar to ChromeKey
« Reply #10 on: August 19, 2019, 09:09:05 pm »
You're forgiven.

We don't have the same avatar though.
Conscience is the debugger of the mind

pixelink

  • Hero Member
  • *****
  • Posts: 1118
    • Pixelink Media
Re: [SOLVED] Lose BackgroundColor - Similar to ChromeKey
« Reply #11 on: August 20, 2019, 03:40:55 pm »
You're forgiven.

We don't have the same avatar though.

Yeah, you're right.

Not sure what i was thinking.
I did have a stroke in JAN 19, and my brain don't function right now :)
Can't Type - Forgetful - Had Stroke = Forgive this old man!

Pixelink Media
LAZ 2.02 • Win10 • 16G RAM • Nivida GForce RTX 2060

circular

  • Hero Member
  • *****
  • Posts: 2954
    • Personal webpage
Re: [SOLVED] Lose BackgroundColor - Similar to ChromeKey
« Reply #12 on: August 20, 2019, 06:08:22 pm »
Ok.

Hope you're alright.
Conscience is the debugger of the mind