AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
• Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

Pixelmanipulation

Ein Thema von Hazardos · begonnen am 20. Sep 2004 · letzter Beitrag vom 18. Sep 2005
Antwort Antwort
hansklok

Registriert seit: 14. Apr 2004
Ort: Karlsruhe
318 Beiträge
 
Delphi 2010 Architect
 
#1

Re: Pixelmanipulation

  Alt 20. Sep 2004, 14:46
Hallo, ich bin im Netz vor ein paar Tagen auf ne richtige Pixelmanipulationsfundgrube gestoßen. Ist zwar der Quellcode für ne Komponente, kannst ihn aber locker in Unit des Formulars unterbringen. Beispiel unten.

zusammenfalten · markieren
Delphi-Quellcode:
//////////////////////////////////////////////////////
// //
// ImagePlus v1.2 +++++ //
// +++++ //
// Great TImage with many effects, +++++++++++++ //
// filters and other cool things. +++++++++++++ //
// +++++++++++++ //
// I hope this is it, what you bin +++++ //
// looking for, else write me a mail +++++ //
// what you miss. ;-) //
// //
// ImagePlus is Freeware for all Freeware and //
// Puplic Domain Stuff. For commercial use you //
// must ask me first. //
// //
// Copyright 2004 by Alias:[Manon] on Gothicware //
// //
// [url]http://www.gothicware.de.vu[/url] [email]primaluna@web.de[/email] //
//////////////////////////////////////////////////////

 

 
unit ImagePlus;

 
interface

 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, Math;

 
type
  TImagePlus = class(TImage)
  private
    { Private-Deklarationen}  
  protected
    { Protected-Deklarationen}  
    constructor Create(AOwner: TComponent); override;
  public
    { Public-Deklarationen}  
  published
    { Published-Deklarationen }  
    Procedure Effect_Invert;
    Procedure Effect_AddColorNoise (Amount: Integer);
    Procedure Effect_AddMonoNoise (Amount: Integer);
    Procedure Effect_AntiAlias;
    Procedure Effect_Contrast (Amount: Integer);
    Procedure Effect_FishEye (Amount: Integer);
    Procedure Effect_GrayScale;
    Procedure Effect_Lightness (Amount: Integer);
    Procedure Effect_Darkness (Amount: Integer);
    Procedure Effect_Saturation (Amount: Integer);
    Procedure Effect_SplitBlur (Amount: Integer);
    Procedure Effect_GaussianBlur (Amount: Integer);
    Procedure Effect_Mosaic (Size: Integer);
    Procedure Effect_Twist (Amount: Integer);
    procedure Effect_Splitlight (Amount: Integer);
    Procedure Effect_Tile (Amount: Integer);
    Procedure Effect_SpotLight (Amount: Integer; Spot: TRect);
    Procedure Effect_Trace (Amount: Integer);
    Procedure Effect_Emboss;
    Procedure Effect_Solorize (Amount: Integer);
    Procedure Effect_Posterize (Amount: Integer);
    Procedure Effect_Colored (Amount: Integer; Colorplus: TColor);
    Procedure Effect_MirrowV;
    Procedure Effect_MirrowH;
    Procedure Effect_FlipV;
    Procedure Effect_FlipH;
    Procedure Effect_MinColor;
    Procedure Effect_MaxColor;
    Procedure Effect_LowGray (Amount: integer);
    Procedure Effect_HighGray (Amount: integer);
  end;

 
procedure Register;

 
implementation

 
{$R *.res}  

 
procedure Register;
begin
  RegisterComponents('Gothicware', [TImagePlus]);
end;

 
constructor TImagePlus.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Width := 160;
Height := 120;
Center := true;
Hint := 'ImagePlus Copyright 2004 by Gothicware©';
ShowHint := true;
end;

 

 
procedure PicInvert(src: tbitmap);
var w,h,x,y:integer;
    p:pbytearray;
begin
w:=src.width;
h:=src.height;
src.PixelFormat :=pf24bit;
 for y:=0 to h-1 do begin
  p:=src.scanline[y];
  for x:=0 to w-1 do begin
   p[x*3]:= not p[x*3];
   p[x*3+1]:= not p[x*3+1];
   p[x*3+2]:= not p[x*3+2];
   end;
  end;
end;

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

 
procedure AddColorNoise(var clip: tbitmap; Amount: Integer);
var
p0:pbytearray;
x,y,r,g,b: Integer;

 
begin
  for y:=0 to clip.Height-1 do
  begin
    p0:=clip.ScanLine [y];
    for x:=0 to clip.Width-1 do
    begin
      r:=p0[x*3]+(Random(Amount)-(Amount shr 1));
      g:=p0[x*3+1]+(Random(Amount)-(Amount shr 1));
      b:=p0[x*3+2]+(Random(Amount)-(Amount shr 1));
      p0[x*3]:=IntToByte(r);
      p0[x*3+1]:=IntToByte(g);
      p0[x*3+2]:=IntToByte(b);
    end;
  end;
end;

 
procedure AddMonoNoise(var clip: tbitmap; Amount: Integer);
var
p0:pbytearray;
x,y,a,r,g,b: Integer;
begin
  for y:=0 to clip.Height-1 do
  begin
    p0:=clip.scanline[y];
    for x:=0 to clip.Width-1 do
    begin
      a:=Random(Amount)-(Amount shr 1);
      r:=p0[x*3]+a;
      g:=p0[x*3+1]+a;
      b:=p0[x*3+2]+a;
      p0[x*3]:=IntToByte(r);
      p0[x*3+1]:=IntToByte(g);
      p0[x*3+2]:=IntToByte(b);
    end;
  end;
end;

 
procedure AntiAliasRect(clip: tbitmap; XOrigin, YOrigin,
  XFinal, YFinal: Integer);
var Memo,x,y: Integer; (* Composantes primaires des points environnants *)  
    p0,p1,p2:pbytearray;

 
begin
   if XFinal<XOrigin then begin Memo:=XOrigin; XOrigin:=XFinal; XFinal:=Memo; end; (* Inversion des valeurs   *)  
   if YFinal<YOrigin then begin Memo:=YOrigin; YOrigin:=YFinal; YFinal:=Memo; end; (* si diff?rence n?gative*)  
   XOrigin:=max(1,XOrigin);
   YOrigin:=max(1,YOrigin);
   XFinal:=min(clip.width-2,XFinal);
   YFinal:=min(clip.height-2,YFinal);
   clip.PixelFormat :=pf24bit;
   for y:=YOrigin to YFinal do begin
    p0:=clip.ScanLine [y-1];
    p1:=clip.scanline [y];
    p2:=clip.ScanLine [y+1];
    for x:=XOrigin to XFinal do begin
      p1[x*3]:=(p0[x*3]+p2[x*3]+p1[(x-1)*3]+p1[(x+1)*3])div 4;
      p1[x*3+1]:=(p0[x*3+1]+p2[x*3+1]+p1[(x-1)*3+1]+p1[(x+1)*3+1])div 4;
      p1[x*3+2]:=(p0[x*3+2]+p2[x*3+2]+p1[(x-1)*3+2]+p1[(x+1)*3+2])div 4;
      end;
   end;
end;

 
procedure AntiAlias(clip: tbitmap);
begin
 AntiAliasRect(clip,0,0,clip.width,clip.height);
end;

 
procedure Contrast(var clip: tbitmap; Amount: Integer);
var
p0:pbytearray;
rg,gg,bg,r,g,b,x,y: Integer;
begin
  for y:=0 to clip.Height-1 do
  begin
    p0:=clip.scanline[y];
    for x:=0 to clip.Width-1 do
    begin
      r:=p0[x*3];
      g:=p0[x*3+1];
      b:=p0[x*3+2];
      rg:=(Abs(127-r)*Amount)div 255;
      gg:=(Abs(127-g)*Amount)div 255;
      bg:=(Abs(127-b)*Amount)div 255;
      if r>127 then r:=r+rg else r:=r-rg;
      if g>127 then g:=g+gg else g:=g-gg;
      if b>127 then b:=b+bg else b:=b-bg;
      p0[x*3]:=IntToByte(r);
      p0[x*3+1]:=IntToByte(g);
      p0[x*3+2]:=IntToByte(b);
    end;
  end;
end;

 
procedure FishEye(var Bmp, Dst: TBitmap; Amount: Extended);
var
xmid,ymid : Single;
fx,fy : Single;
r1, r2 : Single;
ifx, ify : integer;
dx, dy : Single;
rmax : Single;
ty, tx : Integer;
weight_x, weight_y : array[0..1] of Single;
weight : Single;
new_red, new_green : Integer;
new_blue : Integer;
total_red, total_green : Single;
total_blue : Single;
ix, iy : Integer;
sli, slo : PByteArray;
begin
  xmid := Bmp.Width/2;
  ymid := Bmp.Height/2;
  rmax := Dst.Width * Amount;

 
  for ty := 0 to Dst.Height - 1 do begin
    for tx := 0 to Dst.Width - 1 do begin
      dx := tx - xmid;
      dy := ty - ymid;
      r1 := Sqrt(dx * dx + dy * dy);
      if r1 = 0 then begin
        fx := xmid;
        fy := ymid;
      end
      else begin
        r2 := rmax / 2 * (1 / (1 - r1/rmax) - 1);
        fx := dx * r2 / r1 + xmid;
        fy := dy * r2 / r1 + ymid;
      end;
      ify := Trunc(fy);
      ifx := Trunc(fx);
                // Calculate the weights.
      if fy >= 0 then begin
        weight_y[1] := fy - ify;
        weight_y[0] := 1 - weight_y[1];
      end else begin
        weight_y[0] := -(fy - ify);
        weight_y[1] := 1 - weight_y[0];
      end;
      if fx >= 0 then begin
        weight_x[1] := fx - ifx;
        weight_x[0] := 1 - weight_x[1];
      end else begin
        weight_x[0] := -(fx - ifx);
        Weight_x[1] := 1 - weight_x[0];
      end;

 
      if ifx < 0 then
        ifx := Bmp.Width-1-(-ifx mod Bmp.Width)
      else if ifx > Bmp.Width-1 then
        ifx := ifx mod Bmp.Width;
      if ify < 0 then
        ify := Bmp.Height-1-(-ify mod Bmp.Height)
      else if ify > Bmp.Height-1 then
        ify := ify mod Bmp.Height;

 
      total_red := 0.0;
      total_green := 0.0;
      total_blue := 0.0;
      for ix := 0 to 1 do begin
        for iy := 0 to 1 do begin
          if ify + iy < Bmp.Height then
            sli := Bmp.scanline[ify + iy]
          else
            sli := Bmp.scanline[Bmp.Height - ify - iy];
          if ifx + ix < Bmp.Width then begin
            new_red := sli[(ifx + ix)*3];
            new_green := sli[(ifx + ix)*3+1];
            new_blue := sli[(ifx + ix)*3+2];
          end
          else begin
            new_red := sli[(Bmp.Width - ifx - ix)*3];
            new_green := sli[(Bmp.Width - ifx - ix)*3+1];
            new_blue := sli[(Bmp.Width - ifx - ix)*3+2];
          end;
          weight := weight_x[ix] * weight_y[iy];
          total_red := total_red + new_red * weight;
          total_green := total_green + new_green * weight;
          total_blue := total_blue + new_blue * weight;
        end;
      end;
      slo := Dst.scanline[ty];
      slo[tx*3] := Round(total_red);
      slo[tx*3+1] := Round(total_green);
      slo[tx*3+2] := Round(total_blue);

 
    end;
  end;
end;

 
procedure GrayScale(var clip: tbitmap);
var
p0:pbytearray;
Gray,x,y: Integer;
begin
  for y:=0 to clip.Height-1 do
  begin
    p0:=clip.scanline[y];
    for x:=0 to clip.Width-1 do
    begin
      Gray:=Round(p0[x*3]*0.3+p0[x*3+1]*0.59+p0[x*3+2]*0.11);
      p0[x*3]:=Gray;
      p0[x*3+1]:=Gray;
      p0[x*3+2]:=Gray;
    end;
  end;
end;

 

 
procedure Lightness(var clip: tbitmap; Amount: Integer);
var
p0:pbytearray;
r,g,b,x,y: Integer;
begin
  for y:=0 to clip.Height-1 do begin
    p0:=clip.scanline[y];
    for x:=0 to clip.Width-1 do
    begin
      r:=p0[x*3];
      g:=p0[x*3+1];
      b:=p0[x*3+2];
      p0[x*3]:=IntToByte(r+((255-r)*Amount)div 255);
      p0[x*3+1]:=IntToByte(g+((255-g)*Amount)div 255);
      p0[x*3+2]:=IntToByte(b+((255-b)*Amount)div 255);
    end;
  end;
end;

 
procedure Darkness(var src: tbitmap; Amount: integer);
var
p0:pbytearray;
r,g,b,x,y: Integer;
begin
  src.pixelformat:=pf24bit;
  for y:=0 to src.Height-1 do begin
    p0:=src.scanline[y];
    for x:=0 to src.Width-1 do
    begin
      r:=p0[x*3];
      g:=p0[x*3+1];
      b:=p0[x*3+2];
      p0[x*3]:=IntToByte(r-((r)*Amount)div 255);
      p0[x*3+1]:=IntToByte(g-((g)*Amount)div 255);
      p0[x*3+2]:=IntToByte(b-((b)*Amount)div 255);
   end;
  end;
end;

 

 
procedure Saturation(var clip: tbitmap; Amount: Integer);
var
p0:pbytearray;
Gray,r,g,b,x,y: Integer;
begin
  for y:=0 to clip.Height-1 do begin
    p0:=clip.scanline[y];
    for x:=0 to clip.Width-1 do
    begin
      r:=p0[x*3];
      g:=p0[x*3+1];
      b:=p0[x*3+2];
      Gray:=(r+g+b)div 3;
      p0[x*3]:=IntToByte(Gray+(((r-Gray)*Amount)div 255));
      p0[x*3+1]:=IntToByte(Gray+(((g-Gray)*Amount)div 255));
      p0[x*3+2]:=IntToByte(Gray+(((b-Gray)*Amount)div 255));
    end;
  end;
end;

 
procedure SmoothResize(var Src, Dst: TBitmap);
var
x,y,xP,yP,
yP2,xP2: Integer;
Read,Read2: PByteArray;
t,z,z2,iz2: Integer;
pc:PBytearray;
w1,w2,w3,w4: Integer;
Col1r,col1g,col1b,Col2r,col2g,col2b: byte;
begin
  xP2:=((src.Width-1)shl 15)div Dst.Width;
  yP2:=((src.Height-1)shl 15)div Dst.Height;
  yP:=0;
  for y:=0 to Dst.Height-1 do
  begin
    xP:=0;
    Read:=src.ScanLine[yP shr 15];
    if yP shr 16<src.Height-1 then
      Read2:=src.ScanLine [yP shr 15+1]
    else
      Read2:=src.ScanLine [yP shr 15];
    pc:=Dst.scanline[y];
    z2:=yP and $7FFF;
    iz2:=$8000-z2;
    for x:=0 to Dst.Width-1 do
    begin
      t:=xP shr 15;
      Col1r:=Read[t*3];
      Col1g:=Read[t*3+1];
      Col1b:=Read[t*3+2];
      Col2r:=Read2[t*3];
      Col2g:=Read2[t*3+1];
      Col2b:=Read2[t*3+2];
      z:=xP and $7FFF;
      w2:=(z*iz2)shr 15;
      w1:=iz2-w2;
      w4:=(z*z2)shr 15;
      w3:=z2-w4;
      pc[x*3+2]:=
        (Col1b*w1+Read[(t+1)*3+2]*w2+
         Col2b*w3+Read2[(t+1)*3+2]*w4)shr 15;
      pc[x*3+1]:=
        (Col1g*w1+Read[(t+1)*3+1]*w2+
         Col2g*w3+Read2[(t+1)*3+1]*w4)shr 15;
      pc[x*3]:=
        (Col1r*w1+Read2[(t+1)*3]*w2+
         Col2r*w3+Read2[(t+1)*3]*w4)shr 15;
      Inc(xP,xP2);
    end;
    Inc(yP,yP2);
  end;
end;

 
function TrimInt(i, Min, Max: Integer): Integer;
begin
  if i>Max then Result:=Max
  else if i<Min then Result:=Min
  else Result:=i;
end;

 

 
procedure SmoothRotate(var Src, Dst: TBitmap; cx, cy: Integer;
  Angle: Extended);
type
 TFColor = record b,g,r:Byte end;
var
Top,
Bottom,
Left,
Right,
eww,nsw,
fx,fy,
wx,wy: Extended;
cAngle,
sAngle: Double;
xDiff,
yDiff,
ifx,ify,
px,py,
ix,iy,
x,y: Integer;
nw,ne,
sw,se: TFColor;
P1,P2,P3:Pbytearray;
begin
  Angle:=angle;
  Angle:=-Angle*Pi/180;
  sAngle:=Sin(Angle);
  cAngle:=Cos(Angle);
  xDiff:=(Dst.Width-Src.Width)div 2;
  yDiff:=(Dst.Height-Src.Height)div 2;
  for y:=0 to Dst.Height-1 do
  begin
    P3:=Dst.scanline[y];
    py:=2*(y-cy)+1;
    for x:=0 to Dst.Width-1 do
    begin
      px:=2*(x-cx)+1;
      fx:=(((px*cAngle-py*sAngle)-1)/ 2+cx)-xDiff;
      fy:=(((px*sAngle+py*cAngle)-1)/ 2+cy)-yDiff;
      ifx:=Round(fx);
      ify:=Round(fy);

 
      if(ifx>-1)and(ifx<Src.Width)and(ify>-1)and(ify<Src.Height)then
      begin
        eww:=fx-ifx;
        nsw:=fy-ify;
        iy:=TrimInt(ify+1,0,Src.Height-1);
        ix:=TrimInt(ifx+1,0,Src.Width-1);
        P1:=Src.scanline[ify];
        P2:=Src.scanline[iy];
        nw.r:=P1[ifx*3];
        nw.g:=P1[ifx*3+1];
        nw.b:=P1[ifx*3+2];
        ne.r:=P1[ix*3];
        ne.g:=P1[ix*3+1];
        ne.b:=P1[ix*3+2];
        sw.r:=P2[ifx*3];
        sw.g:=P2[ifx*3+1];
        sw.b:=P2[ifx*3+2];
        se.r:=P2[ix*3];
        se.g:=P2[ix*3+1];
        se.b:=P2[ix*3+2];

 
        Top:=nw.b+eww*(ne.b-nw.b);
        Bottom:=sw.b+eww*(se.b-sw.b);
        P3[x*3+2]:=IntToByte(Round(Top+nsw*(Bottom-Top)));

 
        Top:=nw.g+eww*(ne.g-nw.g);
        Bottom:=sw.g+eww*(se.g-sw.g);
        P3[x*3+1]:=IntToByte(Round(Top+nsw*(Bottom-Top)));

 
        Top:=nw.r+eww*(ne.r-nw.r);
        Bottom:=sw.r+eww*(se.r-sw.r);
        P3[x*3]:=IntToByte(Round(Top+nsw*(Bottom-Top)));
      end;
    end;
  end;
end;

 

 
procedure SplitBlur(var clip: tbitmap; Amount: integer);
var
p0,p1,p2:pbytearray;
cx,x,y: Integer;
Buf: array[0..3,0..2]of byte;
begin
  if Amount=0 then Exit;
  for y:=0 to clip.Height-1 do
  begin
    p0:=clip.scanline[y];
    if y-Amount<0 then p1:=clip.scanline[y]
    else {y-Amount>0}          p1:=clip.ScanLine[y-Amount];
    if y+Amount<clip.Height then p2:=clip.ScanLine[y+Amount]
    else {y+Amount>=Height}    p2:=clip.ScanLine[clip.Height-y];

 
    for x:=0 to clip.Width-1 do
    begin
      if x-Amount<0 then cx:=x
      else {x-Amount>0}      cx:=x-Amount;
      Buf[0,0]:=p1[cx*3];
      Buf[0,1]:=p1[cx*3+1];
      Buf[0,2]:=p1[cx*3+2];
      Buf[1,0]:=p2[cx*3];
      Buf[1,1]:=p2[cx*3+1];
      Buf[1,2]:=p2[cx*3+2];
      if x+Amount<clip.Width then cx:=x+Amount
      else {x+Amount>=Width}     cx:=clip.Width-x;
      Buf[2,0]:=p1[cx*3];
      Buf[2,1]:=p1[cx*3+1];
      Buf[2,2]:=p1[cx*3+2];
      Buf[3,0]:=p2[cx*3];
      Buf[3,1]:=p2[cx*3+1];
      Buf[3,2]:=p2[cx*3+2];
      p0[x*3]:=(Buf[0,0]+Buf[1,0]+Buf[2,0]+Buf[3,0])shr 2;
      p0[x*3+1]:=(Buf[0,1]+Buf[1,1]+Buf[2,1]+Buf[3,1])shr 2;
      p0[x*3+2]:=(Buf[0,2]+Buf[1,2]+Buf[2,2]+Buf[3,2])shr 2;
    end;
  end;
end;

 
procedure GaussianBlur(var clip: tbitmap; Amount: integer);
var
i: Integer;
begin
  for i:=Amount downto 0 do
  SplitBlur(clip,3);
end;

 
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;

 

 
procedure Twist(var Bmp, Dst: TBitmap; Amount: integer);
var
  fxmid, fymid : Single;
  txmid, tymid : Single;
  fx,fy : Single;
  tx2, ty2 : Single;
  r : Single;
  theta : Single;
  ifx, ify : integer;
  dx, dy : Single;
  OFFSET : Single;
  ty, tx : Integer;
  weight_x, weight_y : array[0..1] of Single;
  weight : Single;
  new_red, new_green : Integer;
  new_blue : Integer;
  total_red, total_green : Single;
  total_blue : Single;
  ix, iy : Integer;
  sli, slo : PBytearray;

 
  function ArcTan2(xt,yt : Single): Single;
  begin
    if xt = 0 then
      if yt > 0 then
        Result := Pi/2
      else
        Result := -(Pi/2)
    else begin
      Result := ArcTan(yt/xt);
      if xt < 0 then
        Result := Pi + ArcTan(yt/xt);
    end;
  end;

 
begin
  OFFSET := -(Pi/2);
  dx := Bmp.Width - 1;
  dy := Bmp.Height - 1;
  r := Sqrt(dx * dx + dy * dy);
  tx2 := r;
  ty2 := r;
  txmid := (Bmp.Width-1)/2; //Adjust these to move center of rotation
  tymid := (Bmp.Height-1)/2; //Adjust these to move ......
  fxmid := (Bmp.Width-1)/2;
  fymid := (Bmp.Height-1)/2;
  if tx2 >= Bmp.Width then tx2 := Bmp.Width-1;
  if ty2 >= Bmp.Height then ty2 := Bmp.Height-1;

 
  for ty := 0 to Round(ty2) do begin
    for tx := 0 to Round(tx2) do begin
      dx := tx - txmid;
      dy := ty - tymid;
      r := Sqrt(dx * dx + dy * dy);
      if r = 0 then begin
        fx := 0;
        fy := 0;
      end
      else begin
        theta := ArcTan2(dx,dy) - r/Amount - OFFSET;
        fx := r * Cos(theta);
        fy := r * Sin(theta);
      end;
      fx := fx + fxmid;
      fy := fy + fymid;

 
      ify := Trunc(fy);
      ifx := Trunc(fx);
                // Calculate the weights.
      if fy >= 0 then begin
        weight_y[1] := fy - ify;
        weight_y[0] := 1 - weight_y[1];
      end else begin
        weight_y[0] := -(fy - ify);
        weight_y[1] := 1 - weight_y[0];
      end;
      if fx >= 0 then begin
        weight_x[1] := fx - ifx;
        weight_x[0] := 1 - weight_x[1];
      end else begin
        weight_x[0] := -(fx - ifx);
        Weight_x[1] := 1 - weight_x[0];
      end;

 
      if ifx < 0 then
        ifx := Bmp.Width-1-(-ifx mod Bmp.Width)
      else if ifx > Bmp.Width-1 then
        ifx := ifx mod Bmp.Width;
      if ify < 0 then
        ify := Bmp.Height-1-(-ify mod Bmp.Height)
      else if ify > Bmp.Height-1 then
        ify := ify mod Bmp.Height;

 
      total_red := 0.0;
      total_green := 0.0;
      total_blue := 0.0;
      for ix := 0 to 1 do begin
        for iy := 0 to 1 do begin
          if ify + iy < Bmp.Height then
            sli := Bmp.scanline[ify + iy]
          else
            sli := Bmp.scanline[Bmp.Height - ify - iy];
          if ifx + ix < Bmp.Width then begin
            new_red := sli[(ifx + ix)*3];
            new_green := sli[(ifx + ix)*3+1];
            new_blue := sli[(ifx + ix)*3+2];
          end
          else begin
            new_red := sli[(Bmp.Width - ifx - ix)*3];
            new_green := sli[(Bmp.Width - ifx - ix)*3+1];
            new_blue := sli[(Bmp.Width - ifx - ix)*3+2];
          end;
          weight := weight_x[ix] * weight_y[iy];
          total_red := total_red + new_red * weight;
          total_green := total_green + new_green * weight;
          total_blue := total_blue + new_blue * weight;
        end;
      end;
      slo := Dst.scanline[ty];
      slo[tx*3] := Round(total_red);
      slo[tx*3+1] := Round(total_green);
      slo[tx*3+2] := Round(total_blue);
    end;
  end;
end;

 
Procedure Splitlight (var clip:tbitmap;amount:integer);
var x,y,i:integer;
    p1:pbytearray;

 
    function sinpixs(a:integer):integer;
    begin
    result:=variant(sin(a/255*pi/2)*255);
    end;
begin
for i:=1 to amount do
  for y:=0 to clip.height-1 do begin
    p1:=clip.scanline[y];
    for x:=0 to clip.width-1 do begin
      p1[x*3]:=sinpixs(p1[x*3]);
      p1[x*3+1]:=sinpixs(p1[x*3+1]);
      p1[x*3+2]:=sinpixs(p1[x*3+2]);
      end;
    end;
end;

 

 
procedure Tile(src, dst: TBitmap; amount: integer);
var w,h,w2,h2,i,j:integer;
    bm:tbitmap;
begin
  w:=src.width;
  h:=src.height;
  dst.width:=w;
  dst.height:=h;
  dst.Canvas.draw(0,0,src);
  if (amount<=0) or ((w div amount)<5)or ((h div amount)<5) then exit;
  h2:=h div amount;
  w2:=w div amount;
  bm:=tbitmap.create;
  bm.width:=w2;
  bm.height:=h2;
  bm.PixelFormat :=pf24bit;
  smoothresize(src,bm);
  for j:=0 to amount-1 do
   for i:=0 to amount-1 do
     dst.canvas.Draw (i*w2,j*h2,bm);
  bm.free;
end;

 
procedure SpotLight (var src: Tbitmap; Amount: integer; Spot: TRect);
var bm:tbitmap;
    w,h:integer;
begin
Darkness(src,amount);
w:=src.Width;
h:=src.Height ;
bm:=tbitmap.create;
bm.width:=w;
bm.height:=h;
bm.canvas.Brush.color:=clblack;
bm.canvas.FillRect (rect(0,0,w,h));
bm.canvas.brush.Color :=clwhite;
bm.canvas.Ellipse (Spot.left,spot.top,spot.right,spot.bottom);
bm.transparent:=true;
bm.TransparentColor :=clwhite;
src.Canvas.Draw (0,0,bm);
bm.free;
end;

 

 
procedure Trace (src:Tbitmap;intensity:integer);
var
  x,y,i : integer;
  P1,P2,P3,P4 : PByteArray;
  tb,TraceB:byte;
  hasb:boolean;
  bitmap:tbitmap;
begin
  bitmap:=tbitmap.create;
  bitmap.width:=src.width;
  bitmap.height:=src.height;
  bitmap.canvas.draw(0,0,src);
  bitmap.PixelFormat :=pf8bit;
  src.PixelFormat :=pf24bit;
  hasb:=false;
  TraceB:=$00;
  for i:=1 to Intensity do begin
    for y := 0 to BitMap.height -2 do begin
      P1 := BitMap.ScanLine[y];
      P2 := BitMap.scanline[y+1];
      P3 := src.scanline[y];
      P4 := src.scanline[y+1];
      x:=0;
      repeat
        if p1[x]<>p1[x+1] then begin
           if not hasb then begin
             tb:=p1[x+1];
             hasb:=true;
             p3[x*3]:=TraceB;
             p3[x*3+1]:=TraceB;
             p3[x*3+2]:=TraceB;
             end
             else begin
             if p1[x]<>tb then
                 begin
                 p3[x*3]:=TraceB;
                 p3[x*3+1]:=TraceB;
                 p3[x*3+2]:=TraceB;
                 end
               else
                 begin
                 p3[(x+1)*3]:=TraceB;
                 p3[(x+1)*3+1]:=TraceB;
                 p3[(x+1)*3+1]:=TraceB;
                 end;
             end;
           end;
        if p1[x]<>p2[x] then begin
           if not hasb then begin
             tb:=p2[x];
             hasb:=true;
             p3[x*3]:=TraceB;
             p3[x*3+1]:=TraceB;
             p3[x*3+2]:=TraceB;
             end
             else begin
             if p1[x]<>tb then
                 begin
                 p3[x*3]:=TraceB;
                 p3[x*3+1]:=TraceB;
                 p3[x*3+2]:=TraceB;
                 end
               else
                 begin
                 p4[x*3]:=TraceB;
                 p4[x*3+1]:=TraceB;
                 p4[x*3+2]:=TraceB;
                 end;
             end;
           end;
      inc(x);
      until x>=(BitMap.width -2);
    end;
    if i>1 then
    for y := BitMap.height -1 downto 1 do begin
      P1 := BitMap.ScanLine[y];
      P2 := BitMap.scanline[y-1];
      P3 := src.scanline[y];
      P4 := src.scanline [y-1];
      x:=Bitmap.width-1;
      repeat
        if p1[x]<>p1[x-1] then begin
           if not hasb then begin
             tb:=p1[x-1];
             hasb:=true;
             p3[x*3]:=TraceB;
             p3[x*3+1]:=TraceB;
             p3[x*3+2]:=TraceB;
             end
             else begin
             if p1[x]<>tb then
                 begin
                 p3[x*3]:=TraceB;
                 p3[x*3+1]:=TraceB;
                 p3[x*3+2]:=TraceB;
                 end
               else
                 begin
                 p3[(x-1)*3]:=TraceB;
                 p3[(x-1)*3+1]:=TraceB;
                 p3[(x-1)*3+2]:=TraceB;
                 end;
             end;
           end;
        if p1[x]<>p2[x] then begin
           if not hasb then begin
             tb:=p2[x];
             hasb:=true;
             p3[x*3]:=TraceB;
             p3[x*3+1]:=TraceB;
             p3[x*3+2]:=TraceB;
             end
             else begin
             if p1[x]<>tb then
                 begin
                 p3[x*3]:=TraceB;
                 p3[x*3+1]:=TraceB;
                 p3[x*3+2]:=TraceB;
                 end
               else
                 begin
                 p4[x*3]:=TraceB;
                 p4[x*3+1]:=TraceB;
                 p4[x*3+2]:=TraceB;
                 end;
             end;
           end;
      dec(x);
      until x<=1;
    end;
  end;
bitmap.free;
end;

 

 
procedure Emboss(var Bmp:TBitmap);
var
x,y: Integer;
p1,p2: Pbytearray;
begin
  for y:=0 to Bmp.Height-2 do
  begin
    p1:=bmp.scanline[y];
    p2:=bmp.scanline[y+1];
    for x:=0 to Bmp.Width-4 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+2]+(p2[(x+3)*3+2] xor $FF))shr 1;
    end;
  end;

 
end;

 

 
procedure Solorize(src, dst: tbitmap; amount: integer);
var w,h,x,y:integer;
    ps,pd:pbytearray;
    c:integer;
begin
  w:=src.width;
  h:=src.height;
  src.PixelFormat :=pf24bit;
  dst.PixelFormat :=pf24bit;
  for y:=0 to h-1 do begin
   ps:=src.scanline[y];
   pd:=dst.scanline[y];
   for x:=0 to w-1 do begin
    c:=(ps[x*3]+ps[x*3+1]+ps[x*3+2]) div 3;
    if c>amount then begin
     pd[x*3]:= 255-ps[x*3];
     pd[x*3+1]:=255-ps[x*3+1];
     pd[x*3+2]:=255-ps[x*3+2];
     end
     else begin
     pd[x*3]:=ps[x*3];
     pd[x*3+1]:=ps[x*3+1];
     pd[x*3+2]:=ps[x*3+2];
     end;
    end;
   end;
end;

 
procedure Posterize(src, dst: tbitmap; amount: integer);
var w,h,x,y:integer;
    ps,pd:pbytearray;
    c:integer;
begin
  w:=src.width;
  h:=src.height;
  src.PixelFormat :=pf24bit;
  dst.PixelFormat :=pf24bit;
  for y:=0 to h-1 do begin
   ps:=src.scanline[y];
   pd:=dst.scanline[y];
   for x:=0 to w-1 do begin
     pd[x*3]:= round(ps[x*3]/amount)*amount;
     pd[x*3+1]:=round(ps[x*3+1]/amount)*amount;
     pd[x*3+2]:=round(ps[x*3+2]/amount)*amount;
    end;
   end;
end;

 
procedure Colored(var clip: tbitmap; ColorPlus: Tcolor; Amount: Integer);
var
p:pbytearray;
PlusColor: record
r,g,b :integer;
end;
r,g,b,x,y: Integer;
begin
  for y:= 0 to clip.Height -1 do begin
    p:=clip.scanline[y];
    for x:= 0 to clip.Width -1 do
    begin
      r:=p[x*3];
      g:=p[x*3+1];
      b:=p[x*3+2];
      PlusColor.b := round(((GetRvalue(ColorPlus)* (255/100*Amount)) + r)/2);
      PlusColor.G := round(((GetGvalue(ColorPlus)* (255/100*Amount)) + g)/2);
      PlusColor.r := round(((GetBvalue(ColorPlus)* (255/100*Amount)) + b)/2);
      p[x*3] := PlusColor.R;
      p[x*3+1]:= PlusColor.G;
      p[x*3+2]:= PlusColor.B;
      end;
    end;
end;

 
procedure MirrowV(src, dst: tbitmap);
var w,h,x:integer;
begin
  w:=src.width;
  h:=src.height;
  src.PixelFormat := pf24bit;
  dst.PixelFormat := pf24bit;
  for x:= 0 to ((w-1) div 2) do begin
  dst.Canvas.CopyRect(Rect(w-x,0,w-x+1,h),src.Canvas,Rect(x,0,x+1,h));
  end;
  src.PixelFormat := pf24bit;
  dst.PixelFormat := pf24bit;
end;

 

 
procedure MirrowH(src, dst: tbitmap);
var w,h,y:integer;
 begin
  w:=src.width;
  h:=src.height;
  src.PixelFormat := pf24bit;
  dst.PixelFormat := pf24bit;
  for y:=0 to ((h-1) div 2) do begin
  dst.Canvas.CopyRect(Rect(0,h-y,w,h-y+1),src.Canvas,Rect(0,y,w,y+1));
  end;
  src.PixelFormat := pf24bit;
  dst.PixelFormat := pf24bit;
end;

 

 

 
procedure FlipV(src, dst: tbitmap);
var w,h:integer;
begin
  w:=src.width +1;
  h:=src.height +1;
  src.PixelFormat := pf24bit;
  dst.PixelFormat := pf24bit;
  dst.Canvas.CopyRect(Rect(-1,-1,w,h),src.Canvas,Rect(-1,h,w,-1));
  src.PixelFormat := pf24bit;
  dst.PixelFormat := pf24bit;
end;

 

 
procedure FlipH(src, dst: tbitmap);
var w,h:integer;
 begin
  w:=src.width +1;
  h:=src.height +1;
  src.PixelFormat := pf24bit;
  dst.PixelFormat := pf24bit;
  dst.Canvas.CopyRect(Rect(-1,-1,w,h),src.Canvas,Rect(w,-1,-1,h));
  src.PixelFormat := pf24bit;
  dst.PixelFormat := pf24bit;
end;

 
procedure MaxColor(src: TBitmap);
var w,h,x,y:integer;
    tp,p:pbytearray;
begin
w := src.width;
h := src.height;
src.PixelFormat := pf24bit;
 for y := 0 to h-1 do begin
  p := src.scanline[y];
  tp := src.scanline[y];
  for x := 0 to w-1 do begin
  tp[x*3+0] := max(p[x*3+0],(p[x*3+0] + p[x*3+1] + p[x*3+2]) div 3);
  tp[x*3+1] := max(p[x*3+1],(p[x*3+0] + p[x*3+1] + p[x*3+2]) div 3);
  tp[x*3+2] := max(p[x*3+2],(p[x*3+0] + p[x*3+1] + p[x*3+2]) div 3);
   p := tp;
   end;
  end;
end;

 
procedure MinColor(src: TBitmap);
var w,h,x,y:integer;
    tp,p:pbytearray;
begin
w := src.width;
h := src.height;
src.PixelFormat := pf24bit;
 for y := 0 to h-1 do begin
  p := src.scanline[y];
  tp := src.scanline[y];
  for x := 0 to w-1 do begin
  tp[x*3+0] := min(p[x*3+0],(p[x*3+0] + p[x*3+1] + p[x*3+2]) div 3);
  tp[x*3+1] := min(p[x*3+1],(p[x*3+0] + p[x*3+1] + p[x*3+2]) div 3);
  tp[x*3+2] := min(p[x*3+2],(p[x*3+0] + p[x*3+1] + p[x*3+2]) div 3);
   p := tp;
   end;
  end;
end;

 
procedure LowGray(src: TBitmap; Amount: Integer);
var w,h,x,y:integer;
    tp,p:pbytearray;
begin
w := src.width;
h := src.height;
src.PixelFormat := pf24bit;
 for y := 0 to h-1 do begin
  p := src.scanline[y];
  tp := src.scanline[y];
  for x := 0 to w-1 do begin
  if (p[x*3+0] + p[x*3+1] + p[x*3+2]) > (255 div 100 * Amount * 3) then
     begin
     tp[x*3+0] := (p[x*3+0] + p[x*3+1] + p[x*3+2]) div 3;
     tp[x*3+1] := (p[x*3+0] + p[x*3+1] + p[x*3+2]) div 3;
     tp[x*3+2] := (p[x*3+0] + p[x*3+1] + p[x*3+2]) div 3;
     end
   else
     begin
     tp[x*3+0] := p[x*3+0];
     tp[x*3+1] := p[x*3+1];
     tp[x*3+2] := p[x*3+2];
     end;
   p := tp;
   end;
  end;
end;

 
procedure HighGray(src: TBitmap; Amount: Integer);
var w,h,x,y:integer;
    tp,p:pbytearray;
begin
w := src.width;
h := src.height;
src.PixelFormat := pf24bit;
 for y := 0 to h-1 do begin
  p := src.scanline[y];
  tp := src.scanline[y];
  for x := 0 to w-1 do begin
  if (p[x*3+0] + p[x*3+1] + p[x*3+2]) < (255 div 100 * Amount * 3) then
     begin
     tp[x*3+0] := (p[x*3+0] + p[x*3+1] + p[x*3+2]) div 3;
     tp[x*3+1] := (p[x*3+0] + p[x*3+1] + p[x*3+2]) div 3;
     tp[x*3+2] := (p[x*3+0] + p[x*3+1] + p[x*3+2]) div 3;
     end
   else
     begin
     tp[x*3+0] := p[x*3+0];
     tp[x*3+1] := p[x*3+1];
     tp[x*3+2] := p[x*3+2];
     end;
   p := tp;
   end;
  end;
end;

 

 
//-------------------------------------------------------------------->
//-----------------------> Regstrierte Prozeduren <------------------->
//-------------------------------------------------------------------->

 

 
procedure TImagePlus.Effect_Invert;
Begin
 PicInvert (Picture.Bitmap);
 Invalidate;
end;

 
Procedure TImagePlus.Effect_AddColorNoise (Amount:Integer);
Var BB:TBitmap;
Begin
 BB := TBitmap.Create;
 BB.PixelFormat := pf24bit;
 BB.Assign (Picture.Bitmap);
 AddColorNoise (bb,Amount);
 Picture.Bitmap.Assign (BB);
 BB.Free;
end;

 
Procedure TImagePlus.Effect_AddMonoNoise (Amount:Integer);
Var BB:TBitmap;
Begin
 BB := TBitmap.Create;
 BB.PixelFormat := pf24bit;
 BB.Assign (Picture.Bitmap);
 AddMonoNoise (bb,Amount);
 Picture.Bitmap.Assign (BB);
 BB.Free;
end;

 
procedure TImagePlus.Effect_AntiAlias;
Begin
 AntiAlias (Picture.Bitmap);
 Invalidate;
end;

 
Procedure TImagePlus.Effect_Contrast (Amount:Integer);
Var BB:TBitmap;
Begin
 BB := TBitmap.Create;
 BB.PixelFormat := pf24bit;
 BB.Assign (Picture.Bitmap);
 Contrast (bb,Amount);
 Picture.Bitmap.Assign (BB);
 BB.Free;
end;

 
Procedure TImagePlus.Effect_FishEye (Amount:Integer);
Var BB1,BB2:TBitmap;
Begin
 BB1 := TBitmap.Create;
 BB1.PixelFormat := pf24bit;
 BB1.Assign (Picture.Bitmap);
 BB2 := TBitmap.Create;
 BB2.PixelFormat := pf24bit;
 BB2.Assign (BB1);
 FishEye (BB1,BB2,Amount);
 Picture.Bitmap.Assign (BB2);
 BB1.Free;
 BB2.Free;
end;

 
Procedure TImagePlus.Effect_GrayScale;
Var BB:TBitmap;
Begin
 BB := TBitmap.Create;
 BB.PixelFormat := pf24bit;
 BB.Assign (Picture.Bitmap);
 GrayScale (BB);
 Picture.Bitmap.Assign (BB);
 BB.Free;
end;

 
Procedure TImagePlus.Effect_Lightness (Amount:Integer);
Var BB:TBitmap;
Begin
 BB := TBitmap.Create;
 BB.PixelFormat := pf24bit;
 BB.Assign (Picture.Bitmap);
 Lightness (BB,Amount);
 Picture.Bitmap.Assign (BB);
 BB.Free;
end;

 
Procedure TImagePlus.Effect_Darkness (Amount:Integer);
Var BB:TBitmap;
Begin
 BB := TBitmap.Create;
 BB.PixelFormat := pf24bit;
 BB.Assign (Picture.Bitmap);
 Darkness (BB,Amount);
 Picture.Bitmap.Assign (BB);
 BB.Free;
end;

 
Procedure TImagePlus.Effect_Saturation (Amount:Integer);
Var BB:TBitmap;
Begin
 BB := TBitmap.Create;
 BB.PixelFormat := pf24bit;
 BB.Assign (Picture.Bitmap);
 Saturation (BB,Amount);
 Picture.Bitmap.Assign (BB);
 BB.Free;
end;

 
Procedure TImagePlus.Effect_SplitBlur (Amount:Integer);
Var BB:TBitmap;
Begin
 BB := TBitmap.Create;
 BB.PixelFormat := pf24bit;
 BB.Assign (Picture.Bitmap);
 SplitBlur (BB,Amount);
 Picture.Bitmap.Assign (BB);
 BB.Free;
end;

 
Procedure TImagePlus.Effect_GaussianBlur (Amount:Integer);
Var BB:TBitmap;
Begin
 BB := TBitmap.Create;
 BB.PixelFormat := pf24bit;
 BB.Assign (Picture.Bitmap);
 GaussianBlur (BB,Amount);
 Picture.Bitmap.Assign (BB);
 BB.Free;
end;

 
Procedure TImagePlus.Effect_Mosaic (Size:Integer);
Var BB:TBitmap;
Begin
 BB := TBitmap.Create;
 BB.PixelFormat := pf24bit;
 BB.Assign (Picture.Bitmap);
 Mosaic (BB,Size);
 Picture.Bitmap.Assign (BB);
 BB.Free;
end;

 
Procedure TImagePlus.Effect_Twist (Amount:Integer);
Var BB1,BB2:TBitmap;
Begin
 BB1 := TBitmap.Create;
 BB1.PixelFormat := pf24bit;
 BB1.Assign (Picture.Bitmap);
 BB2 := TBitmap.Create;
 BB2.PixelFormat := pf24bit;
 BB2.Assign (BB1);
 Twist (BB1,BB2,Amount);
 Picture.Bitmap.Assign (BB2);
 BB1.Free;
 BB2.Free;
end;

 
Procedure TImagePlus.Effect_Trace (Amount: integer);
Var BB1,BB2:TBitmap;
Begin
 BB1 := TBitmap.Create;
 BB1.PixelFormat := pf24bit;
 BB1.Assign (Picture.Bitmap);
 BB2 := TBitmap.Create;
 BB2.PixelFormat := pf24bit;
 BB2.Assign (BB1);
 Trace (BB2,Amount);
 Picture.Bitmap.Assign (BB2);
 BB1.Free;
 BB2.Free;
end;

 
procedure TImagePlus.Effect_Splitlight (Amount:integer);
Var BB1,BB2:TBitmap;
Begin
 BB1 := TBitmap.Create;
 BB1.PixelFormat := pf24bit;
 BB1.Assign (Picture.Bitmap);
 BB2 := TBitmap.Create;
 BB2.PixelFormat := pf24bit;
 BB2.Assign (BB1);
 Splitlight (BB1,Amount);
 Picture.Bitmap.Assign (BB2);
 BB1.Free;
 BB2.Free;
end;

 
Procedure TImagePlus.Effect_Tile (Amount: integer);
Var BB1,BB2:TBitmap;
Begin
 BB1 := TBitmap.Create;
 BB1.PixelFormat := pf24bit;
 BB1.Assign (Picture.Bitmap);
 BB2 := TBitmap.Create;
 BB2.PixelFormat := pf24bit;
 BB2.Assign (BB1);
 Tile (BB1,BB2,Amount);
 Picture.Bitmap.Assign (BB2);
 BB1.Free;
 BB2.Free;
end;

 
Procedure TImagePlus.Effect_SpotLight (Amount: integer; Spot: TRect);
Var BB1,BB2:TBitmap;
Begin
 BB1 := TBitmap.Create;
 BB1.PixelFormat := pf24bit;
 BB1.Assign (Picture.Bitmap);
 BB2 := TBitmap.Create;
 BB2.PixelFormat := pf24bit;
 BB2.Assign (BB1);
 SpotLight (BB2,Amount,Spot);
 Picture.Bitmap.Assign (BB2);
 BB1.Free;
 BB2.Free;
end;

 
Procedure TImagePlus.Effect_Emboss;
Var BB1,BB2:TBitmap;
Begin
 BB1 := TBitmap.Create;
 BB1.PixelFormat := pf24bit;
 BB1.Assign (Picture.Bitmap);
 BB2 := TBitmap.Create;
 BB2.PixelFormat := pf24bit;
 BB2.Assign (BB1);
 Emboss (BB2);
 Picture.Bitmap.Assign (BB2);
 BB1.Free;
 BB2.Free;
end;

 
Procedure TImagePlus.Effect_Solorize (Amount: integer);
Var BB1,BB2:TBitmap;
Begin
 BB1 := TBitmap.Create;
 BB1.PixelFormat := pf24bit;
 BB1.Assign (Picture.Bitmap);
 BB2 := TBitmap.Create;
 BB2.PixelFormat := pf24bit;
 BB2.Assign (BB1);
 Solorize (BB1,BB2,Amount);
 Picture.Bitmap.Assign (BB2);
 BB1.Free;
 BB2.Free;
end;

 
Procedure TImagePlus.Effect_Posterize (Amount: integer);
Var BB1,BB2:TBitmap;
Begin
 BB1 := TBitmap.Create;
 BB1.PixelFormat := pf24bit;
 BB1.Assign (Picture.Bitmap);
 BB2 := TBitmap.Create;
 BB2.PixelFormat := pf24bit;
 BB2.Assign (BB1);
 Posterize (BB1,BB2,Amount);
 Picture.Bitmap.Assign (BB2);
 BB1.Free;
 BB2.Free;
end;

 

 
Procedure TImagePlus.Effect_Colored (Amount:Integer; ColorPlus: Tcolor);
Var BB1,BB2:TBitmap;
Begin
 BB1 := TBitmap.Create;
 BB1.PixelFormat := pf24bit;
 BB1.Assign (Picture.Bitmap);
 BB2 := TBitmap.Create;
 BB2.PixelFormat := pf24bit;
 BB2.Assign (BB1);
 Colored (BB2, ColorPlus, Amount);
 BB1.Assign (BB2);
 Picture.Bitmap.Assign(BB1);
 BB1.Free;
 BB2.Free;
end;

 
Procedure TImagePlus.Effect_MirrowV;
Var BB1,BB2:TBitmap;
Begin
 BB1 := TBitmap.Create;
 BB1.PixelFormat := pf24bit;
 BB1.Assign (Picture.Bitmap);
 BB2 := TBitmap.Create;
 BB2.PixelFormat := pf24bit;
 BB2.Assign (BB1);
 MirrowV (BB1,BB2);
 Picture.Bitmap.Assign (BB2);
 BB1.Free;
 BB2.Free;
end;

 
Procedure TImagePlus.Effect_MirrowH;
Var BB1,BB2:TBitmap;
Begin
 BB1 := TBitmap.Create;
 BB1.PixelFormat := pf24bit;
 BB1.Assign (Picture.Bitmap);
 BB2 := TBitmap.Create;
 BB2.PixelFormat := pf24bit;
 BB2.Assign (BB1);
 MirrowH (BB1,BB2);
 Picture.Bitmap.Assign (BB2);
 BB1.Free;
 BB2.Free;
end;

 
Procedure TImagePlus.Effect_FlipV;
Var BB1,BB2:TBitmap;
Begin
 BB1 := TBitmap.Create;
 BB1.PixelFormat := pf24bit;
 BB1.Assign (Picture.Bitmap);
 BB2 := TBitmap.Create;
 BB2.PixelFormat := pf24bit;
 BB2.Assign (BB1);
 FlipV (BB1,BB2);
 Picture.Bitmap.Assign (BB2);
 BB1.Free;
 BB2.Free;
end;

 
Procedure TImagePlus.Effect_FlipH;
Var BB1,BB2:TBitmap;
Begin
 BB1 := TBitmap.Create;
 BB1.PixelFormat := pf24bit;
 BB1.Assign (Picture.Bitmap);
 BB2 := TBitmap.Create;
 BB2.PixelFormat := pf24bit;
 BB2.Assign (BB1);
 FlipH (BB1,BB2);
 Picture.Bitmap.Assign (BB2);
 BB1.Free;
 BB2.Free;
end;

 
Procedure TImagePlus.Effect_MinColor;
Var BB1:TBitmap;
Begin
 BB1 := TBitmap.Create;
 BB1.PixelFormat := pf24bit;
 BB1.Assign (Picture.Bitmap);
 MinColor(BB1);
 Picture.Bitmap.Assign (BB1);
 BB1.Free;
end;

 
Procedure TImagePlus.Effect_MaxColor;
Var BB1:TBitmap;
Begin
 BB1 := TBitmap.Create;
 BB1.PixelFormat := pf24bit;
 BB1.Assign (Picture.Bitmap);
 MaxColor(BB1);
 Picture.Bitmap.Assign (BB1);
 BB1.Free;
end;

 
Procedure TImagePlus.Effect_LowGray(Amount: Integer);
Var BB1:TBitmap;
Begin
 BB1 := TBitmap.Create;
 BB1.PixelFormat := pf24bit;
 BB1.Assign (Picture.Bitmap);
 LowGray(BB1, Amount);
 Picture.Bitmap.Assign (BB1);
 BB1.Free;
end;

 
Procedure TImagePlus.Effect_HighGray(Amount: Integer);
Var BB1:TBitmap;
Begin
 BB1 := TBitmap.Create;
 BB1.PixelFormat := pf24bit;
 BB1.Assign (Picture.Bitmap);
 LowGray(BB1, Amount);
 Picture.Bitmap.Assign (BB1);
 BB1.Free;
end;
 
end.

Nun ein Beispiel:

zusammenfalten · markieren
Delphi-Quellcode:
procedure GrayScale(clip: tbitmap);
var
p0:pbytearray;
Gray,x,y: Integer;
begin
  for y:=0 to clip.Height-1 do
  begin
    p0:=clip.scanline[y];
    for x:=0 to clip.Width-1 do
    begin
      Gray:=Round(p0[x*3]*0.3+p0[x*3+1]*0.59+p0[x*3+2]*0.11);
      p0[x*3]:=Gray;
      p0[x*3+1]:=Gray;
      p0[x*3+2]:=Gray;
    end;
  end;
end;

[size=18][b]...[/b][/size]

procedure TForm1.Button1Click(Sender: TObject);
begin
GrayScale(Image1.Picture.Bitmap);
Image1.Refresh;
end;

Ich hoffe, dass ist erst mal genug Code zum probieren!

Tschüss
  Mit Zitat antworten Zitat
Antwort Antwort

« Vorheriges Thema | Nächstes Thema »

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.
BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus
Gehe zu:

• Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 02:02 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz