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:

zusammenfalten · markieren

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:

zusammenfalten · markieren

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.

Zitat:

Im Gegensatz zu meinen
früheren Arbeiten auf diesem Gebiet, habe ich alle Filter/Effekte ins PixelFormat pf32bit
umgeschrieben.

mit welchem pixelformat arbeitet denn dann deine alte unit? mir waere wichtig, das solche
sachen in 16 bit und 32 bit treiberaufloesung funzen ok viellciht nach un 24 bit für ati juenger

oder ist mit pixelformat was anderes gemeint, als die interne darstellung der pixel bei verschiedenen
farbtiefen?

Gruß Richard

Zitat von richard_boderich:

mit welchem pixelformat arbeitet denn dann deine alte unit? mir waere wichtig, das solche
sachen in 16 bit und 32 bit treiberaufloesung funzen ok viellciht nach un 24 bit für ati juenger

Meine alte Unit lief nur mit pf24bit, was auf der einen Seite etwas einfacher war. Damit keine alt zu Grossen Probleme mit unterschiedlichen PixelFormaten auftretten, speichere ich das alte PixelFormat voher und stelle es nach durchführung des Filters wieder her. So das der Benutzer sich selber garnicht um das Pixelformat im goben kümmern muss. Später wird ventuell noch ein ColorManagement und ein Paletten Option kommen.