Simulate infrared film

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

[WojTec]

Zitat von Medium:

You just made the error (...) caused by byte overflow

Oh, thanks

Zitat von Medium:

blur is weighed by brightness, which gives a slight "overshot" look.

What you mean? What I should to do to get similar result? Blend blur with grey image will be ok?

And yet another question: how change "strength"?

Zitat von Medium:

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

Maybe you have method near real IR?

@Bummi, what do your Multiply() procedure? Could you share code?