Simulate infrared film

[WojTec]

Hi,

I'm interesing in nice photo effect - infrared film. I want to implement this cool effect, but I don't found any informations how to make it. Do you know something about it?

[Medium]

I think you need to elaborate a bit more, or show examples of what you have in mind. Extracting actual IR infos from normal computer images is obviously impossible, though there are some CCD chips out there, that respond to IR sources. But how this manifests in the RGB domain is entirely arbitrary, and should not yield any usable data. Hence what you think of needs to be some sort of a fake-IR filter, for which there is no standard, and needs way more explanation from your side.

[Bummi]

via Bitmap Scanline
eliminate blue
increase green * 2
convert to gray

Call

Delphi-Quellcode:

  InfraRed(Image1.Picture.Bitmap);
  Image1.Invalidate;

May be adapted for your needs

Delphi-Quellcode:

unit EXBMP_Utils_1;
// 201011 by Thomas Wasseermann

interface

uses Windows,Classes, Graphics;



type
  pRGBTripleArray = ^TRGBTripleArray;
  TRGBTripleArray = ARRAY[0..$effffff] OF TRGBTriple;
  pRGBQuadArray = ^TRGBQuadArray;
  TRGBQuadArray = ARRAY[0..$effffff] OF TRGBQuad;


  procedure ConvertBitmapToGrayscale(const Bitmap: TBitmap);
  Procedure InfraRed(bmp:TBitmap);

implementation
  
procedure ConvertBitmapToGrayscale32(const Bitmap: TBitmap);
type
  PPixelRec = ^TPixelRec;
  TPixelRec = packed record
    B: Byte;
    G: Byte;
    R: Byte;
    Reserved: Byte;
  end;
var
  X: Integer;
  Y: Integer;
  P: PPixelRec;
  Gray: Byte;
begin
  for Y := 0 to (Bitmap.Height - 1) do
  begin
    P := Bitmap.ScanLine[Y];
    for X := 0 to (Bitmap.Width - 1) do
    begin
      Gray := Round(0.30 * P.R + 0.59 * P.G + 0.11 * P.B);
      P.R := Gray;
      P.G := Gray;
      P.B := Gray;
      Inc(P);
    end;
  end;
end;

procedure ConvertBitmapToGrayscale24(const Bitmap: TBitmap);
type
  PPixelRec = ^TPixelRec;
  TPixelRec = packed record
    B: Byte;
    G: Byte;
    R: Byte;
  end;
var
  X: Integer;
  Y: Integer;
  P: PPixelRec;
  Gray: Byte;
begin
  for Y := 0 to (Bitmap.Height - 1) do
  begin
    P := Bitmap.ScanLine[Y];
    for X := 0 to (Bitmap.Width - 1) do
    begin
      Gray := Round(0.30 * P.R + 0.59 * P.G + 0.11 * P.B);
      P.R := Gray;
      P.G := Gray;
      P.B := Gray;
      Inc(P);
    end;
  end;
end;


procedure ConvertBitmapToGrayscale(const Bitmap: TBitmap);

begin
  if Bitmap.PixelFormat = pf32Bit then ConvertBitmapToGrayscale32(Bitmap)
  else   if Bitmap.PixelFormat = pf24Bit then ConvertBitmapToGrayscale24(Bitmap);
end;




Function GetDoubleByte(i:Integer):Integer;
  Begin
    Result := i * 2;
    if Result > 255 then Result := 255;
  End;

Procedure InfraRed24(bmp:TBitmap);
var
 pscanLine : pRGBTripleArray;
 x,y:Integer;
begin
  for y  := 0 to bmp.Height - 1 do
    begin
       pscanLine := bmp.Scanline[y];
       for x := 0 to bmp.Width - 1 do
          begin
              pscanLine[x].rgbtBlue := 0;
              pscanLine[x].rgbtGreen := GetDoubleByte(pscanLine[x].rgbtGreen);
          end;
    end;
  ConvertBitmapToGrayscale(bmp);
end;

Procedure InfraRed32(bmp:TBitmap);
var
 pscanLine : pRGBQuadArray;
 x,y:Integer;
begin
  for y  := 0 to bmp.Height - 1 do
    begin
       pscanLine := bmp.Scanline[y];
       for x := 0 to bmp.Width - 1 do
          begin
              pscanLine[x].rgbBlue := 0;
              pscanLine[x].rgbGreen := GetDoubleByte(pscanLine[x].rgbGreen);
          end;
    end;
  ConvertBitmapToGrayscale(bmp);
end;


Procedure InfraRed(bmp:TBitmap);
begin
  if bmp.PixelFormat=pf32Bit  then InfraRed32(bmp)
  else   if bmp.PixelFormat=pf24Bit  then InfraRed24(bmp);
end;

end.

[WojTec]

What exactly I'm mean you can see on attached image.

@Bummi, thanks for your filter, it's interesting too

[Bummi]

as far as i can see the part you marked is ConvertBitmapToGrayscale
if not you can play with theis part of the Code

Delphi-Quellcode:

       for x := 0 to bmp.Width - 1 do
          begin
              pscanLine[x].rgbBlue := 0;
              pscanLine[x].rgbGreen := GetDoubleByte(pscanLine[x].rgbGreen);
          end;

[Medium]

What Bummi described first yields very close results to what you showed us. You just made the error not to limit the green channel to 0..255, which causes this "interesting" effect (caused by byte overflow). So don't just take g*2, but min(g*2, 255), and things should look quite similar to what you want.

At least color-wise. The "grain" and "flare" options simply seem to apply some noise and blur, where it could be that the blur is weighed by brightness, which gives a slight "overshot" look.

But to be honest: That doesn't really look much like an IR image, but I didn't expect that either =)

[Bummi]

@Medium

wo findet der Überlauf statt?

Delphi-Quellcode:

Function GetDoubleByte(i:Integer):Byte;
  Begin
    Result := i * 2;
    if Result > 255 then Result := 255;
  End;

[Namenloser]

Zitat von Bummi:

@Medium

wo findet der Überlauf statt?

Delphi-Quellcode:

Function GetDoubleByte(i:Integer):Byte;
  Begin
    Result := i * 2;
    if Result > 255 then Result := 255;
  End;

Die Prüfung auf >255 bringt hier nichts, weil der Typ des Rückgabewerts Byte ist. D.h. bei der Prüfung hat der Überlauf schon stattgefunden. Wenn dann so:

Delphi-Quellcode:

Function GetDoubleByte(i:Integer):Byte;
var
  tmp: Integer;
  Begin
    tmp := i * 2;
    if tmp > 255 then tmp:= 255;
    Result := tmp;
  End;

Ist aber unnötig umständlich. Da würde ich Mediums Variante mit der min -Funktion (Unit "math") vorziehen.

[Bummi]

Danke

[Bummi]

another idea for infrared fake

Delphi-Quellcode:

Procedure NightVision(bmp:TBitMap);
begin
   Gamma(bmp,0.3);
   ConvertBitmapToGrayscale(bmp);
   InvertBitMap(bmp);
   Multiply(bmp,0,3.5,0);
end;