1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:

unit GW_ImagePlus;
.
.
  // Hier die Typen die Übergeben werden, oder Intern genutzt
  TDirection = (drLeft, drTop, drRight, drBottom,
                drLeftTop, drTopRight, drRightBottom, drBottomLeft);
  TOrientation = (orLeft, orTop, orRight, orBottom);
  THSL = record H,S,L: Double; end;
  TRGB = record R,G,B: Byte; end;
  TMatrix3x3 = array [0..8] of Integer;
  TMatrix5x5 = array [0..24] of Integer;
  TPercent = $00..$64;

.
.
//-------------------------------> do procedures <----------------------------->
    // AnitAlias Filter
    procedure doAntiAlias;
    // Helligkeit erhöhen mit variabler Kanal Steuerung
    procedure doBrightness       (AmountR, AmountG, AmountB: Integer);
    // Simuliert einen Farbfilter, wie bei einer Kamera
    procedure doColorFilter      (Color: TColor);
    // Tönt das Bild mit einer bestimmten Farbe zu n Prozent
    procedure doColoring         (Color: TColor; Percent: TPercent);
    // Fügt bunte Pixel hinzu, je höher Amount umso mehr
    procedure doColorNoise       (Amount: Integer);
    // Verschiebt die einzelnen Kanäle mit Cosinus Algo
    procedure doColorPushCosinus (AmountR, AmountG, AmountB: Integer);
    // Verschiebt die einzelnen Kanäle mit Sinus Algo
    procedure doColorPushSinus   (AmountR, AmountG, AmountB: Integer);
    // Stellt den Kontrast für die einzelnen Kanäle ein
    procedure doContrast         (AmountR, AmountG, AmountB: Integer);
    // Emboss Filter mit wählbarem Grundton, Color = clGray => Typisches Emboss
    procedure doEmboss           (Color: TColor);
    // Dreht die Seite Horizontal und/oder Vertikal
    procedure doFlip             (FlipH, FlipV: Boolean);
    // Ersetzt die Farben von Dunkel bis Hell durch einen Farbverlauf (auch mehrfarbig)
    procedure doGradientColors   (FromColor: TColor; ToColors: array of TColor);
    // und alles ist so Grau ;-)
    procedure doGrayScale;
    // malt ein Gitter in der Angebenen Farbe und setzt die Farbe auf Transparent
    procedure doGridOpaque       (Color: TColor);
    // Pixel werden je nach Helligkeit und Amount nach Oben verschoben, kleiner 3D Effekt
    procedure doHighMap          (Amount: Integer);
    // Negativ Bild
    procedure doInvert;
    // wie HighMap nur nach unten
    procedure doLowMap           (Amount: Integer);
    // Consolve Filter mit 3x3 (9) Feldern, standart mässig sollte der Divider die Summe 
    // aller Felder sein, und > 0 
    procedure doMatrix3x3        (Matrix: TMatrix3x3; Divider: Integer);
    // wie Matrix 3x3 nur mit 5x5 (25) Feldern
    procedure doMatrix5x5        (Matrix: TMatrix5x5; Divider: Integer);
    // Ist der Kanal-Wert von Color grösser als der vom Orginal Pixel so wird dieser ersetzt
    procedure doMaxColoring      (Color: TColor);
    // wie MaxColoring nur mit dem kleineren Wert
    procedure doMinColoring      (Color: TColor);
    // wie ColorNoise nur in Grayscale
    procedure doMonoNoise        (Amount: Integer);
    // Verpixelt das Bild, HSize und VSize ist Breite und Höher der Blöcke
    procedure doMosaic           (HSize, VSize: Integer);
    // Posterize Filter
    procedure doPosterize        (Amount: Integer);
    // wie GridOpaque nur mit Pixeln
    procedure doSemiOpaque       (Color: TColor);
    // normaler Sepia (alte Fotos) Effekt
    procedure doSepia            (Amount: Integer);
    // dunkeler werdendes Sepia
    procedure doSepiaDark        (Amount: Integer);
    // heler werdendes Sepia
    procedure doSepiaLight       (Amount: Integer);
    // weicher Wellen Effekt Amount gibt die Verschiebung Horizontal und Vertikal an,
    // und Waves die anzahl der Wellen (eine Welle besteht aus einen Berg und einem Tal)
    procedure doSoftWaves        (AmountH, AmountV, WavesH, WavesV: Integer);
    // Solorize Filter, SlitBlur Filter
    procedure doSolorize         (Amount: Integer);
    procedure doSplitBlur        (Amount: Integer);
    // Pixel werden leicht vom Ursprung verschoben, Spray Effekt
    procedure doSpray            (Amount: Integer);
    // noch nicht toll, aber verdreht das Bild
    procedure doTwist            (Amount: Integer);
    // Wie Softwaves, nur ohne Soften ;-)
    procedure doWaves            (AmountH, AmountV, WavesH, WavesV: Integer);
//-----------------------------> make procedures <----------------------------->
    // Füllt das Rect mit dem Angegenem Verlauf in die angegebene Richtung
    procedure makeGradientRect   (Rect: TRect; FromColor: TColor; ToColors: array of TColor; Orientation: TOrientation);
    // erstellt ein Mandelbrot oder Julia Bild. M2J = 0 => reines Mandelbrot 
    // (M2J > 0) and (M2J < 1) => Madel/Julia Mix, M2J = 1 => reines Julia Bild
    procedure makeMandelOrJulia  (xl, xu, yl, yu: Extended; iterations: Integer; M2J: Double; FromColor: TColor; ToColors: array of TColor);
    // erstellt ein Pascal Dreieck mit Vordergrund und Hintergrund Farbe
    procedure makePascalTriangle (FGColor, BGColor: TColor);
  end;

procedure Register;

//----------------------------------------------------------------------------->
//-------------------------------> Global Export <----------------------------->
//----------------------------------------------------------------------------->

    // Tauscht bei TColor Kanal Rot mit Blau
    function BGRToRGB(Color: TColor): TColor;
    // liefert einen Farbton von einem Verlauf zurück, Step => welcher Schritt, Steps => 
    // Anz. der Verlaufsstufen
    function GetGradientColor(FromColor, ToColor: TColor; Step, Steps: Integer): TColor;
    // Wie rgb(r,g,b) nur mit HSL Farbsystem
    function HSL(H, S, L: Double): TColor;
    // Trimt i zwischen 0 und 255, (asm)
    function IntToByte(i: Integer): Byte;
    // Zerlegt TColor in die einzelnen Kanäle für RGB oder HSL
    procedure ExplodeHSL(Color: TColor; var H, S, L: Double);
    procedure ExplodeRGB(Color: TColor; var R, G, B: Byte);                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:

Unit GW_ImagePlus.pas History
------------------------------
 #  03.10.2005 fix Flip Bug
 +  08.10.2005 add doBlendDraw
 #  09.10.2005 speed up Max/Min function
 +  09.10.2005 add createEmptyBitmap
 +  09.10.2005 add doTrace
 #  10.10.2005 edit doTrace with Colorchannel support
 #  10.10.2005 make the hard decision to put the library under the Trems of
               the GNU Lesser General Public License                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:

procedure _GrayScale(var src: TBitmap);
var i, gray: Integer;
    p: PInteger;
begin
  src.PixelFormat := pf32bit;
  p := src.Scanline[Pred(src.Height)];
  for i := 1 to src.Width * src.Height do
    begin
      gray := IntToByte( Round((getRvalue(p^) + getGvalue(p^) + getBvalue(p^)) / 3));
      p^ := rgb(gray, gray, gray);
      Inc(p);
    end;
end;