Unit janFX; { original release 2-july-2000 janFX is written by Jan Verhoeven most routines are written by myself, some are extracted from freeware sources on the internet to use this library add it to your library path with Tools - Environment Options - Library path in your application you just call the routines for clarity and convenience you might preceed them with janFX like: janFX.Buttonize(src,depth,weight); this library is the updated succesor of my TjanPaintFX component } Interface {$DEFINE USE_SCANLINE} Uses Windows, SysUtils, Classes, Graphics, math; Type // Type of a filter for use with Stretch() TFilterProc = Function(Value: Single): Single; TLightBrush = (lbBrightness, lbContrast, lbSaturation, lbfisheye, lbrotate, lbtwist, lbrimple, mbHor, mbTop, mbBottom, mbDiamond, mbWaste, mbRound, mbround2, mbsplitround, mbsplitwaste); // For scanline simplification TRGBArray = Array[0..32767] Of TRGBTriple; pRGBArray = ^TRGBArray; Function ConvertColor(Value: Integer): TColor; Function Set255(Clr: integer): integer; Procedure CopyMe(tobmp: TBitmap; frbmp: TGraphic); Procedure MaskOval(src: TBitmap; acolor: TColor); Procedure Buttonize(src: TBitmap; depth: byte; weight: integer); Procedure ButtonizeOval(src: TBitmap; depth: byte; weight: integer; rim: String); Procedure Seamless(src: TBitmap; depth: byte); Procedure ConvolveM(ray: Array Of integer; z: word; aBmp: TBitmap); Procedure ConvolveE(ray: Array Of integer; z: word; aBmp: TBitmap); Procedure ConvolveI(ray: Array Of integer; z: word; aBmp: TBitmap); Procedure ConvolveFilter(filternr, edgenr: integer; src: TBitmap); // filternr=0..8 edgenr=0..2 (0 for seamless) Procedure Solorize(src, dst: tbitmap; amount: integer); Procedure Posterize(src, dst: tbitmap; amount: integer); Procedure Blend(src1, src2, dst: tbitmap; amount: extended); Procedure ExtractColor(src: TBitmap; Acolor: tcolor); Procedure ExcludeColor(src: TBitmap; Acolor: tcolor); Procedure turn(src, dst: tbitmap); Procedure turnRight(src, dst: Tbitmap); Procedure HeightMap(src: Tbitmap; amount: integer); Procedure TexturizeTile(src: TBitmap; amount: integer); Procedure TexturizeOverlap(src: TBitmap; amount: integer); Procedure RippleRandom(src: TBitmap; amount: integer); Procedure RippleTooth(src: TBitmap; amount: integer); Procedure RippleTriangle(src: TBitmap; amount: integer); Procedure Triangles(src: TBitmap; amount: integer); Procedure DrawMandelJulia(src: Tbitmap; x0, y0, x1, y1: extended; Niter: integer; Mandel: Boolean); Procedure filterxblue(src: tbitmap; min, max: integer); Procedure filterxgreen(src: tbitmap; min, max: integer); Procedure filterxred(src: tbitmap; min, max: integer); Procedure filterblue(src: tbitmap; min, max: integer); Procedure filtergreen(src: tbitmap; min, max: integer); Procedure filterred(src: tbitmap; min, max: integer); Procedure Emboss(Var Bmp: TBitmap); Procedure Plasma(src1, src2, dst: Tbitmap; scale, turbulence: extended); Procedure Shake(src, dst: Tbitmap; factor: extended); Procedure ShakeDown(src, dst: Tbitmap; factor: extended); Procedure KeepBlue(src: Tbitmap; factor: extended); Procedure KeepGreen(src: Tbitmap; factor: extended); Procedure KeepRed(src: Tbitmap; factor: extended); Procedure MandelBrot(src: Tbitmap; factor: integer); Procedure MaskMandelBrot(src: Tbitmap; factor: integer); Procedure FoldRight(src1, src2, dst: Tbitmap; amount: extended); Procedure QuartoOpaque(src, dst: tbitmap); Procedure semiOpaque(src, dst: Tbitmap); Procedure ShadowDownLeft(src: tbitmap); Procedure ShadowDownRight(src: tbitmap); Procedure shadowupleft(src: Tbitmap); Procedure shadowupright(src: tbitmap); Procedure Darkness(Var src: tbitmap; Amount: integer); Procedure Trace(src: Tbitmap; intensity: integer); Procedure FlipRight(src: Tbitmap); Procedure FlipDown(src: Tbitmap); Procedure SpotLight(Var src: Tbitmap; Amount: integer; Spot: TRect); Procedure splitlight(Var clip: tbitmap; amount: integer); Procedure MakeSeamlessClip(Var clip: tbitmap; seam: integer); Procedure Wave(Var clip: tbitmap; amount, inference, style: integer); Procedure Mosaic(Var Bm: TBitmap; size: Integer); Function TrimInt(i, Min, Max: Integer): Integer; Procedure SmoothRotate(Var Src, Dst: TBitmap; cx, cy: Integer; Angle: Extended); Procedure SmoothResize(Var Src, Dst: TBitmap); Procedure Twist(Bmp, Dst: TBitmap; Amount: integer); Procedure SplitBlur(Var clip: tbitmap; Amount: integer); Procedure SoftnessBlur(clip: tbitmap; Amount: Integer); Procedure GaussianBlur(Var clip: tbitmap; Amount: integer); Procedure Smooth(Var clip: tbitmap; Weight: Integer); Procedure GrayScale(Var clip: tbitmap); Procedure AddColorNoise(Var clip: tbitmap; Amount: Integer); Procedure AddMonoNoise(Var clip: tbitmap; Amount: Integer); Procedure Contrast(Var clip: tbitmap; Amount: Integer); Procedure Lightness(Var clip: tbitmap; Amount: Integer); Procedure Saturation(Var clip: tbitmap; Amount: Integer); Procedure Spray(Var clip: tbitmap; Amount: Integer); Procedure AntiAlias(clip: tbitmap); Procedure AntiAliasRect(clip: tbitmap; XOrigin, YOrigin, XFinal, YFinal: Integer); Procedure SmoothPoint(Var clip: tbitmap; xk, yk: integer); Procedure FishEye(Bmp, Dst: TBitmap; Amount: Extended); Procedure marble(Var src, dst: tbitmap; scale: extended; turbulence: integer); Procedure marble2(Var src, dst: tbitmap; scale: extended; turbulence: integer); Procedure marble3(Var src, dst: tbitmap; scale: extended; turbulence: integer); Procedure marble4(Var src, dst: tbitmap; scale: extended; turbulence: integer); Procedure marble5(Var src, dst: tbitmap; scale: extended; turbulence: integer); Procedure marble6(Var src, dst: tbitmap; scale: extended; turbulence: integer); Procedure marble7(Var src, dst: tbitmap; scale: extended; turbulence: integer); Procedure marble8(Var src, dst: tbitmap; scale: extended; turbulence: integer); Procedure squeezehor(src, dst: tbitmap; amount: integer; style: TLightBrush); Procedure splitround(src, dst: tbitmap; amount: integer; style: TLightBrush); Procedure tile(src, dst: TBitmap; amount: integer); // Interpolator // Src: Source bitmap // Dst: Destination bitmap // filter: Weight calculation filter // fwidth: Relative sample radius Procedure Strecth(Src, Dst: TBitmap; filter: TFilterProc; fwidth: single); Procedure Grow(Src1, Src2, Dst: TBitmap; amount: extended; x, y: integer); Procedure Invert(src: tbitmap); Procedure MirrorRight(src: Tbitmap); Procedure MirrorDown(src: Tbitmap); // Sample filters for use with Stretch() Function SplineFilter(Value: Single): Single; Function BellFilter(Value: Single): Single; Function TriangleFilter(Value: Single): Single; Function BoxFilter(Value: Single): Single; Function HermiteFilter(Value: Single): Single; Function Lanczos3Filter(Value: Single): Single; Function MitchellFilter(Value: Single): Single; Procedure Sharpen(SrcBmp: Tbitmap); Const MaxPixelCount = 32768; // ----------------------------------------------------------------------------- // // List of Filters // // ----------------------------------------------------------------------------- ResampleFilters: Array[0..6] Of Record Name: String; // Filter name Filter: TFilterProc; // Filter implementation Width: Single; // Suggested sampling width/radius End = ( (Name: 'Box'; Filter: BoxFilter; Width: 0.5), (Name: 'Triangle'; Filter: TriangleFilter; Width: 1.0), (Name: 'Hermite'; Filter: HermiteFilter; Width: 1.0), (Name: 'Bell'; Filter: BellFilter; Width: 1.5), (Name: 'B-Spline'; Filter: SplineFilter; Width: 2.0), (Name: 'Lanczos3'; Filter: Lanczos3Filter; Width: 3.0), (Name: 'Mitchell'; Filter: MitchellFilter; Width: 2.0) ); Implementation Type TRGBTripleArray = Array[0..MaxPixelCount - 1] Of TRGBTriple; pRGBTripleArray = ^TRGBTripleArray; TFColor = Record b, g, r: Byte; End; // Procedure Sharpen(SrcBmp: Tbitmap); //;AProgressBar:TProgressBar=Nil); Function Min(a, b: integer): integer; Begin If a < b Then result := a Else result := b; End; Function Max(a, b: integer): integer; Begin If a > b Then result := a Else result := b; End; Var i, j: integer; SrcRow: pRGBArray; SrcPreRow: pRGBArray; Value: integer; Begin // AProgressBar.Max:=SrcBmp.Height - 1; For i := 1 To SrcBmp.Height - 1 Do Begin SrcRow := SrcBmp.ScanLine[i]; SrcPreRow := SrcBmp.ScanLine[i - 1]; //DestRow := DestBmp.ScanLine[i]; // for each pixel in row For j := 0 To SrcBmp.Width - 1 Do Begin // add brightness value to pixel's RGB values // RGB values must be less than 256 Value := SrcRow[j].rgbtRed + (SrcRow[j].rgbtRed - SrcPreRow[j - 1].rgbtRed) Div 2; Value := Max(0, Value); Value := Min(255, Value); SrcRow[j].rgbtRed := value; Value := SrcRow[j].rgbtGreen + (SrcRow[j].rgbtGreen - SrcPreRow[j - 1].rgbtGreen) Div 2; Value := Max(0, Value); Value := Min(255, Value); SrcRow[j].rgbtGreen := value; Value := SrcRow[j].rgbtBlue + (SrcRow[j].rgbtBlue - SrcPreRow[j - 1].rgbtBlue) Div 2; Value := Max(0, Value); Value := Min(255, Value); SrcRow[j].rgbtBlue := value; End; // if AProgressBar<>Nil then // AProgressBar.Position:=i; End; End; // Bell filter Function BellFilter(Value: Single): Single; Begin If (Value < 0.0) Then Value := -Value; If (Value < 0.5) Then Result := 0.75 - Sqr(Value) Else If (Value < 1.5) Then Begin Value := Value - 1.5; Result := 0.5 * Sqr(Value); End Else Result := 0.0; End; // Box filter // a.k.a. "Nearest Neighbour" filter // anme: I have not been able to get acceptable // results with this filter for subsampling. Function BoxFilter(Value: Single): Single; Begin If (Value > -0.5) And (Value <= 0.5) Then Result := 1.0 Else Result := 0.0; End; // Hermite filter Function HermiteFilter(Value: Single): Single; Begin // f(t) = 2|t|^3 - 3|t|^2 + 1, -1 <= t <= 1 If (Value < 0.0) Then Value := -Value; If (Value < 1.0) Then Result := (2.0 * Value - 3.0) * Sqr(Value) + 1.0 Else Result := 0.0; End; // Lanczos3 filter Function Lanczos3Filter(Value: Single): Single; Function SinC(Value: Single): Single; Begin If (Value <> 0.0) Then Begin Value := Value * Pi; Result := sin(Value) / Value End Else Result := 1.0; End; Begin If (Value < 0.0) Then Value := -Value; If (Value < 3.0) Then Result := SinC(Value) * SinC(Value / 3.0) Else Result := 0.0; End; Function MitchellFilter(Value: Single): Single; Const B = (1.0 / 3.0); C = (1.0 / 3.0); Var tt: single; Begin If (Value < 0.0) Then Value := -Value; tt := Sqr(Value); If (Value < 1.0) Then Begin Value := (((12.0 - 9.0 * B - 6.0 * C) * (Value * tt)) + ((-18.0 + 12.0 * B + 6.0 * C) * tt) + (6.0 - 2 * B)); Result := Value / 6.0; End Else If (Value < 2.0) Then Begin Value := (((-1.0 * B - 6.0 * C) * (Value * tt)) + ((6.0 * B + 30.0 * C) * tt) + ((-12.0 * B - 48.0 * C) * Value) + (8.0 * B + 24 * C)); Result := Value / 6.0; End Else Result := 0.0; End; // B-spline filter Function SplineFilter(Value: Single): Single; Var tt: single; Begin If (Value < 0.0) Then Value := -Value; If (Value < 1.0) Then Begin tt := Sqr(Value); Result := 0.5 * tt * Value - tt + 2.0 / 3.0; End Else If (Value < 2.0) Then Begin Value := 2.0 - Value; Result := 1.0 / 6.0 * Sqr(Value) * Value; End Else Result := 0.0; End; // Triangle filter // a.k.a. "Linear" or "Bilinear" filter Function TriangleFilter(Value: Single): Single; Begin If (Value < 0.0) Then Value := -Value; If (Value < 1.0) Then Result := 1.0 - Value Else Result := 0.0; End; Function IntToByte(i: Integer): Byte; Begin If i > 255 Then Result := 255 Else If i < 0 Then Result := 0 Else Result := i; End; Procedure AddColorNoise(Var clip: tbitmap; Amount: Integer); Var p0: pbytearray; x, y, r, g, b: Integer; Begin For y := 0 To clip.Height - 1 Do Begin p0 := clip.ScanLine[y]; For x := 0 To clip.Width - 1 Do Begin r := p0[x * 3] + (Random(Amount) - (Amount Shr 1)); g := p0[x * 3 + 1] + (Random(Amount) - (Amount Shr 1)); b := p0[x * 3 + 2] + (Random(Amount) - (Amount Shr 1)); p0[x * 3] := IntToByte(r); p0[x * 3 + 1] := IntToByte(g); p0[x * 3 + 2] := IntToByte(b); End; End; End; Procedure AddMonoNoise(Var clip: tbitmap; Amount: Integer); Var p0: pbytearray; x, y, a, r, g, b: Integer; Begin For y := 0 To clip.Height - 1 Do Begin p0 := clip.scanline[y]; For x := 0 To clip.Width - 1 Do Begin a := Random(Amount) - (Amount Shr 1); r := p0[x * 3] + a; g := p0[x * 3 + 1] + a; b := p0[x * 3 + 2] + a; p0[x * 3] := IntToByte(r); p0[x * 3 + 1] := IntToByte(g); p0[x * 3 + 2] := IntToByte(b); End; End; End; Procedure SoftnessBlur(clip: tbitmap; Amount: Integer); Var i: integer; Begin For i := 1 To Amount Do AntiAlias(clip); End; Procedure AntiAlias(clip: tbitmap); Begin AntiAliasRect(clip, 0, 0, clip.width, clip.height); End; Procedure AntiAliasRect(clip: tbitmap; XOrigin, YOrigin, XFinal, YFinal: Integer); Var Memo, x, y: Integer; (* Composantes primaires des points environnants *) p0, p1, p2: pbytearray; Begin If XFinal < XOrigin Then Begin Memo := XOrigin; XOrigin := XFinal; XFinal := Memo; End; (* Inversion des valeurs *) If YFinal < YOrigin Then Begin Memo := YOrigin; YOrigin := YFinal; YFinal := Memo; End; (* si diffrence ngative*) XOrigin := max(1, XOrigin); YOrigin := max(1, YOrigin); XFinal := min(clip.width - 2, XFinal); YFinal := min(clip.height - 2, YFinal); clip.PixelFormat := pf24bit; For y := YOrigin To YFinal Do Begin p0 := clip.ScanLine[y - 1]; p1 := clip.scanline[y]; p2 := clip.ScanLine[y + 1]; For x := XOrigin To XFinal Do Begin p1[x * 3] := (p0[x * 3] + p2[x * 3] + p1[(x - 1) * 3] + p1[(x + 1) * 3]) Div 4; p1[x * 3 + 1] := (p0[x * 3 + 1] + p2[x * 3 + 1] + p1[(x - 1) * 3 + 1] + p1[(x + 1) * 3 + 1]) Div 4; p1[x * 3 + 2] := (p0[x * 3 + 2] + p2[x * 3 + 2] + p1[(x - 1) * 3 + 2] + p1[(x + 1) * 3 + 2]) Div 4; End; End; End; Procedure Contrast(Var clip: tbitmap; Amount: Integer); Var p0: pbytearray; rg, gg, bg, r, g, b, x, y: Integer; Begin For y := 0 To clip.Height - 1 Do Begin p0 := clip.scanline[y]; For x := 0 To clip.Width - 1 Do Begin r := p0[x * 3]; g := p0[x * 3 + 1]; b := p0[x * 3 + 2]; rg := (Abs(127 - r) * Amount) Div 255; gg := (Abs(127 - g) * Amount) Div 255; bg := (Abs(127 - b) * Amount) Div 255; If r > 127 Then r := r + rg Else r := r - rg; If g > 127 Then g := g + gg Else g := g - gg; If b > 127 Then b := b + bg Else b := b - bg; p0[x * 3] := IntToByte(r); p0[x * 3 + 1] := IntToByte(g); p0[x * 3 + 2] := IntToByte(b); End; End; End; Procedure FishEye(Bmp, Dst: TBitmap; Amount: Extended); Var xmid, ymid: Single; fx, fy: Single; r1, r2: Single; ifx, ify: integer; dx, dy: Single; rmax: Single; ty, tx: Integer; weight_x, weight_y: Array[0..1] Of Single; weight: Single; new_red, new_green: Integer; new_blue: Integer; total_red, total_green: Single; total_blue: Single; ix, iy: Integer; sli, slo: PByteArray; Begin xmid := Bmp.Width / 2; ymid := Bmp.Height / 2; rmax := Dst.Width * Amount; For ty := 0 To Dst.Height - 1 Do Begin For tx := 0 To Dst.Width - 1 Do Begin dx := tx - xmid; dy := ty - ymid; r1 := Sqrt(dx * dx + dy * dy); If r1 = 0 Then Begin fx := xmid; fy := ymid; End Else Begin r2 := rmax / 2 * (1 / (1 - r1 / rmax) - 1); fx := dx * r2 / r1 + xmid; fy := dy * r2 / r1 + ymid; End; ify := Trunc(fy); ifx := Trunc(fx); // Calculate the weights. If fy >= 0 Then Begin weight_y[1] := fy - ify; weight_y[0] := 1 - weight_y[1]; End Else Begin weight_y[0] := -(fy - ify); weight_y[1] := 1 - weight_y[0]; End; If fx >= 0 Then Begin weight_x[1] := fx - ifx; weight_x[0] := 1 - weight_x[1]; End Else Begin weight_x[0] := -(fx - ifx); Weight_x[1] := 1 - weight_x[0]; End; If ifx < 0 Then ifx := Bmp.Width - 1 - (-ifx Mod Bmp.Width) Else If ifx > Bmp.Width - 1 Then ifx := ifx Mod Bmp.Width; If ify < 0 Then ify := Bmp.Height - 1 - (-ify Mod Bmp.Height) Else If ify > Bmp.Height - 1 Then ify := ify Mod Bmp.Height; total_red := 0.0; total_green := 0.0; total_blue := 0.0; For ix := 0 To 1 Do Begin For iy := 0 To 1 Do Begin If ify + iy < Bmp.Height Then sli := Bmp.scanline[ify + iy] Else sli := Bmp.scanline[Bmp.Height - ify - iy]; If ifx + ix < Bmp.Width Then Begin new_red := sli[(ifx + ix) * 3]; new_green := sli[(ifx + ix) * 3 + 1]; new_blue := sli[(ifx + ix) * 3 + 2]; End Else Begin new_red := sli[(Bmp.Width - ifx - ix) * 3]; new_green := sli[(Bmp.Width - ifx - ix) * 3 + 1]; new_blue := sli[(Bmp.Width - ifx - ix) * 3 + 2]; End; weight := weight_x[ix] * weight_y[iy]; total_red := total_red + new_red * weight; total_green := total_green + new_green * weight; total_blue := total_blue + new_blue * weight; End; End; slo := Dst.scanline[ty]; slo[tx * 3] := Round(total_red); slo[tx * 3 + 1] := Round(total_green); slo[tx * 3 + 2] := Round(total_blue); End; End; End; Procedure GaussianBlur(Var clip: tbitmap; Amount: integer); Var i: Integer; Begin For i := Amount Downto 0 Do SplitBlur(clip, 3); End; Procedure Grayscale1(Var Bitmap: TBi ... ...

近期下载者：

相关文件：

评论：[我要评论] [举报此文件]

收藏者：