ScanLine - kontrast, nasycenie, negatyw, przyciemnienie, rozjaśnienie, rozmycie, sepia, skala szarości, wykucie,wypłowienie, zamiana RGB i inne..

Piotrekdp

UWAGA PONIŻSZE KODY SĄ ZAPISANE DLA BITMAP O FORMACIE PIXELI pf24Bit
Zamieściłem fotki po zastosowaniu efektu fotka oryginalna wygląda tak :

ilary.png

Funkcja ChangeRGBColor

Zamienia wartości RGB Pixela.

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

Funkcja ColorToTriple

Funkcja zamienia wartość TColor na TRGBTriple.

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

Funkcja IntToByte

Funkcja zamienia wartość Integer na Byte.

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

Kontrast (Contrast)

contrast.png

Korzysta z funkcji IntToByte (powyżej):

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

Nasycenie (Saturation)

saturation.png

Korzysta z funkcji IntToByte (powyżej).

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

Mozaika ( Mosaic )

mosaic.png

Autor Kodu /Code Author:
Babak Sateli
http://raveland.netfirms.com

procedure Mosaic(var Bitmap :TBitmap;Size:Integer);
var
   x,y,i,j:integer;
   p1,p2:pbytearray;
   r,g,b:byte;
begin
  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;

Negatyw (Negative)

negative.png

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;

Odbicie Vertykalne (Flip Vertical)

flipvertical.png

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;

Odbicie Horyzontalne (Flip Horizontal)

fliphorizontal.png

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;

Posteryzacja (Posterize)

posterize.png

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;

Progowanie(Threshold)

threshold.png

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;

Przyciemnienie (Darkness)

darkness.png

Parametr Amount to stopień zaciemnienia .
Korzysta z funkcji IntToByte (powyżej).

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;

Relief

relief.png

Parametr MedianGrey to stopień jasności reliefu .

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

Rozjaśnienie (Lightness)

lightness.png

Korzysta z funkcji IntToByte (powyżej).

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;

Rozmycie (Blur)

blur.png

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;

Sepia

sepia.png

   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;

Skala Szarości (GrayScale po "amerykańsku" lub GreyScale po "brytyjsku")

grayscale.png

Microsoft(C) używa "amerykańskiego" toteż pod namową Coldpeer'a zmieniłem nazwe na "amerykańską" (ale obie są poprawne) patrz http://en.wikipedia.org/wiki/Grayscale

Procedure GrayScale(var Bitmap:TBitmap);
var
Row:^TRGBTriple; // wskaźnik do rekordu reprezentującego składowe RGB Pixela
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 +       //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;

Szum-Kolorowy (Color Noise)

colornoise.png

Funkcja daje efekt "Zakłóceń" telewizyjnych - rózny na wszystkich kanałach RGB

procedure ColorNoise( Bitmap: TBitmap; Amount: Integer);
var
WSK:^Byte;
H,V,a: 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^+(Random(Amount)-(Amount shr 1)));
      inc(Wsk);
    end;
  end;
end;

Szum-Mono (Mono Noise)

mononoise.png

Funkcja daje efekt "Zakłuceń" telewizyjnych - jednolity na wszystkich kanałach RGB.

procedure MonoNoise(var Bitmap: TBitmap; Amount: Integer);
var
Row:^TRGBTriple;
H,V,a: Integer;
begin
  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;

Wykucie (Emboss)

emboss.png

procedure Emboss(Bitmap : TBitmap; AMount : Integer);
   var
   x, y, i : integer;
  p1, p2: PByteArray;
begin
  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;

Wypłowienie (Flaxen)

flaxen.png

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

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

Zmana wartości RGB z blokadą przepełnienia

changergb.png

Korzysta z funkcji ChangeRGBColor (Powyżej)
Funkcja dodaje lub odejmuje zawartość poszczególnych składowych rgb,
Jeżeli dodamy takie same wartości R,G,B to rozjaśnimy rysunek a jeżeli odejmiemy to go przyciemnimy.:


procedure ChangeRGB(var Bitmap:TBitmap;R,G,B:integer);
var
H,V:integer;
DstRow:^TRGBTriple; // to jest wskaźnik do pixela
begin
 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;

Operacje Na kanałach Red, Green ,Blue, Alpha - Bitmapy 32 bitowe

Zamiana palety na skalę 256 odcieni szarości (GrayScalePalette)

procedure GrayScalePalette(var Bitmap:TBitmap);
var
  pal: PLogPalette;
  hpal: HPALETTE;
  i: Integer;
begin
  pal := nil;
  try
    GetMem(pal, sizeof(TLogPalette) + sizeof(TPaletteEntry) * 255);
    pal.palVersion := $300;
    pal.palNumEntries := 256;
    for i := 0 to 255 do
    begin
      pal.palPalEntry[i].peRed :=   i;
      pal.palPalEntry[i].peGreen := i;
      pal.palPalEntry[i].peBlue :=  i;
    end;
    hpal := CreatePalette(pal^);
    if hpal <> 0 then
      Bitmap.Palette := hpal;
  finally
    FreeMem(pal);
  end;
end;

Łączenie kanałów (Channel Concat )

withoutred.png + redchannel.jpg = ilary.png

Parametry :

Src256Bitmap- Bitmapa 8bit reprezentująca dany kanał
Dst32Bitmap - Bitmapa 32bit (bitmapa docelowa do której zosanie dołączony kanał)
ChannelNumber - Numer Kanału , odpowiednio :
0 - Blue;
1 - Green;
2- Red;
3- Alpha ;

procedure  ChannelConcat(const Src256Bitmap:TBitmap; var Dst32Bitmap:TBitmap;ChannelNumber:Byte) ;
{B,G,R,A łączy 2 bitmapy  1 z kanalem kloru 1 normalną np RG+B }
var
SrcWsk,DstWsk:^Byte;
H,V:Integer;
begin
if( Src256Bitmap.Width <> Dst32Bitmap.Width) or
  ( Src256Bitmap.Height <> Dst32Bitmap.Height ) then Exit;
 {tu wstawić Zgloszene ewentualnego wyjatku}
Dst32Bitmap.PixelFormat :=Pf32Bit;
For V:=0 to Src256Bitmap.Height -1 do
  begin
  SrcWsk:=Src256Bitmap.ScanLine[V];
  DstWsk:=Dst32Bitmap.ScanLine[V];
  inc(DstWsk,ChannelNumber);

  for H:=0 to Src256Bitmap.Width  -1 do
     begin
      DstWsk^:= SrcWsk^;
      inc(SrcWsk);
      inc(DstWsk,4);
      end;
   end;
end;

Zamiana wartości Kanału na wartość stałą ( Channel Replacer )

Parametry :
Bitmap - Bitmapa źródłowa ;
ChannelNumber - Numer Kanału , odpowiednio :
0 - Blue;
1 - Green;
2- Red;
3- Alpha ;
Value - wartość dla całego kanału (można np wyzerować Kanał podając 0 )

procedure ChannelReplacer(var Bitmap:TBitmap;ChannelNumber,Value :Byte);
{B,G,R,A Zamienia caly kanal na dana wartosc }
var
DstWsk:^Byte;
H,V:Integer;
begin
Bitmap.PixelFormat:=pf32bit;
for V:= 0 to Bitmap.Height -1 do
  begin
  DstWsk:=Bitmap.ScanLine[V];
  inc(DstWsk,ChannelNumber);
  for H:=0 to Bitmap.Height -1 do
    begin
   DstWsk^:=Value;
   inc(DstWsk,4);
    end;
  end;
end;

Rozdzielenie Obrazu na poszczególne kanały -bez usuwania kanału z bitmapy bazowej- (Channel Split)

redchannel.jpg greenchannel.jpg bluechannel.jpg

Parametry :

SrcBitmap - Bitmapa źródłowa ;
DstBitmap - Bitmapa wyjściowa ;
Paleta bitmapy wyjściowej zostaje zamieniona na 256 Kolorów-Skala Szarości.
ChannelNumber - Numer Kanału , odpowiednio :
0 - Blue;
1 - Green;
2- Red;
3- Alpha;


procedure ChannelSplit(const  SrcBitmap:TBitmap; var DstBitmap:TBitmap;ChannelNumber:Byte) ;
{B,G,R,A  Pokazuje dany kanal}
var
SrcWsk,DstWsk:^Byte;
H,V:Integer;
begin

DstBitmap.Width :=SrcBitmap.Width ;
DstBitmap.Height :=SrcBitmap.Height ;
DstBitmap.PixelFormat :=Pf8Bit;
GrayScalePalette(DstBitmap);

SrcBitmap.PixelFormat :=Pf32Bit;
For V:=0 to SrcBitmap.Height -1 do
   begin
   SrcWsk:=SrcBitmap.ScanLine[V];
   DstWsk:=DstBitmap.ScanLine[V];
   inc(SrcWsk,ChannelNumber);

   for H:=0 to SrcBitmap.Width  -1 do
     begin
     DstWsk^:= SrcWsk^;
     inc(DstWsk);
     inc(SrcWsk,4);
     end;
  end;
end;

10 komentarzy

No, i fajny gotowiec powstał :)

BTW: "Skala Szarości (GreyScale)" a nie Gray zamiast Grey? ;)

Supcio arcik :P pozdro

Te przykłady są bardzo dobrym pomysłem - od razu widać co kodzik robi - fajna sprawa.
Ilary Blasi? :P

[edited]
hehe, bingo :]

Program do obróbki zdjęć:

Marooned dnia 08-11-2005 23:00:43
Dla zainteresowanych niekoniecznie programem :P :P
2 słowa kluczowe: Ilary Blasi

Hmm tak myśle czy nie powinienem opatrywać moich wynalazków komentarzami dlaczego tak a nie inaczej ale to byłoby 2x wiecej pisania a kody w miare zrozumiale są ...

Nie pozostaje nic innego jak napisać konkurenta dla Photoshopa :P

kilka pomysłów:
Odbicie poziome:
var Bmp : TBitMap;
begin
Bmp :=TBitMap.Create;
Bmp.Width :=Image1.Width;
Bmp.Height :=Image1.Height;
Bmp.Canvas.StretchDraw(Rect(Bmp.Width,0,0,Bmp.Height),Image1.Picture.Bitmap);//bez utraty jakości bo rozmiary takie same
Image1.Picture.Bitmap.Assign(Bmp);

podobnie odbicie pionowe: Rect(0,Bmp.Height,Bmp.Width,0)

a negatyw? proszę:
InvertRect(Image1.Canvas.Handle,Image1.ClientRect);
Image1.Repaint;

Zabawy ze Scanline przy obecnych rozmiarach zdjęć...

@Coldpeer:
grey jest po angielsku
gray po amerykansku...
wiec oba obreslenia poprawne. czyli pisac jak kto woli;]

Przyda się ogarnąć ten artykuł, trzeba zmienić tytuł, stworzyć spis treści i sformatować większość tekstu i kodów żeby była większa czytelność;

Artykuł ciekawy, algorytmy może nie najszybsze, ale działają (jak ktoś będzie chciał szybsze to niech pokombinuje trochę sam); Gratuluję;

Niestety Yavo muszę Cię zmartwić Twój ScretchDraw() przy odbiciu tylko 100 krotnym bitmapy 1000x1000 24 bitowej
operacje przeprowadza u mnie w 19979 milisekund natomiast to samo algorytmem na ScanLine uzyskam w vertykalnym w 540 milisekund natomiast horyzonralnym 810 milisekund.

więc Twój pomysł jest jakieś 36 razy wolniejszy w przypadku vertical i 24 razy w przypadku horizontal
to ,że algorytm jest krótszy w zapisie nie oznacza ze jest szybszy jak nie wierzysz przetestuj.

kod testu :

var
  tc:Cardinal;
  Bmp:TBitmap;
  i:Integer;
//.............
Bmp :=TBitMap.Create;
Bmp.Width :=1000;
Bmp.Height :=1000;
Bmp.PixelFormat := pf24bit;
TC:=GetTickCount();
for i := 0 to 100 do
//i tu dwie opcje albo jedna albo druga (obie dałem w kometarz)
//Bmp.Canvas.StretchDraw(Rect(Bmp.Width,0,0,Bmp.Height),bmp);
//FlipHorizontal(Bmp);
Wynik:=(GetTickCount()-TC);  //i potem odczyt
Bmp.Free;