{
	wszystkie procedury ze strony
   http://4programmers.net/Delphi/Gotowce/ScanLine_-_kontrast,_nasycenie,_negatyw,_przyciemnienie,_rozja%C5%9Bnienie,_rozmycie,_sepia,_skala_szaro%C5%9Bci,_wykucie,wyp%C5%82owienie,_zamiana_RGB_i_inne..

}

unit UBmpTools;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls;


Type

BmpTools = class
public
	function   ChangeRGBColor(color : TRGBTriple; R, G, B : Integer) : TRGBTriple;
	function   ColorToTriple(Color : TColor) : TRGBTriple;
	function   IntToByte(i : Integer) : Byte;

	procedure  Contrast(var Bitmap:TBitmap; Amount: Integer);
	procedure  Saturation(var  Bitmap: TBitmap; Amount: Integer);
	procedure  Mosaic(var Bitmap :TBitmap;Size:Integer);
	procedure  Negative(var Bitmap:TBitmap);
   procedure  FlipVertical(var Bitmap:TBitmap);
	procedure  FlipHorizontal(var Bitmap:TBitmap);
	procedure  Posterize(Bitmap: TBitmap; Amount: integer);
	procedure  Threshold( Bitmap:TBitmap ; const Light:TRgbTriple; const Dark:TRgbTriple; Amount:Integer = 128);
	procedure  Darkness( Bitmap:TBitmap; Amount: integer);
	procedure  Relief(Bitmap:TBitmap;MedianGrey:Integer);
	procedure  Lightness( Bitmap:TBitmap; Amount: Integer);
	procedure  Blur(var Bitmap :TBitmap);
	procedure  Sepia(Bitmap : TBitmap; depth : byte);
	procedure  GrayScale(var Bitmap:TBitmap);
	procedure  ColorNoise( Bitmap: TBitmap; Amount: Integer);
	procedure  MonoNoise(var Bitmap: TBitmap; Amount: Integer);
	procedure  Emboss(Bitmap : TBitmap; AMount : Integer);
	procedure  Flaxen( Bitmap:TBitmap);
	procedure  ChangeRGB(var Bitmap:TBitmap;R,G,B:integer);
end;

implementation
{------------------------------------------------------------------------------}
function BmpTools.ChangeRGBColor(color:TRGBTriple;R,G,B:integer):TRGBTriple;
begin
	if  B+Color.rgbtBlue >255 then Color.rgbtBlue :=255 else
   if  B+Color.rgbtBlue <0 then  Color.rgbtBlue :=0 else
   inc(Color.rgbtBlue,B) ;

   if  G+Color.rgbtGreen >255 then Color.rgbtGreen :=255 else
   if  G+Color.rgbtGreen <0 then  Color.rgbtGreen :=0 else
   inc(Color.rgbtGreen,G) ;

   if  R+Color.rgbtRed >255 then Color.rgbtRed :=255 else
   if  R+Color.rgbtRed <0 then  Color.rgbtRed :=0 else
   inc(Color.rgbtRed,R) ;

	Result := Color;
end;

function BmpTools.ColorToTriple(Color:TColor):TRGBTriple;
begin
	Result.rgbtRed := (Color and $0000FF);  // pozyskanie kanałów rgb
   Result.rgbtGreen := (Color and $00FF00) shr 8;
   Result.rgbtBlue := (Color and $FF0000) shr 16;
end;

function BmpTools.IntToByte(i : Integer) : Byte;
begin
	if i > 255 then
   	Result := 255
   else if i < 0 then
   	Result := 0
   else
   	Result := i;
end;

procedure BmpTools.Contrast(var Bitmap:TBitmap; Amount: Integer);
var
	ByteWsk : ^Byte;
   H , V   :  Integer;

begin
	for V :=0 to Bitmap.Height-1 do
   begin
   	ByteWsk := Bitmap.ScanLine[V];

      for H := 0 to Bitmap.Width*3 -1  do
      begin
      	if ByteWsk^>127 then
         	ByteWsk^ := IntToByte(ByteWsk^+(Abs(127-ByteWsk^)*Amount)div 255)
         else
         	ByteWsk^ := IntToByte(ByteWsk^-(Abs(127-ByteWsk^)*Amount)div 255);
         Inc(ByteWsk);
      end;
   end;
end;

procedure BmpTools.Saturation(var  Bitmap: TBitmap; Amount: Integer);
var
	Wsk        : ^TRGBTriple;
   Gray, H, V : Integer;

begin
	{
   nasycenie
	}
	for V:=0 to Bitmap.Height-1 do
   begin
   	Wsk:=Bitmap.ScanLine[V];

      for H := 0 to Bitmap.Width-1 do
      begin
      	Gray:=(Wsk.rgbtBlue+Wsk.rgbtGreen+Wsk.rgbtRed)div 3;
         Wsk.rgbtRed:=IntToByte(Gray+(((Wsk.rgbtRed-Gray)*Amount)div 255));
         Wsk.rgbtGreen:=IntToByte(Gray+(((Wsk.rgbtGreen-Gray)*Amount)div 255));
         Wsk.rgbtBlue:=IntToByte(Gray+(((Wsk.rgbtBlue-Gray)*Amount)div 255));
         inc(Wsk);
      end;
   end;
end;

procedure BmpTools.Mosaic(var Bitmap :TBitmap;Size:Integer);
var
	x, y, i, j : integer;
   p1, p2     : pbytearray;
   r, g, b    : byte;

begin
	{
	Mozaika
	}
	y := 0;

   repeat
    p1 := Bitmap.Scanline[y];
    x := 0;

    repeat
    	j := 1;

      repeat
      	p2 := Bitmap.Scanline[y];
         x := 0;

         repeat
         	r := p1[x*3];
         	g := p1[x*3+1];
         	b := p1[x*3+2];
         	i := 1;

            repeat
            	p2[x*3] := r;
	            p2[x*3+1] := g;
   	         p2[x*3+2] := b;
      	      inc(x);
         	   inc(i);
            until (x>=Bitmap.Width) or (i>Size);
         until x>=Bitmap.Width;
         inc(j);
         inc(y);
      until (y>=Bitmap.height) or (j>Size);
    until (y>=Bitmap.height) or (x>=Bitmap.Width);
   until y>=Bitmap.height;
end;

procedure BmpTools.Negative(var Bitmap:TBitmap);
var
	H,V     :Integer;
   WskByte : ^Byte; //Wskaźnik do Bajta (nie trzeba do całego pixela bo i tak wszystko odwracamy)

begin
	Bitmap.PixelFormat := pf24bit;

   for V := 0 to Bitmap.Height-1 do
   begin
   	WskByte := Bitmap.ScanLine[V]; // V jest to pozycja  danej linii bitmapy (od góry )

      for H := 0 to (Bitmap.Width *3)-1 do
      begin
      	WskByte^:= not WskByte^ ;// (odwracamy wartość na którą pokazuje wskaźnik)
	      inc(WskByte);//Przesuwam wskaźnik
      end;
   end;
end;

procedure BmpTools.FlipVertical(var Bitmap:TBitmap);
var
	ByteTop, ByteBottom : ^Byte;
   ByteTemp            : Byte;
   H, V                : Integer;

begin
	{
	odbicie vertykalne
   }

	for V := 0 to (Bitmap.Height -1 ) div 2 do
   begin
   	ByteTop := Bitmap.ScanLine[V];
	   ByteBottom := Bitmap.ScanLine[Bitmap.Height -1-V];
   	for H := 0 to Bitmap.Width *3 -1 do
	   begin
   		ByteTemp := ByteTop^;
		   ByteTop^ := ByteBottom^;
		   ByteBottom^ := ByteTemp;
		   inc(ByteTop);
		   inc(ByteBottom);
	   end;
   end;
end;

procedure BmpTools.FlipHorizontal(var Bitmap:TBitmap);
type
	ByteTriple = array[0..2] of byte        ; // musimy czytać po 3 bajty żeby nie zamienić kolejności BGR na RGB

var
	ByteL, ByteR : ^ByteTriple;
   ByteTemp : ByteTriple;
   H, V : Integer;

begin
	Bitmap.PixelFormat:=pf24bit;

   for V :=0 to (Bitmap.Height -1 )  do
   begin
   	ByteL:=Bitmap.ScanLine[V];
	   ByteR:=Bitmap.ScanLine[V];
   	inc(ByteR,Bitmap.Width -1);

	   for H:=0 to (Bitmap.Width -1) div 2  do
      begin
      	ByteTemp:=ByteL^;
         ByteL^:=ByteR^;
         ByteR^:=ByteTemp;
         Inc(ByteL);
         Dec(ByteR);
      end;
   end;
end;

procedure BmpTools.Posterize(Bitmap: TBitmap; Amount: integer);
var
	H,V:Integer;
   Wsk:^Byte;

begin
	{
	posteryzacja
   }
	Bitmap.PixelFormat :=pf24bit;

   for V:=0 to Bitmap.Height -1 do
   begin
   	Wsk:=Bitmap.scanline[V];
      for H := 0 to Bitmap.Width*3 -1 do
      begin
      	Wsk^:= round(WSK^/amount)*amount ;
      	inc(Wsk);
      end;
   end;
end;

procedure BmpTools.Threshold( Bitmap:TBitmap ; const Light:TRgbTriple; const Dark:TRgbTriple; Amount:Integer = 128);
var
	Row:^TRGBTriple;
   H,V,Index:Integer;

begin
	{
	progowanie
   }
   Bitmap.PixelFormat:=pf24bit;

   for V:=0 to Bitmap.Height-1 do
   begin
   	Row:=Bitmap.ScanLine[V];

      for H:=0 to Bitmap.Width -1 do
      begin
      	Index := ((Row.rgbtRed * 77 + Row.rgbtGreen* 150 + Row.rgbtBlue * 29) shr 8);
         if Index>Amount then
         	Row^:=Light  else Row^:=Dark ;
         inc(Row);
      end;
   end;
end;

procedure BmpTools.Darkness( Bitmap:TBitmap; Amount: integer);
var
	Wsk :^Byte;
	H,V : Integer;

begin
   {
   przyciemnianie
	}
	Bitmap.PixelFormat:=pf24bit;

   for V := 0 to Bitmap.Height-1 do begin
   	WSK:=Bitmap.ScanLine[V];
      for H:=0 to Bitmap.Width*3-1 do
      begin
      	Wsk^ := IntToByte(Wsk^-(Wsk^*Amount)div 255);
         inc(Wsk);
      end;
   end;
end;

procedure BmpTools.Relief(Bitmap:TBitmap;MedianGrey:Integer);
const
	RP = 0.2989;
   GP = 0.5866;
   BP = 1 - RP - GP;

var
	V, H: Integer;
   P1,P2,Wsk   : ^TrgbTriple;
   value,light1,light2,vlight : Integer;

begin
	{
   Relief
	}
	Bitmap.PixelFormat :=pf24bit;
   for V := 0 to Bitmap.Height -1 do
   begin
   	P1:=Bitmap.ScanLine [V];
      P2:=P1;
      inc(P2,3); // przesuniecie o 3 pozycje    Light2
      Wsk:=Bitmap.ScanLine [V];

      for H:= 0 to Bitmap.Width-1 do
      begin
      	light1 := trunc (P1.rgbtRed * RP + P1.rgbtGreen * GP + p1.rgbtBlue * BP); // wymnożenie przez stałe
         light2 := trunc (P2.rgbtRed  * RP + p2.rgbtGreen * GP + p2.rgbtBlue * BP);
         vlight := (MedianGrey + light2 - Light1);
         if vlight < 0 then vlight := 0;
         if vlight > 255 then vlight := 255;
         vlight := vlight * $010101;
         Wsk.rgbtRed := (vlight and $0000FF);  // pozyskanie kanałów rgb
         Wsk.rgbtGreen := (vlight and $00FF00) shr 8;
         Wsk.rgbtBlue := (vlight and $FF0000) shr 16;
         inc(p1);
         inc(p2);
         inc(Wsk);
      end;
   end;
end;

procedure BmpTools.Lightness( Bitmap:TBitmap; Amount: Integer);
var
	Wsk:^Byte;
   H,V: Integer;

begin
	Bitmap.PixelFormat:=Graphics.pf24bit;

   for V:=0 to Bitmap.Height-1 do
   begin
   	Wsk:=Bitmap.ScanLine[V];
	   for H:=0 to Bitmap.Width*3-1 do
      begin
		   Wsk^:=IntToByte(Wsk^+((255-Wsk^)*Amount)div 255);
		   inc(Wsk);
		end;
   end;
end;

Procedure BmpTools.Blur( var Bitmap :TBitmap);
var
	TL,TC,TR,BL,BC,BR,LL,LC,LR:^TRGBTriple;
	H,V:Integer;

begin
	{
	rozmycie
	}
	Bitmap.PixelFormat :=pf24bit;
   for V := 1 to Bitmap.Height - 2 do
   begin
   	TL:= Bitmap.ScanLine[V - 1];
      TC:=TL;    // to samo Scanline  Bitmap.ScanLine[V - 1]; tylko oszczędniej
      TR:=TL;
      BL:= Bitmap.ScanLine[V];
      BC:=BL;
      BR:=BL;
      LL:= Bitmap.ScanLine[V + 1];
      LC:=LL;
      LR:=LL;
      inc(TC); inc(TR,2);
      inc(BC); inc(BR,2);
      inc(LC); inc(LR,2);

      for H := 1 to (Bitmap.Width  - 2) do
      begin
      	//Wyciągam srednią z 9 sąsiadujących pixeli
         BC.rgbtRed:= (BC.rgbtRed+ BL.rgbtRed+BR.rgbtRed+
         TC.rgbtRed+ TL.rgbtRed+TR.rgbtRed+
         LL.rgbtRed+ LC.rgbtRed+LR.rgbtRed) div 9 ;

         BC.rgbtGreen:=( BC.rgbtGreen+ BL.rgbtGreen+BR.rgbtGreen+
         TC.rgbtGreen+ TL.rgbtGreen+TR.rgbtGreen+
         LL.rgbtGreen+ LC.rgbtGreen+LR.rgbtGreen) div 9 ;

         BC.rgbtBlue:=( BC.rgbtBlue+ BL.rgbtBlue+BR.rgbtBlue+
         TC.rgbtBlue+ TL.rgbtBlue+TR.rgbtBlue+
         LL.rgbtBlue+ LC.rgbtBlue+LR.rgbtBlue )div 9 ;
         // zwiększam wskaźniki biorąc następne 9 pixeli
         inc(TL);inc(TC);inc(TR);
         inc(BL);inc(BC);inc(BR);
         inc(LL);inc(LC);inc(LR);
      end;
   end;
end;

procedure BmpTools.Sepia(Bitmap : TBitmap; depth : byte);
var
	Row : ^TRGBTriple;
	H,V : Integer;

begin
	Bitmap.PixelFormat := pf24bit;

   for V:=0 to Bitmap.Height-1 do
   begin
   	Row := Bitmap.ScanLine[V];

      for H := 0 to Bitmap.Width-1 do
      begin
      	Row.rgbtBlue := (Row.rgbtBlue +Row.rgbtGreen +Row.rgbtRed) div 3;
	      Row.rgbtGreen:= Row.rgbtBlue;
      	Row.rgbtRed  := Row.rgbtBlue;
   	   inc(Row.rgbtRed, depth*2); //dodane wartosci
	      inc(Row.rgbtGreen,depth);
   	   if Row.rgbtRed < (depth*2) then Row.rgbtRed:=255;
      	if  Row.rgbtGreen < (depth) then Row.rgbtGreen:=255;
	      inc(Row);
      end;
   end;
end;

Procedure BmpTools.GrayScale(var Bitmap:TBitmap);
var
	Row:^TRGBTriple; // wskaźnik do rekordu reprezentującego składowe RGB Pixela
	H,V,Index:Integer;

begin
	{
   skala szarości
	}

	Bitmap.PixelFormat:=pf24bit;
   for V:=0 to Bitmap.Height-1 do
   begin
   	Row:=Bitmap.ScanLine[V];
	   for H:=0 to Bitmap.Width -1 do
   	begin
			Index := ((Row.rgbtRed * 77 +       //77 to stała dla czerwieni
         Row.rgbtGreen* 150 +           //150 stała dla zielonego
         Row.rgbtBlue * 29) shr 8);    //29  stała dla niebieskiego
         Row.rgbtBlue:=Index;
         Row.rgbtGreen:=Index;
         Row.rgbtRed:=Index;
         inc(Row);
         {
         Nie wolno przypisywać X:=0 lub 1,2 bo to Wskaźnk!!!
         poruszamy się inc() lub dec()
         }
      end;
   end;
end;

procedure BmpTools.ColorNoise( Bitmap: TBitmap; Amount: Integer);
var
	WSK:^Byte;
   H,V,a: Integer;

begin
	{
   szum kolorowy
	}
   Bitmap.PixelFormat:=pf24bit;
   for V:=0 to Bitmap.Height-1 do
   begin
   	Wsk:=Bitmap.ScanLine[V];
      for H:=0 to Bitmap.Width*3-1 do
      begin
      	Wsk^:=IntToByte(Wsk^+(Random(Amount)-(Amount shr 1)));
         inc(Wsk);
      end;
   end;
end;

procedure BmpTools.MonoNoise(var Bitmap: TBitmap; Amount: Integer);
var
	Row:^TRGBTriple;
   H,V,a: Integer;

begin
	{
   szum mono
	}
   for V:=0 to Bitmap.Height-1 do
   begin
   	Row:=Bitmap.ScanLine[V];
      for H:=0 to Bitmap.Width-1 do
      begin
      	a:=Random(Amount)-(Amount shr 1);
         Row.rgbtBlue :=IntToByte(Row.rgbtBlue+a);
	      Row.rgbtGreen :=IntToByte(Row.rgbtGreen+a);
   	   Row.rgbtRed :=IntToByte(Row.rgbtRed+a);
      	inc(Row);
      end;
   end;
end;

procedure BmpTools.Emboss(Bitmap : TBitmap; AMount : Integer);
var
	x, y, i : integer;
   p1, p2: PByteArray;

begin
	{
   wykucie
	}
	for i := 0 to AMount do
   begin
   	for y := 0 to Bitmap.Height-2 do
      begin
      	p1 := Bitmap.ScanLine[y];
      	p2 := Bitmap.ScanLine[y+1];

      	for x := 0 to Bitmap.Width do
         begin
         	p1[x*3] := (p1[x*3]+(p2[(x+3)*3] xor $FF)) shr 1;
         	p1[x*3+1] := (p1[x*3+1]+(p2[(x+3)*3+1] xor $FF)) shr 1;
         	p1[x*3+2] := (p1[x*3+1]+(p2[(x+3)*3+1] xor $FF)) shr 1;
         end;
      end;
   end;
end;

procedure BmpTools.Flaxen(Bitmap:TBitmap);
var
	H,V:Integer;
   WSK,WSK2,WSK3:^TRGBTriple;

begin
	{
   wypłownienie
	}
	Bitmap.PixelFormat:=pf24bit;

   for V:=0 to Bitmap.Height-1 do
   begin
   	Wsk:=Bitmap.ScanLine[V];
      Wsk2:=Wsk;
      Wsk3:=Wsk;
      inc(Wsk2);
      inc(Wsk3,2);

      for H:=0 to Bitmap.Width -3 do
      begin
	      Wsk.rgbtRed  := (Wsk.rgbtRed + Wsk2.rgbtGreen  +
	      Wsk3.rgbtBlue) div 3;
   	   Wsk2.rgbtGreen := (Wsk.rgbtGreen + Wsk2.rgbtGreen +
      	Wsk3.rgbtBlue) div 3;
	      Wsk2.rgbtBlue := (Wsk.rgbtBlue + Wsk2.rgbtGreen +
   	   Wsk3.rgbtBlue) div 3;
      	inc(Wsk);inc(Wsk2);inc(Wsk3);
      end;
   end;
end;

procedure BmpTools.ChangeRGB(var Bitmap:TBitmap;R,G,B:integer);
var
	H,V:integer;
   DstRow:^TRGBTriple; // to jest wskaźnik do pixela

begin
	{
   zmina wartości RGB z blokadą przepełnienia
	}
	Bitmap.PixelFormat:=pf24bit;
   for V:=0 to Bitmap.Height -1 do
   begin
   	DstRow:=Bitmap.ScanLine[V];

      for H:=0 to Bitmap.Width -1 do
      begin
      	DstRow^:=ChangeRGBColor(DStrow^,R,G,B);
         Inc(DstRow);
      end;
   end;
end;

end.

