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

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



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)




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)




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 )





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)




 
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)




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)




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)




 
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)




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)




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




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)




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)




 
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




 
   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")




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)




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)




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)




 
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)




 
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




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 )


+ =

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)


    

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;
 

Kategoria: Delphi » Gotowce

10 komentarzy

Avatar: Furious Programming
Napisany 2012-03-09 16:38 przez Furious Programming

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

Avatar: cimak
Napisany 2010-01-13 11:26 przez cimak

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

Brak avatara
Napisany 2009-11-07 23:18 przez Piotrekdp

<b>Niestety Yavo muszę Cię zmartwić</b> 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 <b> Twój pomysł jest jakieś 36 razy wolniejszy w przypadku vertical i 24 razy w przypadku horizontal</b>
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;

Brak avatara
Napisany 2009-10-26 22:04 przez yavo

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ęć...

Avatar: MikiKam
Napisany 2008-04-17 19:08 przez MikiKam

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

Brak avatara
Napisany 2007-10-26 15:36 przez Piotrekdp

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

Avatar: Coldpeer
Napisany 2007-07-28 15:32 przez Coldpeer

<url=http://4programmers.net/Delphi[...]o_obr%C3%B3bki_zdj%C4%99%C4%87>Program do obróbki zdjęć</url>:

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

Avatar: Marooned
Napisany 2007-05-17 03:47 przez Marooned

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

[edited]
hehe, <url=http://tiny.pl/d61z>bingo</url> :]

Brak avatara
Napisany 2007-05-06 22:02 przez Av4

Supcio arcik :P pozdro

Avatar: Coldpeer
Napisany 2006-09-17 18:52 przez Coldpeer

No, i fajny gotowiec powstał :)

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

Facebook
4programmers.net