Tinting pictures and videos
lazarus / 39-Graphics

----------------------------------------------------------------------
user5 · 2024-10-02 20:07

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][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i uses 
wincrt,Unit6,Unit5,Unit4,Unit3,Unit2,FileUtil,intfgraphics, windows,
SysUtils,  Forms,  Controls, Graphics, LResources,FPimage, GraphUtil, 
Process, ExtCtrls, Dialogs, StdCtrls,  LCLProc,  ActnList, LCLIntf,
LCLType,  Interfaces, Buttons, ExtDlgs, Menus,  ComCtrls,  strutils, 
Classes, GraphType,BGRABitmap, BGRABitmapTypes, EpikTimer;  procedure
TForm1.Button15Click(Sender: TObject);var tempstr:string;   
chosencolor,newcolor:TColor;   
x,y,lum,rednum,greennum,bluenum,code:integer;   
tempred,tempgreen,tempblue,templum,val1,val2,val3:extended;   
num1,num2,num3,num4,num5,num6,num7,U,V:extended;   
bgra1:TBGRABitmap;    c:TBGRAPixel;    mybitmap,mybitmap2:TBitmap;   
inf1,inf2:TLazIntfImage;    ImgFormatDescription:
TRawImageDescription;begin  form4go := false; form4.button1.Enabled :=
true; form4.Button1.visible := true; form4.button1.caption :=
'GO'; form4.paintbox1.color := clNone; 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.'; form4.show; application.processmessages; backgroundcolor :=
''; image1.transparent := false; while form4.visible = true do  begin 
 form4.bringtofront;   application.processmessages; 
end; form4.Button1.visible := false; form4.button1.caption :=
'Button1'; form4.button1.enabled := false;  if (form4go = false) then 
begin   form3.show;   if backgroundcolor = '' then 
 form3.statictext1.caption := 'Process cancelled by user.'; 
 delay(1600);   application.processmessages;   form3.hide;   exit; 
end;  if colordialog1.execute = false then  exit;  form2.show;
//Please Wait message application.processmessages;  bgra1 :=
TBGRABitmap.create; mybitmap := TBitmap.create; mybitmap.width :=
image1.width; mybitmap.height := image1.height;  mybitmap2 :=
TBitmap.create; mybitmap2.width := image1.width; mybitmap2.height := i
mage1.height;  mybitmap.assign(image1.picture.bitmap); bgra1.assign(my
bitmap);  chosencolor := colordialog1.color; tintcolor :=
chosencolor;  for y := 0 to (image1.height - 1) do  for x := 0 to
(image1.width - 1) do   begin    c := bgra1.GetPixel(x,y); //Get each
pixel    newcolor := BGRAToColor(c);    
GetRGBColorNumbers(newcolor,rednum,greennum,bluenum); //Get the red,
green and blue numbers.     //Get industry standard percentages   
val1 := StrToFloat('0.299');    val2 := StrToFloat('0.587');    val3
:= StrToFloat('0.114');     num1 := StrToFloat('0.439');    num2 :=
StrToFloat('0.368');    num3 := StrToFloat('0.071');    num4 :=
StrToFloat('0.148');    num5 := StrToFloat('0.291');    num6 :=
StrToFloat('0.439');     templum := (val1 * rednum) + (val2 *
greennum) + (val3 * bluenum);    if templum < 0 then     templum := 1 
  else     if templum > 255 then      templum := 255;    lum :=
round(templum); //Lum = the luminance of each pixel.    
GetRGBColorNumbers(chosencolor,rednum,greennum,bluenum);     V :=
(num1 * rednum) - (num2 * greennum) - (num3 * bluenum) + 128;    U :=
-(num4 * rednum) - (num5 * greennum) + (num6 * bluenum) + 128;    
num1 := StrToFloat('1.164');    num2 := StrToFloat('2.018');    num3
:= StrToFloat('1.164');    num4 := StrToFloat('0.813');    num5 :=
StrToFloat('0.391');    num6 := StrToFloat('1.164');    num7 :=
StrToFloat('1.596');     tempblue := (num1 * (lum - 16)) + (num2 * (U
- 128));    tempgreen := (num3 * (lum - 16)) - (num4 * (V - 128)) -
(num5 * (U - 128));    tempred :=  (num6 * (lum - 16)) + (num7 * (V -
 128));     //Ensure that no number is less than zero or larger than
255.    if tempred < 0 then     tempred := 0    else     if tempred >
255 then      tempred := 255;     if tempgreen < 0 then     tempgreen
:= 0    else     if tempgreen > 255 then      tempgreen := 255;     if
tempblue < 0 then     tempblue := 0    else     if tempblue > 255
then      tempblue := 255;     rednum := round(tempred);    greennum
:= round(tempgreen);    bluenum := round(tempblue);     newcolor :=
RGBToColor(rednum, greennum, bluenum);   
bgra1.SetPixel(x,y,newcolor);    end;   mybitmap.assign(bgra1);  
//The TLazIntfImage stuff ensures that the bitmap is 24 bit. 
inf2:=TLazIntfImage.Create(mybitmap.Width,mybitmap.Height);  inf1:=
mybitmap.CreateIntfImage;  try  ImgFormatDescription.Init_BPP24_B8G8R8
_BIO_TTB(mybitmap.Width,mybitmap.Height); 
inf2.DataDescription:=ImgFormatDescription;  inf2.CopyPixels(inf1); 
mybitmap2.PixelFormat:=pf24bit;  mybitmap2.LoadFromIntfImage(inf2); 
mybitmap2.PixelFormat:=pf24bit;  finally    inf1.free;    inf2.Free; 
end;   image1.picture.bitmap.assign(mybitmap2);   tentativetinted :=
true; //Global variable  tinted := true; //Global variable 
mybitmap.free;  mybitmap2.free;  bgra1.free;   form2.hide; end;

----------------------------------------------------------------------
H₂SO₄ · 2024-10-03 09:46

Quote from: user5 on October 02, 2024, 10:07:28 pmInserted 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][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i procedure
ConvertToGrayscale(Bitmap: TBitmap);var  Line, Pixel: PRGBAQuad; 
Luma: Byte;  X, Y: SizeInt;begin  Bitmap.PixelFormat := pf32bit;  with
Bitmap, RawImage do begin    BeginUpdate();    for Y := 0 to Height -
1 do begin      Line := Pointer(GetLineStart(Y));      for X := 0 to
Width - 1 do begin        Pixel := @Line[X];        Luma :=
(Cardinal(Pixel^.Red) * 76 + Pixel^.Green * 150 + Pixel^.Blue * 29)
div 255;        Pixel^.Red := Luma;        Pixel^.Green := Luma;     
 Pixel^.Blue := Luma;      end;    end;    EndUpdate();  end;end;

----------------------------------------------------------------------
user5 · 2024-10-03 22:21

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 · 2024-10-03 23:39

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][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i mybitmap :=
TBitmap.create; mybitmap.width := image1.width; mybitmap.height := ima
ge1.height; mybitmap.assign(image1.picture.bitmap); mybitmap.PixelForm
at := pf32bit;  with mybitmap, RawImage do begin    BeginUpdate();   
for y := 0 to image1.height - 1 do begin      Line :=
Pointer(GetLineStart(y));      for x := 0 to image1.width - 1 do
begin        Pixel := @Line[x];        Luma := (Cardinal(Pixel^.Red) *
76 + Pixel^.Green * 150 + Pixel^.Blue * 29) div 255;        Pixel^.Red
:= Luma;        Pixel^.Green := Luma;        Pixel^.Blue := Luma;    
  //Was something left out here?      end;    end;    EndUpdate(); 
end;  image1.picture.bitmap.assign(mybitmap); mybitmap.free;

----------------------------------------------------------------------
BasicOne · 2024-10-04 03:45

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][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i procedure
tLTMap.ApplyBrightness(var aPicture:
tPicture);type tGraphPixelColor=packed record                        
  b:byte;                            g:byte;                         
 r:byte;                         
 end; pGraphPixelColor=^tLTGraphPixelColor;var  X, Y: Integer; 
PixelPtr: pGraphPixelColor;  PixelRowPtr: pGraphPixelColor;  RawImage:
TRawImage;  BytePerPixel: Integer;  H,V,S:double;  r,g,b: integer; 
Hl,Ll,Sl: byte;begin if abs(self.fBrightness)>0.01 then begin   try 
 RawImage := aPicture.Bitmap.RawImage;    if RawImage.Data<>nil then
begin    PixelRowPtr := pGraphPixelColor(RawImage.Data);   
BytePerPixel := RawImage.Description.BitsPerPixel div 8;     PixelPtr
:= PixelRowPtr;    for Y := 0 to aPicture.Bitmap.Height - 1 do begin 
  for X := 0 to aPicture.Bitmap.Width - 1 do begin      if
self.fBrightness<1 then begin     
 RGBtoHSV(PixelPtr^.r,PixelPtr^.g,PixelPtr^.b,H,S,V);     
 v:=V*self.fBrightness;       HSVtoRGB(H,S,V,r,g,b);     
 PixelPtr^.r:=r;       PixelPtr^.g:=g;       PixelPtr^.b:=b;      end
else begin     
 RGBtoHLS(PixelPtr^.r,PixelPtr^.g,PixelPtr^.b,Hl,Ll,Sl);     
 Ll:=trunc(Ll+(255-Ll)*(self.fBrightness-1));     
 HLStoRGB(Hl,Ll,Sl,PixelPtr^.r,PixelPtr^.g,PixelPtr^.b);      end;   
 Inc(PByte(PixelPtr), BytePerPixel);     end;    end;   end;  except 
end;  end;end;

----------------------------------------------------------------------
user5 · 2024-10-04 06:25

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][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i

----------------------------------------------------------------------
user5 · 2024-10-04 06:29

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][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i

----------------------------------------------------------------------
H₂SO₄ · 2024-10-04 06:30

Quote from: user5 on October 04, 2024, 12:21:06 amI 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][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i //uses
BGRABitmap, BGRABitmapTypes; procedure ConvertToGrayscale(Bitmap:
TBGRABitmap);var  Line, Pixel: PBGRAPixel;  Luma: Byte;  X, Y:
SizeInt;begin  for Y := 0 to Bitmap.Height - 1 do begin    Line :=
Bitmap.ScanLine[Y];    for X := 0 to Bitmap.Width - 1 do begin     
Pixel := @Line[X];      Luma := (Cardinal(Pixel^.Red) * 76 +
Pixel^.Green * 150 + Pixel^.Blue * 29) div 255;      Pixel^.Red :=
Luma;      Pixel^.Green := Luma;      Pixel^.Blue := Luma;    end; 
end;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][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i templum :=
(0.299 * rednum) + (0.587 * greennum) + (0.114 * bluenum);

----------------------------------------------------------------------
user5 · 2024-10-04 06:31

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.