Einzelnen Beitrag anzeigen

Gothicware

Registriert seit: 25. Aug 2005
Ort: Dresden
7 Beiträge
 
#1

TGW_ImagePlus 2, TImage mit Effekten und Filtern

  Alt 17. Sep 2005, 21:17
TGW_ImagePlus.pas

Noch in der Entwicklung aber bereits jetzt schon sehr nützlich. Im Gegensatz zu meinen
früheren Arbeiten auf diesem Gebiet, habe ich alle Filter/Effekte ins PixelFormat pf32bit
umgeschrieben.
Neu ist auch, das alle Filter/Effekte bis zum Rand arbeiten zb.: AntiAlias. Ich habe
mich stark bemüht den Quellcode sehr Übersichtlich zuhalten, und hoffe ihr kommt damit klar.

Hier die wichtigsten Fakten:
  • Bilder müssen immer zuerst in ein Bitmap umgewandelt werden
    es gibt keine Undo/Redo funktion, und wir auch nicht kommen, denn das ist Aufgabe des Programms
    es gibt 2, es werden 3 Matrixen zur verfügung stehen 3x3,5x5,9x9
    Bei Matrixen muss ein spetzieller Array verwendet werden, zb:
    var matrix: gw_imageplus.TMatrix3x3;

Die Filter/Effekte:
Delphi-Quellcode:

    procedure doAntiAlias;
    procedure doInvert;
    procedure doColorNoise (Amount: Integer);
    procedure doMonoNoise (Amount: Integer);
    procedure doSpray (Amount: Integer);
    procedure doContrast (Amount: Integer);
    procedure doSemiOpaque (Color: TColor);
    procedure doGridOpaque (Color: TColor);
    procedure doEmboss (Color: TColor);
    procedure doColoring (Color: TColor; Percent: TPercent);
    procedure doColorFilter (Color: TColor);
    procedure doMaxColoring (Color: TColor);
    procedure doMinColoring (Color: TColor);
    procedure doMosaic (HSize,VSize: Integer);
    procedure doMatrix3x3 (Matrix: TMatrix3x3; Divider: Integer);
    procedure doMatrix5x5 (Matrix: TMatrix5x5; Divider: Integer);
    procedure doSplitBlur (Amount: Integer);
Die Unit:
Delphi-Quellcode:
unit GW_ImagePlus;
{
      /####| The
    .#  "#
    #                  /  #/      *|
  ##                  #    #|      *|                .
  #|          ___  /*#__  #|__          _.        ###    .        .    _.
  #|        /#""#\  # #  ##`"#  #|  #`#*  ##      #  #" #  *# *#  .# #|
  ## #####  ##  ##  # ´  #|  #  #  #` "  |#  #  |#    _#|  ´#    ####*
  |#    |#  ##  ##  #    #|  #  #  #      # .#. #`  #* #|  #    #
    *#  |#  ##  ##  #    #|  #  #  #|      # #"# #  ##  *    #    #.
    "#  |#  \#  #/  #.  #|  #  #.  ´#___  ### ###  #|  #|  .#    *#__
      "###.  \##/    \*.  "`  #  ##  ´*"    ### ###  *#  ##  *#      "*
                                #\          [UltimativeFreak]#.    ,INC. 2005
                                ` .__________.
                        ._________|##########|_________.
.______            .____|###########[ INFO ]###########|____.            ______.
|######|___________|#[Unit: GW_ImagePlus.pas]##[17.09.2005]#|___________|######|
|#V 2.0##################################################################V 2.0#|
|##$$$#""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""#$$$##|
  |#$$#                                                                  #$$#|
  |#$$#  GW_ImagePlus.pas V2.0 Copyright (c) 2005 by Gothicware, Inc.    #$$#|
  |#$$#  written by UltimativeFreak        E-mail: [email]gothicware@web.de[/email]    #$$#|
  |#$$#                                                                  #$$#|
  |#$$#  Free use for non racialist and unexploiting Sofware!*          #$$#|
  |#$$#  *(as long you keep the full Copyright notice somewhere in your  #$$#|
  |#$$#  software manuel or readme file.)                              #$$#|
  |#$$#                                                                  #$$#|
  |#$$#  Use it at your own risk, with out any warranty!                #$$#|
  |#$$#                                                                  #$$#|
  |#$$#  Please remember:                                                #$$#|
  |#$$#  Sofware is like Sex, it's better if it's FREE! ;-)              #$$#|
  |#$$#                                                                  #$$#|
  |#$$#  Simpel use:                                                    #$$#|
  |#$$#  - put it somewhere on your Form                                #$$#|
  |#$$#  - edit the propertys                                            #$$#|
  |#$$#  - open some kind of an image (turn it to an bitmap)            #$$#|
  |#$$#  - call one of the effect procedures like:                      #$$#|
  |#$$#    "GW_ImagePlus1.doInvert;"                                    #$$#|
  |#$$#  - get lucky! ;-)                                                #$$#|
  |#$$#                                                                  #$$#|
._|#$$#                                                                  #$$#|_.
|##############################################################################|
|##############################################################################|
°""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""°
}




interface    

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

type
  TMatrix3x3 = array [0..8] of Integer;
  TMatrix5x5 = array [0..24] of Integer;
  TMatrix9x9 = array [0..80] of Integer;
  TPercent = $00..$64;
  TDirection = (drLeft, drTop, drRight, drBottom, drLeftTop, drTopRight, drRightBottom, drBottomLeft);
  TGW_ImagePlus = class(TImage)
  private    
    { Private-Deklarationen}    
  protected    
    { Protected-Deklarationen}    
    constructor Create(AOwner: TComponent); override;    
  public    
    { Public-Deklarationen}    
  published    
    { Published-Deklarationen }    
    procedure doAntiAlias;
    procedure doInvert;
    procedure doColorNoise (Amount: Integer);
    procedure doMonoNoise (Amount: Integer);
    procedure doSpray (Amount: Integer);
    procedure doContrast (Amount: Integer);
    procedure doSemiOpaque (Color: TColor);
    procedure doGridOpaque (Color: TColor);
    procedure doEmboss (Color: TColor);
    procedure doColoring (Color: TColor; Percent: TPercent);
    procedure doColorFilter (Color: TColor);
    procedure doMaxColoring (Color: TColor);
    procedure doMinColoring (Color: TColor);
    procedure doMosaic (HSize,VSize: Integer);
    procedure doMatrix3x3 (Matrix: TMatrix3x3; Divider: Integer);
    procedure doMatrix5x5 (Matrix: TMatrix5x5; Divider: Integer);
    procedure doSplitBlur (Amount: Integer);
  end;

procedure Register;

implementation

//{$R *.res}

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

constructor TGW_ImagePlus.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Width := 160;
  Height := 120;
  Center := true;
  Hint := 'Delphi Unit TGW_ImagePlus'#10#13'(c) Copyright 2004 - 2005 by Gothicware, Inc.';
  ShowHint := true;
end;

function min(a,b:Integer):Integer;
asm
  CMP EAX,b
  JG @HIA
  RET
 @HIA:
  MOV EAX,b
  RET
end;

function max(a,b:Integer):Integer;
asm
  CMP EAX,b
  JL @HIB
  RET
 @HIB:
  MOV EAX,b
  RET
end;

function IntToByte(i:Integer):Byte;
asm
  MOV EAX,i
  CMP EAX,254
  JG @SETHI
  CMP EAX,1
  JL @SETLO
  RET
@SETHI:
  MOV EAX,255
  RET
@SETLO:
  MOV EAX,0
end;

procedure _Invert(var src: TBitmap);
var i:Integer;
    p:PInteger;
begin
  src.PixelFormat:=pf32bit;
  p:= src.Scanline[Pred(src.Height)];
  for i:=1 to src.Width*src.Height do
    begin
      p^:= not p^;
      Inc(p);
    end;
end;

procedure _Matrix3x3(src:TBitmap; matrix: TMatrix3x3; Divider: Word);
var p,p0,p1,p2: PByteArray;
    x,y,c,z: Integer;
    tmp0,tmp1: TBitmap;
begin
  z:= Divider;
  if z = 0 then Inc(z);
  tmp0:= TBitmap.Create;
  tmp1:= TBitmap.Create;
  src.PixelFormat:= pf32bit;
  tmp0.PixelFormat:= pf32bit;
  tmp1.PixelFormat:= pf32bit;
  tmp0.Width:= src.Width +2;
  tmp0.Height:= src.Height+2;
  tmp1.Width:= src.Width +2;
  tmp1.Height:= src.Height+2;
  tmp0.Canvas.StretchDraw(Rect(0,0,tmp0.Width,tmp0.Height),src);
  tmp0.Canvas.Draw(1,1,src);
  tmp1.Canvas.Draw(0,0,tmp0);
  for y := 1 to tmp0.Height - 2 do begin
    p := tmp1.ScanLine[y+0];
    p0 := tmp0.ScanLine[y-1];
    p1 := tmp0.ScanLine[y+0];
    p2 := tmp0.ScanLine[y+1];
    for x := 1 to (tmp0.Width - 2) do
    for c := 0 to 3 do
      begin
        p[((x)*4)+c] := IntToByte(round((
          (p0[((x-1)*4)+c] * matrix[0]) + (p0[((x)*4)+c] * matrix[1]) + (p0[((x+1)*4)+c] * matrix[2]) +
          (p1[((x-1)*4)+c] * matrix[3]) + (p1[((x)*4)+c] * matrix[4]) + (p1[((x+1)*4)+c] * matrix[5]) +
          (p2[((x-1)*4)+c] * matrix[6]) + (p2[((x)*4)+c] * matrix[7]) + (p2[((x+1)*4)+c] * matrix[8])) / z));
      end;
  end;
  src.Canvas.CopyRect(Rect(0,0,src.Width,src.Height),tmp1.Canvas,Rect(1,1,src.Width,src.Height));
  tmp0.Free;
  tmp1.Free;
end;

procedure _Matrix5x5(src:TBitmap; matrix: TMatrix5x5; Divider: Word);
var p,p0,p1,p2,p3,p4: PByteArray;
    x,y,c,z: Integer;
    tmp0,tmp1: TBitmap;
begin
  z:= Divider;
  if z = 0 then Inc(z);
  tmp0:= TBitmap.Create;
  tmp1:= TBitmap.Create;
  src.PixelFormat:= pf32bit;
  tmp0.PixelFormat:= pf32bit;
  tmp1.PixelFormat:= pf32bit;
  tmp0.Width:= src.Width +4;
  tmp0.Height:= src.Height+4;
  tmp1.Width:= src.Width +4;
  tmp1.Height:= src.Height+4;
  tmp0.Canvas.StretchDraw(Rect(0,0,tmp0.Width,tmp0.Height),src); // not the best, but easy
  tmp0.Canvas.Draw(1,1,src);
  tmp1.Canvas.Draw(0,0,tmp0);
  for y := 2 to tmp0.Height - 3 do begin
    p := tmp1.ScanLine[y+0];
    p0 := tmp0.ScanLine[y-2];
    p1 := tmp0.ScanLine[y-1];
    p2 := tmp0.ScanLine[y+0];
    p3 := tmp0.ScanLine[y+1];
    p4 := tmp0.ScanLine[y+2];
    for x := 2 to (tmp0.Width - 3) do
    for c := 0 to 3 do
      begin
        p[((x)*4)+c] := IntToByte(round((
          (p0[((x-2)*4)+c] * matrix[00]) + (p0[((x-1)*4)+c] * matrix[01]) + (p0[((x)*4)+c] * matrix[02]) + (p0[((x+1)*4)+c] * matrix[03]) + (p0[((x+2)*4)+c] * matrix[04]) +
          (p1[((x-2)*4)+c] * matrix[05]) + (p1[((x-1)*4)+c] * matrix[06]) + (p1[((x)*4)+c] * matrix[07]) + (p1[((x+1)*4)+c] * matrix[08]) + (p1[((x+2)*4)+c] * matrix[09]) +
          (p2[((x-2)*4)+c] * matrix[10]) + (p2[((x-1)*4)+c] * matrix[11]) + (p2[((x)*4)+c] * matrix[12]) + (p2[((x+1)*4)+c] * matrix[13]) + (p2[((x+2)*4)+c] * matrix[14]) +
          (p3[((x-2)*4)+c] * matrix[15]) + (p3[((x-1)*4)+c] * matrix[16]) + (p3[((x)*4)+c] * matrix[17]) + (p3[((x+1)*4)+c] * matrix[18]) + (p3[((x+2)*4)+c] * matrix[19]) +
          (p4[((x-2)*4)+c] * matrix[20]) + (p4[((x-1)*4)+c] * matrix[21]) + (p4[((x)*4)+c] * matrix[22]) + (p4[((x+1)*4)+c] * matrix[23]) + (p4[((x+2)*4)+c] * matrix[24])) / z));
      end;
  end;
  src.Canvas.CopyRect(Rect(0,0,src.Width,src.Height),tmp1.Canvas,Rect(2,2,src.Width,src.Height));
  tmp0.Free;
  tmp1.Free;
end;

procedure _AntiAlias(var src: TBitmap);
var i,x,y,gwc:Integer;
    p0,p1,p2:PByteArray;
begin
  src.PixelFormat:=pf32bit;
  for y:= 0 to src.Height-1 do
  for x:= 0 to src.Width-1 do
    begin
      if y > 0 then p0:= src.Scanline[y-1] else p0:= src.Scanline[y];
      p1:= src.Scanline[y];
      if y < src.Height -1 then p2:= src.Scanline[y+1] else p2:= src.Scanline[y];
      for gwc:= 0 to 3 do
        begin
          if (x > 0) and (x < src.Width -1) then p1[x*4+gwc]:= (p1[x*4+gwc] + p1[(x-1)*4+gwc] + p1[(x+1)*4+gwc] + p0[x*4+gwc] + p2[x*4+gwc]) div 5;
          if (x = 0) then p1[x*4+gwc]:= (p1[x*4+gwc] + p1[(x)*4+gwc] + p1[(x+1)*4+gwc] + p0[x*4+gwc] + p2[x*4+gwc]) div 5;
          if (x = src.Width-1) then p1[x*4+gwc]:= (p1[x*4+gwc] + p1[(x-1)*4+gwc] + p1[(x)*4+gwc] + p0[x*4+gwc] + p2[x*4+gwc]) div 5;
        end;
    end;
end;

procedure _ColorNoise(var src: TBitmap; Amount: Integer);
var i:Integer;
    p:PInteger;
begin
  src.PixelFormat:=pf32bit;
  p:= src.Scanline[Pred(src.Height)];
  for i:=1 to src.Width*src.Height do
    begin
      p^:= rgb(IntToByte(getRvalue(p^)+(Random(Amount)-(Amount shr 1))),
               IntToByte(getGvalue(p^)+(Random(Amount)-(Amount shr 1))),
               IntToByte(getBvalue(p^)+(Random(Amount)-(Amount shr 1))));
      Inc(p);
    end;
end;

procedure _MonoNoise(var src: TBitmap; Amount: Integer);
var i,m:Integer;
    p:PInteger;
begin
  src.PixelFormat:=pf32bit;
  p:= src.Scanline[Pred(src.Height)];
  for i:=1 to src.Width*src.Height do
    begin
      m:= (Random(Amount)-(Amount shr 1));
      p^:= rgb(IntToByte(getRvalue(p^)+m),
               IntToByte(getGvalue(p^)+m),
               IntToByte(getBvalue(p^)+m));
      Inc(p);
    end;
end;

procedure _Spray(var src: TBitmap; Amount: Integer);
var p0,p1:PByteArray;
    newx,newy,oldx,oldy,w,h,val: Integer;
begin
  src.PixelFormat:=pf32bit;
  h:=src.height;
  w:=src.Width;
  for newy:=0 to h-1 do
    for newx:=0 to w-1 do
      begin
        val:= Random(Amount);
        oldx:=newx+val-Random(val*2);
        oldy:=newy+val-Random(val*2);
        if (oldx>-1) and (oldx<w) and (oldy>-1) and (oldy<h) then
          begin
            p0:= src.Scanline[newy];
            p1:= src.Scanline[oldy];
            p0[newx*4]:= p1[oldx*4];
            p0[newx*4+1]:= p1[oldx*4+1];
            p0[newx*4+2]:= p1[oldx*4+2];
            p0[newx*4+3]:= p1[oldx*4+3];
          end;
      end;
end;

procedure _Contrast(var src: TBitmap; Amount: Integer);
var i,m:Integer;
    r,g,b:Byte;
    p:PInteger;
begin
  src.PixelFormat:=pf32bit;
  p:= src.Scanline[Pred(src.Height)];
  for i:=1 to src.Width*src.Height do
    begin
      if getRvalue(p^) > 127 then r:= IntToByte(getRvalue(p^)+Amount) else r:= IntToByte(getRvalue(p^)-Amount);
      if getGvalue(p^) > 127 then g:= IntToByte(getGvalue(p^)+Amount) else g:= IntToByte(getGvalue(p^)-Amount);
      if getBvalue(p^) > 127 then b:= IntToByte(getBvalue(p^)+Amount) else b:= IntToByte(getBvalue(p^)-Amount);
      p^:= rgb(r,g,b);
      Inc(p);
    end;
end;

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 _Emboss(var src:TBitmap; Color:TColor);
var x,y,i: Integer;
    p0,p1: PByteArray;
begin
  src.PixelFormat:= pf32bit;
  for i:=0 to src.Height-2 do
  begin
    p0:=src.Scanline[i];
    p1:=src.Scanline[i+1];
    for x:=0 to src.Width-4 do
    begin
      p0[x*4+0] :=(p0[x*4+0] +(p1[(x+3)*4+0] xor getRvalue(Color)))shr 1;
      p0[x*4+1] :=(p0[x*4+1] +(p1[(x+3)*4+1] xor getGvalue(Color)))shr 1;
      p0[x*4+2] :=(p0[x*4+2] +(p1[(x+3)*4+2] xor getBvalue(Color)))shr 1;
    end;
    for x:=src.Width-3 to src.Width-1 do
    begin
      p0[x*4+0] :=(p0[x*4+0] +(p1[(x)*4+0] xor getRvalue(Color)))shr 1;
      p0[x*4+1] :=(p0[x*4+1] +(p1[(x)*4+1] xor getGvalue(Color)))shr 1;
      p0[x*4+2] :=(p0[x*4+2] +(p1[(x)*4+2] xor getBvalue(Color)))shr 1;
    end;
  end;
  p0:=src.scanline[src.Height-1];
  p1:=src.scanline[src.Height-2];
  for x:=0 to src.Width-4 do
  begin
    p0[x*4+0] :=(p0[x*4+0] +(p1[(x+3)*4+0] xor getRvalue(Color)))shr 1;
    p0[x*4+1] :=(p0[x*4+1] +(p1[(x+3)*4+1] xor getGvalue(Color)))shr 1;
    p0[x*4+2] :=(p0[x*4+2] +(p1[(x+3)*4+2] xor getBvalue(Color)))shr 1;
  end;
  for x:=src.Width-3 to src.Width-1 do
  begin
    p0[x*4+0] :=(p0[x*4+0] +(p1[(x)*4+0] xor getRvalue(Color)))shr 1;
    p0[x*4+1] :=(p0[x*4+1] +(p1[(x)*4+1] xor getGvalue(Color)))shr 1;
    p0[x*4+2] :=(p0[x*4+2] +(p1[(x)*4+2] xor getBvalue(Color)))shr 1;
  end;
end;

procedure _Coloring(var src: TBitmap; Color: TColor; Percent: TPercent);
var i,rest:Integer;
    p:PInteger;
    r,g,b:Byte;
begin
  src.PixelFormat:=pf32bit;
  p:= src.Scanline[Pred(src.Height)];
  rest:= 101-Percent;
  for i:=1 to src.Width*src.Height do
    begin
      r:= IntToByte(round(((getRvalue(p^)*rest) + (getBvalue(Color)*Percent))/ 100));
      g:= IntToByte(round(((getGvalue(p^)*rest) + (getGvalue(Color)*Percent))/ 100));
      b:= IntToByte(round(((getBvalue(p^)*rest) + (getRvalue(Color)*Percent))/ 100));
      p^:= rgb(r,g,b);
      Inc(p);
    end;
end;

procedure _ColorFilter(var src: TBitmap; Color: TColor);
var i:Integer;
    p:PInteger;
    r,g,b,gray:Byte;
begin
  src.PixelFormat:=pf32bit;
  p:= src.Scanline[Pred(src.Height)];
  for i:=1 to src.Width*src.Height do
    begin
      r:= getRvalue(p^);
      g:= getGvalue(p^);
      b:= getBvalue(p^);
      gray:= (r+g+b)div 3;
      r:= round(r/100*(100/255*getBvalue(Color)));
      g:= round(g/100*(100/255*getGvalue(Color)));
      b:= round(b/100*(100/255*getRvalue(Color)));
      p^:= rgb(r,g,b);
      Inc(p);
    end;
end;

procedure _MaxColoring(var src: TBitmap; Color: TColor);
var i:Integer;
    p:PInteger;
    r,g,b:Byte;
begin
  src.PixelFormat:=pf32bit;
  p:= src.Scanline[Pred(src.Height)];
  for i:=1 to src.Width*src.Height do
    begin
      r:= max(getRvalue(p^),getBvalue(Color));
      g:= max(getGvalue(p^),getGvalue(Color));
      b:= max(getBvalue(p^),getRvalue(Color));
      p^:= rgb(r,g,b);
      Inc(p);
    end;
end;

procedure _MinColoring(var src: TBitmap; Color: TColor);
var i:Integer;
    p:PInteger;
    r,g,b:Byte;
begin
  src.PixelFormat:=pf32bit;
  p:= src.Scanline[Pred(src.Height)];
  for i:=1 to src.Width*src.Height do
    begin
      r:= min(getRvalue(p^),getBvalue(Color));
      g:= min(getGvalue(p^),getGvalue(Color));
      b:= min(getBvalue(p^),getRvalue(Color));
      p^:= rgb(r,g,b);
      Inc(p);
    end;
end;

procedure _Mosaic(var src: TBitmap; HSize,VSize: Integer);
var x,y,i,j,hs,vs:Integer;
    p0,p1:PByteArray;
    r,g,b:Byte;
begin
  src.PixelFormat:=pf32bit;
  hs:= max(min(HSize,src.Width),0);
  vs:= max(min(VSize,src.Height),0);
  if (hs<1) then exit;
  if (vs<1) then exit;
  y:=0;
  repeat
    p0:=src.scanline[y];
    x:=0;
    repeat
      j:=1;
      repeat
      p1:=src.scanline[y];
      x:=0;
      repeat
        r:=p0[x*4+0];
        g:=p0[x*4+1];
        b:=p0[x*4+2];
        i:=1;
          repeat
            p1[x*4+0]:=r;
            p1[x*4+1]:=g;
            p1[x*4+2]:=b;
            inc(x);
            inc(i);
          until (x>=src.width) or (i>hs);
        until x>=src.width;
        inc(j);
        inc(y);
      until (y>=src.height) or (j>vs);
    until (y>=src.height) or (x>=src.width);
  until y>=src.height;
end;

procedure _SplitBlur(var src: TBitmap; Amount: Integer);
var p0,p1,p2:PByteArray;
    cx,i,x,y: Integer;
    Buf: array[0..3,0..2]of Byte;
begin
  src.PixelFormat:=pf32bit;
  if Amount=0 then Exit;
  for y:=0 to src.Height-1 do
  begin
    p0:=src.scanline[y];
    if (y-Amount) < 0 then
      p1:= src.ScanLine[y]
    else
      p1:= src.ScanLine[y-Amount];
    if (y+Amount) < src.Height then
      p2:= src.ScanLine[y+Amount]
    else
      p2:=src.ScanLine[src.Height-y];
    for x:=0 to src.Width-1 do
    begin
      if (x-Amount) < 0 then
        cx:= x
      else
        cx:= x-Amount;
      Buf[0,0]:=p1[cx*4+0];
      Buf[0,1]:=p1[cx*4+1];
      Buf[0,2]:=p1[cx*4+2];
      Buf[1,0]:=p2[cx*4+0];
      Buf[1,1]:=p2[cx*4+1];
      Buf[1,2]:=p2[cx*4+2];
      if (x+Amount) < src.Width then
        cx:=x+Amount
      else
        cx:= src.Width-x;
      Buf[2,0]:=p1[cx*4+0];
      Buf[2,1]:=p1[cx*4+1];
      Buf[2,2]:=p1[cx*4+2];
      Buf[3,0]:=p2[cx*4+0];
      Buf[3,1]:=p2[cx*4+1];
      Buf[3,2]:=p2[cx*4+2];
      p0[x*4+0]:=(Buf[0,0]+Buf[1,0]+Buf[2,0]+Buf[3,0])shr 2;
      p0[x*4+1]:=(Buf[0,1]+Buf[1,1]+Buf[2,1]+Buf[3,1])shr 2;
      p0[x*4+2]:=(Buf[0,2]+Buf[1,2]+Buf[2,2]+Buf[3,2])shr 2;
    end;
  end;
end;

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


procedure TGW_ImagePlus.doAntiAlias;
var tmpBmp: TBitmap;
    oldPf: TPixelFormat;
begin
  tmpBmp:= TBitmap.Create;
  tmpBmp.Assign(Picture.Bitmap);
  oldPf:= tmpBmp.PixelFormat;
  _AntiAlias(tmpBmp);
  tmpBmp.PixelFormat:= oldPf;
  Picture.Bitmap.Assign(tmpBmp);
  tmpBmp.Free;
  Invalidate;
end;

procedure TGW_ImagePlus.doInvert;
var tmpBmp: TBitmap;
    oldPf: TPixelFormat;
begin
  tmpBmp:= TBitmap.Create;
  tmpBmp.Assign(Picture.Bitmap);
  oldPf:= tmpBmp.PixelFormat;
  _Invert(tmpBmp);
  tmpBmp.PixelFormat:= oldPf;
  Picture.Bitmap.Assign(tmpBmp);
  tmpBmp.Free;
  Invalidate;
end;

procedure TGW_ImagePlus.doColorNoise(Amount: Integer);
var tmpBmp: TBitmap;
    oldPf: TPixelFormat;
begin
  tmpBmp:= TBitmap.Create;
  tmpBmp.Assign(Picture.Bitmap);
  oldPf:= tmpBmp.PixelFormat;
  _ColorNoise(tmpBmp, Amount);
  tmpBmp.PixelFormat:= oldPf;
  Picture.Bitmap.Assign(tmpBmp);
  tmpBmp.Free;
  Invalidate;
end;

procedure TGW_ImagePlus.doMonoNoise(Amount: Integer);
var tmpBmp: TBitmap;
    oldPf: TPixelFormat;
begin
  tmpBmp:= TBitmap.Create;
  tmpBmp.Assign(Picture.Bitmap);
  oldPf:= tmpBmp.PixelFormat;
  _MonoNoise(tmpBmp, Amount);
  tmpBmp.PixelFormat:= oldPf;
  Picture.Bitmap.Assign(tmpBmp);
  tmpBmp.Free;
  Invalidate;
end;

procedure TGW_ImagePlus.doSpray(Amount: Integer);
var tmpBmp: TBitmap;
    oldPf: TPixelFormat;
begin
  tmpBmp:= TBitmap.Create;
  tmpBmp.Assign(Picture.Bitmap);
  oldPf:= tmpBmp.PixelFormat;
  if Amount > 0 then _Spray(tmpBmp, Amount) else _Spray(tmpBmp, Amount * -1);
  tmpBmp.PixelFormat:= oldPf;
  Picture.Bitmap.Assign(tmpBmp);
  tmpBmp.Free;
  Invalidate;
end;

procedure TGW_ImagePlus.doContrast(Amount: Integer);
var tmpBmp: TBitmap;
    oldPf: TPixelFormat;
begin
  tmpBmp:= TBitmap.Create;
  tmpBmp.Assign(Picture.Bitmap);
  oldPf:= tmpBmp.PixelFormat;
  _Contrast(tmpBmp, Amount);
  tmpBmp.PixelFormat:= oldPf;
  Picture.Bitmap.Assign(tmpBmp);
  tmpBmp.Free;
  Invalidate;
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;

procedure TGW_ImagePlus.doEmboss(Color: TColor);
var tmpBmp: TBitmap;
    oldPf: TPixelFormat;
begin
  tmpBmp:= TBitmap.Create;
  tmpBmp.Assign(Picture.Bitmap);
  oldPf:= tmpBmp.PixelFormat;
  _Emboss(tmpBmp,Color);
  tmpBmp.PixelFormat:= oldPf;
  Picture.Bitmap.Assign(tmpBmp);
  tmpBmp.Free;
  Invalidate;
end;

procedure TGW_ImagePlus.doColoring(Color: TColor; Percent: TPercent);
var tmpBmp: TBitmap;
    oldPf: TPixelFormat;
begin
  tmpBmp:= TBitmap.Create;
  tmpBmp.Assign(Picture.Bitmap);
  oldPf:= tmpBmp.PixelFormat;
  _Coloring(tmpBmp,Color,Percent);
  tmpBmp.PixelFormat:= oldPf;
  Picture.Bitmap.Assign(tmpBmp);
  tmpBmp.Free;
  Invalidate;
end;

procedure TGW_ImagePlus.doColorFilter(Color: TColor);
var tmpBmp: TBitmap;
    oldPf: TPixelFormat;
begin
  tmpBmp:= TBitmap.Create;
  tmpBmp.Assign(Picture.Bitmap);
  oldPf:= tmpBmp.PixelFormat;
  _ColorFilter(tmpBmp,Color);
  tmpBmp.PixelFormat:= oldPf;
  Picture.Bitmap.Assign(tmpBmp);
  tmpBmp.Free;
  Invalidate;
end;

procedure TGW_ImagePlus.doMaxColoring(Color: TColor);
var tmpBmp: TBitmap;
    oldPf: TPixelFormat;
begin
  tmpBmp:= TBitmap.Create;
  tmpBmp.Assign(Picture.Bitmap);
  oldPf:= tmpBmp.PixelFormat;
  _MaxColoring(tmpBmp,Color);
  tmpBmp.PixelFormat:= oldPf;
  Picture.Bitmap.Assign(tmpBmp);
  tmpBmp.Free;
  Invalidate;
end;

procedure TGW_ImagePlus.doMinColoring(Color: TColor);
var tmpBmp: TBitmap;
    oldPf: TPixelFormat;
begin
  tmpBmp:= TBitmap.Create;
  tmpBmp.Assign(Picture.Bitmap);
  oldPf:= tmpBmp.PixelFormat;
  _MinColoring(tmpBmp,Color);
  tmpBmp.PixelFormat:= oldPf;
  Picture.Bitmap.Assign(tmpBmp);
  tmpBmp.Free;
  Invalidate;
end;

procedure TGW_ImagePlus.doMosaic(HSize,VSize: Integer);
var tmpBmp: TBitmap;
    oldPf: TPixelFormat;
begin
  tmpBmp:= TBitmap.Create;
  tmpBmp.Assign(Picture.Bitmap);
  oldPf:= tmpBmp.PixelFormat;
  _Mosaic(tmpBmp,HSize,VSize);
  tmpBmp.PixelFormat:= oldPf;
  Picture.Bitmap.Assign(tmpBmp);
  tmpBmp.Free;
  Invalidate;
end;

procedure TGW_ImagePlus.doMatrix3x3(Matrix: TMatrix3x3; Divider: Integer);
var tmpBMP : TBitmap;
    oldPf: TPixelFormat;
begin
  tmpBmp:= TBitmap.Create;
  tmpBmp.Assign(Picture.Bitmap);
  oldPf:= tmpBmp.PixelFormat;
  _Matrix3x3(tmpBmp ,Matrix,Divider);
  tmpBmp.PixelFormat:= oldPf;
  Picture.Bitmap.Assign(tmpBmp);
  tmpBmp.Free;
  Invalidate;
end;

procedure TGW_ImagePlus.doMatrix5x5(Matrix: TMatrix5x5; Divider: Integer);
var tmpBMP : TBitmap;
    oldPf: TPixelFormat;
begin
  tmpBmp:= TBitmap.Create;
  tmpBmp.Assign(Picture.Bitmap);
  oldPf:= tmpBmp.PixelFormat;
  _Matrix5x5(tmpBmp ,Matrix,Divider);
  tmpBmp.PixelFormat:= oldPf;
  Picture.Bitmap.Assign(tmpBmp);
  tmpBmp.Free;
  Invalidate;
end;

procedure TGW_ImagePlus.doSplitBlur(Amount: Integer);
var tmpBmp: TBitmap;
    oldPf: TPixelFormat;
begin
  tmpBmp:= TBitmap.Create;
  tmpBmp.Assign(Picture.Bitmap);
  oldPf:= tmpBmp.PixelFormat;
  if Amount > 0 then _SplitBlur(tmpBmp, Amount)
  else _SplitBlur(tmpBmp, Amount * -1);
  tmpBmp.PixelFormat:= oldPf;
  Picture.Bitmap.Assign(tmpBmp);
  tmpBmp.Free;
  Invalidate;
end;

end.
Für Anregungen, Fragen , Kritik , Lob , oder weiter Codes
stehe ich gerne zur Verfügung. Wenn jemand lust hat ein Demo-Prog zuschreiben, mitzuwirken oder diese Unit in seinem Prog verwenden will, bitte eine PM an mich.

Danke und viel Spass,

Gothicware, Inc.
Sometimes i think there must be a dolphin in delphi!?
  Mit Zitat antworten Zitat