Recent

Author Topic: Tinting pictures and videos  (Read 513 times)

user5

  • Sr. Member
  • ****
  • Posts: 363
Tinting pictures and videos
« on: October 02, 2024, 10:07:28 pm »
    I have often come to this forum for help so I thought it would be nice to return the favor/s. The attached code will tint a
grayscale or color picture or video image item with any chosen color, matching the density of the original item. I like to use
it to add color to grayscale foreground images that are surrounded by a solid background color which can be made transparent
when desired.
    Inserted into this code, a Raw Image pointer system will process 80 500x500 frames in 55 sec. BGRABitmap will do it in
56 sec. The time difference is negligible and the latter system can also access neighboring pixels so it is more useful.
    I don't think that it can be made faster but after all, we're talking about 20,000,000 pixels and each one has to be accessed.
    The listed headers include some that do no apply here but which do apply elsewhere in the program of which this code is a part.
    Enjoy, and as usual all praise to Lazarus.

 
Code: Pascal  [Select][+][-]
  1. uses
  2.   wincrt,Unit6,Unit5,Unit4,Unit3,Unit2,FileUtil,intfgraphics, windows, SysUtils,
  3.   Forms,  Controls, Graphics, LResources,FPimage, GraphUtil,
  4.   Process, ExtCtrls, Dialogs, StdCtrls,  LCLProc,  ActnList, LCLIntf, LCLType,
  5.   Interfaces, Buttons, ExtDlgs, Menus,  ComCtrls,  strutils,
  6.   Classes, GraphType,BGRABitmap, BGRABitmapTypes, EpikTimer;
  7.  
  8.  
  9. procedure TForm1.Button15Click(Sender: TObject);
  10. var tempstr:string;
  11.     chosencolor,newcolor:TColor;
  12.     x,y,lum,rednum,greennum,bluenum,code:integer;
  13.     tempred,tempgreen,tempblue,templum,val1,val2,val3:extended;
  14.     num1,num2,num3,num4,num5,num6,num7,U,V:extended;
  15.     bgra1:TBGRABitmap;
  16.     c:TBGRAPixel;
  17.     mybitmap,mybitmap2:TBitmap;
  18.     inf1,inf2:TLazIntfImage;
  19.     ImgFormatDescription: TRawImageDescription;
  20. begin
  21.  
  22.  form4go := false;
  23.  form4.button1.Enabled := true;
  24.  form4.Button1.visible := true;
  25.  form4.button1.caption := 'GO';
  26.  form4.paintbox1.color := clNone;
  27.  form4.statictext1.caption := '    This tool applies tinting with a chosen color to pictures and videos, including grayscale and colored images. Press GO to choose a tinting color or close this message to cancel.';
  28.  form4.show;
  29.  application.processmessages;
  30.  backgroundcolor := '';
  31.  image1.transparent := false;
  32.  while form4.visible = true do
  33.   begin
  34.    form4.bringtofront;
  35.    application.processmessages;
  36.   end;
  37.  form4.Button1.visible := false;
  38.  form4.button1.caption := 'Button1';
  39.  form4.button1.enabled := false;
  40.  
  41.  if (form4go = false) then
  42.   begin
  43.    form3.show;
  44.    if backgroundcolor = '' then
  45.    form3.statictext1.caption := 'Process cancelled by user.';
  46.    delay(1600);
  47.    application.processmessages;
  48.    form3.hide;
  49.    exit;
  50.   end;
  51.  
  52.  if colordialog1.execute = false then
  53.   exit;
  54.  
  55.  form2.show; //Please Wait message
  56.  application.processmessages;
  57.  
  58.  bgra1 := TBGRABitmap.create;
  59.  mybitmap := TBitmap.create;
  60.  mybitmap.width := image1.width;
  61.  mybitmap.height := image1.height;
  62.  
  63.  mybitmap2 := TBitmap.create;
  64.  mybitmap2.width := image1.width;
  65.  mybitmap2.height := image1.height;
  66.  
  67.  mybitmap.assign(image1.picture.bitmap);
  68.  bgra1.assign(mybitmap);
  69.  
  70.  chosencolor := colordialog1.color;
  71.  tintcolor := chosencolor;
  72.  
  73.  for y := 0 to (image1.height - 1) do
  74.   for x := 0 to (image1.width - 1) do
  75.    begin
  76.     c := bgra1.GetPixel(x,y); //Get each pixel
  77.     newcolor := BGRAToColor(c);
  78.  
  79.     GetRGBColorNumbers(newcolor,rednum,greennum,bluenum); //Get the red, green and blue numbers.
  80.  
  81.     //Get industry standard percentages
  82.     val1 := StrToFloat('0.299');
  83.     val2 := StrToFloat('0.587');
  84.     val3 := StrToFloat('0.114');
  85.  
  86.     num1 := StrToFloat('0.439');
  87.     num2 := StrToFloat('0.368');
  88.     num3 := StrToFloat('0.071');
  89.     num4 := StrToFloat('0.148');
  90.     num5 := StrToFloat('0.291');
  91.     num6 := StrToFloat('0.439');
  92.  
  93.     templum := (val1 * rednum) + (val2 * greennum) + (val3 * bluenum);
  94.     if templum < 0 then
  95.      templum := 1
  96.     else
  97.      if templum > 255 then
  98.       templum := 255;
  99.     lum := round(templum); //Lum = the luminance of each pixel.
  100.  
  101.     GetRGBColorNumbers(chosencolor,rednum,greennum,bluenum);
  102.  
  103.     V := (num1 * rednum) - (num2 * greennum) - (num3 * bluenum) + 128;
  104.     U := -(num4 * rednum) - (num5 * greennum) + (num6 * bluenum) + 128;
  105.  
  106.     num1 := StrToFloat('1.164');
  107.     num2 := StrToFloat('2.018');
  108.     num3 := StrToFloat('1.164');
  109.     num4 := StrToFloat('0.813');
  110.     num5 := StrToFloat('0.391');
  111.     num6 := StrToFloat('1.164');
  112.     num7 := StrToFloat('1.596');
  113.  
  114.     tempblue := (num1 * (lum - 16)) + (num2 * (U - 128));
  115.     tempgreen := (num3 * (lum - 16)) - (num4 * (V - 128)) - (num5 * (U - 128));
  116.     tempred :=  (num6 * (lum - 16)) + (num7 * (V -  128));
  117.  
  118.     //Ensure that no number is less than zero or larger than 255.
  119.     if tempred < 0 then
  120.      tempred := 0
  121.     else
  122.      if tempred > 255 then
  123.       tempred := 255;
  124.  
  125.     if tempgreen < 0 then
  126.      tempgreen := 0
  127.     else
  128.      if tempgreen > 255 then
  129.       tempgreen := 255;
  130.  
  131.     if tempblue < 0 then
  132.      tempblue := 0
  133.     else
  134.      if tempblue > 255 then
  135.       tempblue := 255;
  136.  
  137.     rednum := round(tempred);
  138.     greennum := round(tempgreen);
  139.     bluenum := round(tempblue);
  140.  
  141.     newcolor := RGBToColor(rednum, greennum, bluenum);
  142.     bgra1.SetPixel(x,y,newcolor);
  143.  
  144.    end;
  145.  
  146.   mybitmap.assign(bgra1);
  147.  
  148.   //The TLazIntfImage stuff ensures that the bitmap is 24 bit.
  149.   inf2:=TLazIntfImage.Create(mybitmap.Width,mybitmap.Height);
  150.   inf1:= mybitmap.CreateIntfImage;
  151.   try
  152.   ImgFormatDescription.Init_BPP24_B8G8R8_BIO_TTB(mybitmap.Width,mybitmap.Height);
  153.   inf2.DataDescription:=ImgFormatDescription;
  154.   inf2.CopyPixels(inf1);
  155.   mybitmap2.PixelFormat:=pf24bit;
  156.   mybitmap2.LoadFromIntfImage(inf2);
  157.   mybitmap2.PixelFormat:=pf24bit;
  158.   finally
  159.     inf1.free;
  160.     inf2.Free;
  161.   end;
  162.  
  163.   image1.picture.bitmap.assign(mybitmap2);
  164.  
  165.   tentativetinted := true; //Global variable
  166.   tinted := true; //Global variable
  167.   mybitmap.free;
  168.   mybitmap2.free;
  169.   bgra1.free;
  170.  
  171.   form2.hide;
  172.  
  173. end;







Khrys

  • Full Member
  • ***
  • Posts: 102
Re: Tinting pictures and videos
« Reply #1 on: October 03, 2024, 11:46:29 am »
Inserted into this code, a Raw Image pointer system [...]

I don't think that it can be made faster [...]

It can be made much, much faster by actually using a raw image, which you aren't doing here.
Take this example of a grayscale function (not using any floating-point math):

Code: Pascal  [Select][+][-]
  1. procedure ConvertToGrayscale(Bitmap: TBitmap);
  2. var
  3.   Line, Pixel: PRGBAQuad;
  4.   Luma: Byte;
  5.   X, Y: SizeInt;
  6. begin
  7.   Bitmap.PixelFormat := pf32bit;
  8.   with Bitmap, RawImage do begin
  9.     BeginUpdate();
  10.     for Y := 0 to Height - 1 do begin
  11.       Line := Pointer(GetLineStart(Y));
  12.       for X := 0 to Width - 1 do begin
  13.         Pixel := @Line[X];
  14.         Luma := (Cardinal(Pixel^.Red) * 76 + Pixel^.Green * 150 + Pixel^.Blue * 29) div 255;
  15.         Pixel^.Red := Luma;
  16.         Pixel^.Green := Luma;
  17.         Pixel^.Blue := Luma;
  18.       end;
  19.     end;
  20.     EndUpdate();
  21.   end;
  22. end;

user5

  • Sr. Member
  • ****
  • Posts: 363
Re: Tinting pictures and videos
« Reply #2 on: October 04, 2024, 12:21:06 am »
    Khrys, your code looks VERY interesting, elegant and short. Wowser. I will try it and report the results.
    I noticed that you used 32-bit and I wonder if this is for a technical reason or due to personal preference
and for the properties associated with 32-bit vrs. 24-bit. I plan to use it for 24-bit images if I can get it to
work. It compiles fine.
    Thank you very much. - User5

user5

  • Sr. Member
  • ****
  • Posts: 363
Re: Tinting pictures and videos
« Reply #3 on: October 04, 2024, 01:39:18 am »
    Every time that I run the code below based on your code, Image1 comes out black. If I try 24-bit then
the program crashes. Was something left out or am I missing something?

Code: Pascal  [Select][+][-]
  1. mybitmap := TBitmap.create;
  2.  mybitmap.width := image1.width;
  3.  mybitmap.height := image1.height;
  4.  mybitmap.assign(image1.picture.bitmap);
  5.  mybitmap.PixelFormat := pf32bit;
  6.   with mybitmap, RawImage do begin
  7.     BeginUpdate();
  8.     for y := 0 to image1.height - 1 do begin
  9.       Line := Pointer(GetLineStart(y));
  10.       for x := 0 to image1.width - 1 do begin
  11.         Pixel := @Line[x];
  12.         Luma := (Cardinal(Pixel^.Red) * 76 + Pixel^.Green * 150 + Pixel^.Blue * 29) div 255;
  13.         Pixel^.Red := Luma;
  14.         Pixel^.Green := Luma;
  15.         Pixel^.Blue := Luma;
  16.         //Was something left out here?
  17.       end;
  18.     end;
  19.     EndUpdate();
  20.   end;
  21.  
  22.  image1.picture.bitmap.assign(mybitmap);
  23.  mybitmap.free;


BasicOne

  • New Member
  • *
  • Posts: 16
Re: Tinting pictures and videos
« Reply #4 on: October 04, 2024, 05:45:10 am »

I do it similar in a class with 24 bit pictures, based on the source code I found somewhere. fBrightness is something between -1 and 1. The main difference is the replacement of the function GetLineStart() by some primitive pointer arithmetic taking into account the BytePerPixel. The RGB conversion functions are somewhere in the graphutil unit. I am not an expert of what these conversions do in detail, but the result is sufficient for my needs.


Code: Pascal  [Select][+][-]
  1. procedure tLTMap.ApplyBrightness(var aPicture: tPicture);
  2. type
  3.  tGraphPixelColor=packed record
  4.                             b:byte;
  5.                             g:byte;
  6.                             r:byte;
  7.                            end;
  8.  pGraphPixelColor=^tLTGraphPixelColor;
  9. var
  10.   X, Y: Integer;
  11.   PixelPtr: pGraphPixelColor;
  12.   PixelRowPtr: pGraphPixelColor;
  13.   RawImage: TRawImage;
  14.   BytePerPixel: Integer;
  15.   H,V,S:double;
  16.   r,g,b: integer;
  17.   Hl,Ll,Sl: byte;
  18. begin
  19.  if abs(self.fBrightness)>0.01 then begin
  20.  
  21.   try
  22.    RawImage := aPicture.Bitmap.RawImage;
  23.  
  24.    if RawImage.Data<>nil then begin
  25.     PixelRowPtr := pGraphPixelColor(RawImage.Data);
  26.     BytePerPixel := RawImage.Description.BitsPerPixel div 8;
  27.  
  28.     PixelPtr := PixelRowPtr;
  29.     for Y := 0 to aPicture.Bitmap.Height - 1 do begin
  30.      for X := 0 to aPicture.Bitmap.Width - 1 do begin
  31.       if self.fBrightness<1 then begin
  32.        RGBtoHSV(PixelPtr^.r,PixelPtr^.g,PixelPtr^.b,H,S,V);
  33.        v:=V*self.fBrightness;
  34.        HSVtoRGB(H,S,V,r,g,b);
  35.        PixelPtr^.r:=r;
  36.        PixelPtr^.g:=g;
  37.        PixelPtr^.b:=b;
  38.       end else begin
  39.        RGBtoHLS(PixelPtr^.r,PixelPtr^.g,PixelPtr^.b,Hl,Ll,Sl);
  40.        Ll:=trunc(Ll+(255-Ll)*(self.fBrightness-1));
  41.        HLStoRGB(Hl,Ll,Sl,PixelPtr^.r,PixelPtr^.g,PixelPtr^.b);
  42.       end;
  43.       Inc(PByte(PixelPtr), BytePerPixel);
  44.      end;
  45.     end;
  46.    end;
  47.   except
  48.   end;
  49.  
  50.  end;
  51. end;

user5

  • Sr. Member
  • ****
  • Posts: 363
Re: Tinting pictures and videos
« Reply #5 on: October 04, 2024, 08:25:30 am »
    The code below uses RawImage to tint a picture. It still takes a long time to process numerous large
frames (same as BGRABitmap) but at least it works.
    BasicOne, can the code you posted be adapted to do tinting instead of altering brightness?



   
Code: Text  [Select][+][-]
  1.  


user5

  • Sr. Member
  • ****
  • Posts: 363
Re: Tinting pictures and videos
« Reply #6 on: October 04, 2024, 08:29:26 am »
    I don't know what happened but the code I wanted to show in my previous message didn't appear so it is shown here.

   
Code: Text  [Select][+][-]
  1.  


Khrys

  • Full Member
  • ***
  • Posts: 102
Re: Tinting pictures and videos
« Reply #7 on: October 04, 2024, 08:30:47 am »
I noticed that you used 32-bit and I wonder if this is for a technical reason or due to personal preference
and for the properties associated with 32-bit vrs. 24-bit.

I've already had this code on hand. I wrote it for use with 32-bit images because I needed to handle transparency, and have been using it ever since without issues.
However, bitmap pixel formats in Lazarus are unreliable, and while researching this answer I've found that the  PixelFormat  property only seems to work on freshly  Create()'d bitmaps and not with those loaded from files. I guess I never noticed this since I always use 32-bit bitmaps everywhere...  :(

This is a big problem for raw image data access, since the pointer types (PRGBAQuad  for 32-bit and  PRGBTriple  for 24-bit) need to match exactly, or else image corruption and segfaults will occur.
I guess it'd be better to just use BGRABitmap wherever possible, which ensures a consistent memory layout:

Code: Pascal  [Select][+][-]
  1. //uses BGRABitmap, BGRABitmapTypes;
  2.  
  3. procedure ConvertToGrayscale(Bitmap: TBGRABitmap);
  4. var
  5.   Line, Pixel: PBGRAPixel;
  6.   Luma: Byte;
  7.   X, Y: SizeInt;
  8. begin
  9.   for Y := 0 to Bitmap.Height - 1 do begin
  10.     Line := Bitmap.ScanLine[Y];
  11.     for X := 0 to Bitmap.Width - 1 do begin
  12.       Pixel := @Line[X];
  13.       Luma := (Cardinal(Pixel^.Red) * 76 + Pixel^.Green * 150 + Pixel^.Blue * 29) div 255;
  14.       Pixel^.Red := Luma;
  15.       Pixel^.Green := Luma;
  16.       Pixel^.Blue := Luma;
  17.     end;
  18.   end;
  19. end;

Oh, and by the way, FPC supports floating-point literals; you don't have to use  StrToFloat  everywhere  :)
Your existing code will run much faster up if you make  val1, num1  etc. actual constants or at least move them out of the loop (currently you're parsing 16 strings per each pixel!):

Code: Pascal  [Select][+][-]
  1. templum := (0.299 * rednum) + (0.587 * greennum) + (0.114 * bluenum);

user5

  • Sr. Member
  • ****
  • Posts: 363
Re: Tinting pictures and videos
« Reply #8 on: October 04, 2024, 08:31:56 am »
    It looks like I'm having some trouble with my computer. It seems I post the code I want so I may try again later.

 

TinyPortal © 2005-2018