Bild mit einem Filter oder Effekt versehen..!?

[Phantom1]

Es ist eigentlich alles möglich

Für solche Filter wie Weichzeichnen, Schärfen usw, kann man mit einer FilterMatrix arbeiten. Folgend mal ein Code von mir (ist jedoch nicht auf geschwindigkeit optimiert).

Delphi-Quellcode:

Type
  TMatrix3x3 = Array[0..10] of Integer;

Const
  F_AntiAlias   : TMatrix3x3 = (0,0,0, 0,1,1, 0,1,1, 4,0);
  F_Sharpen     : TMatrix3x3 = (-1,-2,-1, -2,28,-2, -1,-2,-1, 16,0);
  F_SharpenMore : TMatrix3x3 = (0,-1,0, -1,6,-1, 0,-1,0, 2,0);
  F_Soften      : TMatrix3x3 = (6,12,6, 12,25,12, 6,12,6, 97,0);
  F_SoftenMore  : TMatrix3x3 = (1,1,1, 1,1,1, 1,1,1, 9,0);
  F_Lithography : TMatrix3x3 = (-5,-5,-5, -5,42,-5, -5,-5,-5, 2,0);
  F_HiPass      : TMatrix3x3 = (-1,-1,-1, -1,9,-1, -1,-1,-1, 1,0);
  F_Emboss1     : TMatrix3x3 = (-1,0,0, 0,0,0, 0,0,1, 1,128);
  F_Emboss2     : TMatrix3x3 = (0,-1,0, -1,1,1, 0,1,0, 1,0);
  F_FindLines   : TMatrix3x3 = (1,1,1, 1,-8,1, 1,1,1, 1,0);
  F_FindEdges   : TMatrix3x3 = (4,4,4, 4,-33,4, 4,4,4, 1,0);
  F_Sculpture   : TMatrix3x3 = (0,-1,-1, 0,2,0, 0,0,0, 1,0);

procedure TForm1.BmpMatrix3x3(Bmp: TBitmap; Mx: TMatrix3x3);
Type
  TRGBArray = Array[0..0] of Packed Record b, g, r: byte End;
var
  BmpCopy: TBitmap;
  SrcSL : Array of ^TRGBArray;
  DestSL: ^TRGBArray;
  i, dx,dy, x,y, R,G,B, RR,GG,BB, divisor, bias: Integer;
  BmpHeight,BmpWidth: Integer;
Begin
  BmpWidth:=Bmp.Width; BmpHeight:=Bmp.Height;
  divisor:=Mx[High(Mx)-1]; bias:=Mx[High(Mx)];
  BmpCopy:=TBitmap.Create;
  Try
    BmpCopy.Assign(Bmp);
    SetLength(SrcSL,BmpHeight);
    For i:=0 To BmpHeight-1 Do
      SrcSL[i]:=BmpCopy.ScanLine[i];
    For y:=0 to BmpHeight-1 Do Begin
      DestSL:=Bmp.ScanLine[y];
      For x:=0 to BmpWidth-1 Do begin
        RR:=0; GG:=0; BB:=0;
        For dy:=-1 To 1 Do
          For dx:=-1 To 1 Do Begin
            If (y+dy >= 0) And (y+dy <= BmpHeight-1) And
               (x+dx >= 0) And (x+dx <= BmpWidth-1) Then Begin
              R:=SrcSL[y+dy,x+dx].r;
              G:=SrcSL[y+dy,x+dx].g;
              B:=SrcSL[y+dy,x+dx].b;
            End Else Begin
              R:=SrcSL[y,x].r;
              G:=SrcSL[y,x].g;
              B:=SrcSL[y,x].b;
            End;
            i:=Mx[4+dy*3+dx];
            RR:=RR+R*i;
            GG:=GG+G*i;
            BB:=BB+B*i;
          End;
        RR:=RR div divisor + bias;
        GG:=GG div divisor + bias;
        BB:=BB div divisor + bias;
        If RR>255 Then RR:=255 Else If RR<0 Then RR:=0;
        If GG>255 Then GG:=255 Else If GG<0 Then GG:=0;
        If BB>255 Then BB:=255 Else If BB<0 Then BB:=0;
        DestSL[x].r:=RR;
        DestSL[x].g:=GG;
        DestSL[x].b:=BB;
      End;
    End;
  Finally
    BmpCopy.Free;
  End;
end;