Never been to CodeSnippets before?

Snippets is a public source code repository. Easily build up your personal collection of code snippets, categorize them with tags / keywords, and share them with the world (or not, you can keep them private!)

Sepia

procedure 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;

Blur

Procedure Blur( var Bitmap :TBitmap);
var
TL,TC,TR,BL,BC,BR,LL,LC,LR:^TRGBTriple;
H,V:Integer;
begin
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;

Lightness

procedure 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;

Darkness

procedure Darkness( Bitmap:TBitmap; Amount: integer);
var
Wsk:^Byte;
H,V: Integer;
begin
  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;

Threshold

funkcja przetwarza Bitmapę na 2 kolorową o podanych kolorach (odpowiadającym ciemniejszemu-Dark
i jaśniejszemu -Light w zależności od podanego progu -Amout rozgraniczającego odcienie (domyślnie128 );
jeśli chcemy użyć zmiennych TColor należy użyć funkcji ColorToTriple (powyżej).

procedure Threshold( Bitmap:TBitmap ; const Light:TRgbTriple; const Dark:TRgbTriple; Amount:Integer = 128);
var
Row:^TRGBTriple;
H,V,Index: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
    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;

Posterize

procedure Posterize(Bitmap: TBitmap; amount: integer);
var
H,V:Integer;
Wsk:^Byte;
begin
  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;

Mosaic

procedure Mosaic(var Bm:TBitmap;size:Integer);
var
   x,y,i,j:integer;
   p1,p2:pbytearray;
   r,g,b:byte;
begin
  y:=0;
  repeat
    p1:=bm.scanline[y];
    x:=0;
    repeat
      j:=1;
      repeat
      p2:=bm.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>=bm.width) or (i>size);
      until x>=bm.width;
      inc(j);
      inc(y);
      until (y>=bm.height) or (j>size);
    until (y>=bm.height) or (x>=bm.width);
  until y>=bm.height;
end;

Flip Horizontal

Procedura odbija bitmapę względem osi Y

procedure 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;

Flip Vertical

Procedura odbija bitmapę względem osi X
procedure FlipVertical(var Bitmap:TBitmap);
var
ByteTop,ByteBottom:^Byte;
ByteTemp:Byte;
H,V:Integer;
begin
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;de

Negative

procedure 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;