AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
• Registrieren
Zurück Delphi-PRAXiS Projekte TGW_ImagePlus 2, TImage mit Effekten und Filtern
Thema durchsuchen
Ansicht
Themen-Optionen

TGW_ImagePlus 2, TImage mit Effekten und Filtern

Ein Thema von Gothicware · begonnen am 17. Sep 2005 · letzter Beitrag vom 18. Sep 2005
Antwort Antwort
Gothicware
Registriert seit: 25. Aug 2005
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.
Sometimes i think there must be a dolphin in delphi!?
 
17. Sep 2005, 20:50
Dieses Thema wurde von "Daniel" von "Freeware" nach "Open-Source" verschoben.
Benutzerbild von richard_boderich
richard_boderich

 
Delphi 7 Architect
 
#3
  Alt 18. Sep 2005, 09:25
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
  Mit Zitat antworten Zitat
Gothicware
 
#4
  Alt 18. Sep 2005, 15:04
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.
  Mit Zitat antworten Zitat
Antwort Antwort

« Vorheriges Thema | Nächstes Thema »

Forumregeln

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

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