Pixelmanipulation

[Hazardos]

Hallo...
Ich wollte mal fragen, ob sich hier jemand mit Pixelmanipulation auskennt und mir evtl. weiterhelfen kann.

Ich möchte ein Bild halbtransparent in ein anderes einfügen und weis nicht, wie ich mit den TColor-werten, die mir die Eigenschaft Pixels[x,y] liefert, umgehen soll...

Ich bin für jede Hilfe dankbar ;)

MfG, Jörn

[himitsu]

Im grundegenommen ist das ganz einfach:

zuerst teilst du das zu bearbeitende Pixel in seine Farbbestandteile auf

rechnest für jeden Farbwert einzenl den Mittelwert aus
> Farbteil := (Farbteil_Bild1 + Farbteil_Bild2) div 2;
Und zum schluß werden dann einfach die einzelnen Teile wieder zusammengesetzt


[oh]RGB, GetRValue, GetGValue, GetBValue[/oh]

[fkerber]

Hi!

Ich habe das bei mir so gelöst, dass ich einfach jedes 2. Pixel vom Hintergrund nehme.
Also so

Code:

10101010101010
01010101010101
10101010101010

0 = Hintergrund
1 = Vordergrund

Ist dann auch halb-transparent.


Ciao Frederic

[himitsu]

@fkerber
wenn du's schon so machst, warum dann in Linien?

versetzt sollte es doch besser ausehn?

Code:

10101010101010
01010101010101
10101010101010

[hansklok]

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.

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][e-mail][/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:

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

[fkerber]

Hi!

Zitat:

Zitat von himitsu

@fkerber
wenn du's schon so machst, warum dann in Linien?

versetzt sollte es doch besser ausehn?

Code:

10101010101010
01010101010101
10101010101010

Das war ein Copy-&-Paste-Fehler, hatte vergessen die mittlere Zeile anzupassen.
Habe es aber geändert.

Ciao Frederic

[alcaeus]

@Hansklok: füg die Unit bitte als Datei an, ohne Code-Folding scrollt man sich da ja zu tode :roll:

Greetz
alcaeus

PS: Und außerdem braucht das PHP-Script endslang den code auszulesen und die Seitenzahlen hinzuzufügen :roll:

[hansklok]

Hier die Unit

[Hazardos]

Wie wärs denn mal hiermit??
führt zum gewünschten ergebnis...

Delphi-Quellcode:

var x,y,left,top : integer; //x,y = schleifenvariablen, left,top = Position des 2. Bildes im Ersten
    r,g,b : byte;
    Color1, Color2 : TColor;
    bmp1, bmp2 : TBitmap;

[...]

for x := 0 to bmp2.Width do
  begin
    for y := 0 to bmp2.Height do
      begin
        Color1 := ColorToRGB(bmp1.Canvas.Pixels[left + X, top + Y]); //Farbe des Pixels im ersten Bild holen
        Color2 := ColorToRGB(bmp2.Canvas.Pixels[x,y]); //Farbe des Pixels im zweiten Bild holen
        r := (GetRValue (Color1) + GetRValue (Color2)) div  2; // Farben zerlegen und mischen
        g := (GetGValue (Color1) + GetGValue (Color2)) div  2;
        b := (GetBValue (Color1) + GetBValue (Color2)) div  2;
        bmp.Canvas.Pixels[left + X, top + Y] := rgb (r,g,b); // Pixel ausgeben
      end;
  end;

[Gothicware]

Schön meine alte Unit mal im Netz wieder zufinden ;-)!

Hier mal zwei einfache Lösung:

Delphi-Quellcode:

.
.
.
procedure _SemiOpaque(src:Tbitmap; Color:TColor);
var x,y:Integer;
    p:PInteger;
begin
  src.PixelFormat:=pf32bit;
  p:= src.Scanline[Pred(src.Height)];
  for y:=1 to src.Height do
  for x:=1 to src.Width do
    begin
      if ((x+0 mod 2) = 0) and ((y mod 2)  = 0) then p^:= Color;
      if ((x+1 mod 2) = 0) and ((y mod 2) <> 0) then p^:= Color;
      Inc(p);
    end;
end;

procedure _GridOpaque(src:Tbitmap; Color:TColor);
var x,y:Integer;
    p:PInteger;
begin
  src.PixelFormat:=pf32bit;
  p:= src.Scanline[Pred(src.Height)];
  for y:=1 to src.Height do
  for x:=1 to src.Width do
    begin
      if ((x+0 mod 2) = 0) and ((y mod 2)  = 0) then p^:= p^ else
      if ((x+1 mod 2) = 0) and ((y mod 2) <> 0) then p^:= p^ else
      p^:= Color;
      Inc(p);
    end;
end;

procedure TGW_ImagePlus.doSemiOpaque(Color: TColor);
var tmpBmp: TBitmap;
    oldPf: TPixelFormat;
begin
  tmpBmp:= TBitmap.Create;
  tmpBmp.Assign(Picture.Bitmap);
  oldPf:= tmpBmp.PixelFormat;
  _SemiOpaque(tmpBmp, Color);
  tmpBmp.PixelFormat:= oldPf;
  Picture.Bitmap.Assign(tmpBmp);
  Picture.Bitmap.TransparentColor:= Color;
  Picture.Bitmap.TransparentMode:= tmFixed;
  Transparent:= true;
  tmpBmp.Free;
  Invalidate;
end;

procedure TGW_ImagePlus.doGridOpaque(Color: TColor);
var tmpBmp: TBitmap;
    oldPf: TPixelFormat;
begin
  tmpBmp:= TBitmap.Create;
  tmpBmp.Assign(Picture.Bitmap);
  oldPf:= tmpBmp.PixelFormat;
  _GridOpaque(tmpBmp, Color);
  tmpBmp.PixelFormat:= oldPf;
  Picture.Bitmap.Assign(tmpBmp);
  Picture.Bitmap.TransparentColor:= Color;
  Picture.Bitmap.TransparentMode:= tmFixed;
  Transparent:= true;
  tmpBmp.Free;
  Invalidate;
end;
.
.
.

Diese zwei Proceduren sind aus meiner neuen Unit, und setzen dann gleich das TImage halb Transparent,
aber das Grundprinzip ist gut zu erkennen.

MfG Gothicware.