{ Copyright (C) 2010 Daro
  www.algorytm.org

 *****************************************************************************
 *                                                                           *
 *  See the file COPYING.modifiedLGPL, included in this distribution,        *
 *  for details about the copyright.                                         *
 *                                                                           *
 *  This program is distributed in the hope that it will be useful,          *
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of           *
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     *
 *                                                                           *
 *****************************************************************************
}
unit effects;

interface
uses
  Classes, SysUtils, Graphics, ComCtrls, ExtCtrls, Windows;


type
TEffect = (efNegative,efSolarize,efFalseColors,efGrayScale,efSepia);

TGraphicEffects = class (TComponent)
private
FEffect: TEffect;
FImage: TImage;
FLuminance: byte;
FDepth: integer;

private
procedure SolarizeOrInvert(const Solarize: boolean;const lum: byte);
procedure FalseColors;
procedure ConvertToGrayScaleSepia(const dpt: integer;const sepia: boolean);
protected
public
Inbmp: Graphics.TBitmap;
Outbmp: Graphics.TBitmap;

constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure AssignImage;
procedure Convert;
published
property Effect: TEffect read FEffect write FEffect;
property Image: TImage read FImage write FImage;
property Luminance: byte read FLuminance write FLuminance;
property Depth: integer read FDepth write FDepth;
end;

procedure Register;

implementation
var
LUT: Array[0..255] of Double;

procedure TGraphicEffects.SolarizeOrInvert(const Solarize: boolean;const lum: byte);
var
    i, j, rvalue, gvalue, bvalue: Integer;
    col: TColor;
begin
if solarize then
  begin
    for i:=0 to lum do LUT[i]:=i; //solaryzacja
	for i:=(lum+1) to 255 do LUT[i]:=255-i;  
  end
else  
  for i:=0 to 255 do LUT[i]:=255-i; //negatyw
outbmp.Width:=Inbmp.Width;
outbmp.Height:=Inbmp.Height;
  
for j := 0 to Inbmp.Height-1 do
   for i := 0 to Inbmp.Width-1 do
        begin
            col := InBmp.Canvas.Pixels[i,j];
            rvalue := GetRValue(col);
            gvalue := GetGValue(col);
            bvalue := GetBValue(col);
            //zmien wartosc wedlug tablicy LUT
            col := Round(LUT[rvalue]) +
                    (Round(LUT[gvalue]) shl 8) +
                    (Round(LUT[bvalue]) shl 16);
            OutBmp.Canvas.Pixels[i,j] := col;

        end;
Image.Picture.Assign(outbmp);
end;

procedure TGraphicEffects.FalseColors;
var
    i, j, rvalue, gvalue, bvalue: Integer;
    col: TColor;
begin

outbmp.Width:=Inbmp.Width;
outbmp.Height:=Inbmp.Height;

for j := 0 to Inbmp.Height-1 do
   for i := 0 to Inbmp.Width-1 do
        begin
            col := InBmp.Canvas.Pixels[i,j];
            rvalue := GetRValue(col);
            gvalue := GetGValue(col);
            bvalue := GetBValue(col);
            //fałszuj
            col := bvalue +
                    (gvalue shl 8) +
                    (rvalue shl 16);
            OutBmp.Canvas.Pixels[i,j] := col;

        end;
Image.Picture.Assign(outbmp);
end;

procedure TGraphicEffects.ConvertToGrayScaleSepia(const dpt: integer;const sepia: boolean);
var
color1,color2:longint;
r,g,b,rr,gg:byte;
h,w:integer;
begin
outbmp.Width:=Inbmp.Width;
outbmp.Height:=Inbmp.Height;

  for h := 0 to inbmp.height-1 do
  begin
    for w := 0 to inbmp.width-1 do
    begin
    //first convert the bitmap to greyscale
    color1:=colortorgb(inbmp.Canvas.pixels[w,h]);
    r:=getrvalue(color1);
    g:=getgvalue(color1);
    b:=getbvalue(color1);
    color2:=(r+g+b) div 3;
    outbmp.canvas.Pixels[w,h]:=RGB(color2,color2,color2);
    //then convert it to sepia
    if sepia then
      begin
        color1:=colortorgb(outbmp.Canvas.pixels[w,h]);
		r:=getrvalue(color1);
		g:=getgvalue(color1);
		b:=getbvalue(color1);
		rr:=r+(dpt*2);
		gg:=g+dpt;
		if rr <= ((dpt*2)-1) then
		rr:=255;
		if gg <= (dpt-1) then
		gg:=255;
		outbmp.canvas.Pixels[w,h]:=RGB(rr,gg,b);
      end;
    end;
  end;

Image.Picture.Assign(outbmp);
end;

constructor TGraphicEffects.Create(AOwner:TComponent);
begin
inherited Create(AOwner);
Inbmp:=Graphics.Tbitmap.Create;
Outbmp:=Graphics.Tbitmap.Create;
FDepth:=20;
FLuminance:=127;
end;

destructor TGraphicEffects.Destroy;
begin
Inbmp.Free;
Outbmp.Free;
inherited Destroy;
end;

procedure TGraphicEffects.AssignImage;
begin
Inbmp.Assign(Image.Picture.Bitmap);
end;

procedure TGraphicEffects.Convert;
begin
case FEffect of
  efNegative:
			  begin
			    SolarizeOrInvert(false,0);
			  end;
  efSolarize:
			  begin
			    SolarizeOrInvert(true,FLuminance);
			  end;
  efFalseColors:
			  begin
			    FalseColors;
			  end;
  efGrayScale:
			  begin
			    ConvertToGrayScaleSepia(0,false);
			  end;
  efSepia:
			  begin
			    ConvertToGrayScaleSepia(FDepth,true);
			  end;
end;
end;

procedure Register;
begin
RegisterComponents('Graphics',[TGraphicEffects]);
end;

end.