| 1,40 → 1,13 |
|---|
| {*******************************************************} |
| { } |
| { DIB and PAINTBOX componets } |
| { } |
| { Copyright (C) 1997-2000 Hiroyuki Hori } |
| { base components and effects } |
| { Copyright (C) 2000 Keith Murray } |
| { supernova effect } |
| { Copyright (C) 2000 Michel Hibon } |
| { new special effects added for DIB } |
| { Copyright (C) 2001 Joakim Back } |
| { conFusion effects (as DxFusion) } |
| { Copyright (C) 2003 Babak Sateli } |
| { 24-bit DIB effect as supplement ones } |
| { Copyright (C) 2004-2012 Jaro Benes } |
| { 32-bit DIB effect with alphachannel } |
| { direct works with texture buffer } |
| { modified and adapted all adopted functions } |
| { } |
| {*******************************************************} |
| |
| unit DIB; |
| |
| interface |
| |
| {$INCLUDE DelphiXcfg.inc} |
| {$DEFINE USE_SCANLINE} |
| |
| uses |
| Windows, SysUtils, Classes, Graphics, Controls, |
| {$IFDEF VER17UP} Types, UITypes,{$ENDIF} |
| Math; |
| Windows, SysUtils, Classes, Graphics, Controls; |
| |
| type |
| TColorLineStyle = (csSolid, csGradient, csRainbow); |
| TColorLinePixelGeometry = (pgPoint, pgCircular, pgRectangular); |
| PRGBQuads = ^TRGBQuads; |
| TRGBQuads = array[0..255] of TRGBQuad; |
| |
| TPaletteEntries = array[0..255] of TPaletteEntry; |
| 44,16 → 17,6 |
|---|
| B, G, R: Byte; |
| end; |
| |
| { Added this type for New SPecial Effect } |
| TFilter = array[0..2, 0..2] of SmallInt; |
| TLines = array[0..0] of TBGR; |
| PLines = ^TLines; |
| TBytes = array[0..0] of Byte; |
| PBytes = ^TBytes; |
| TPBytes = array[0..0] of PBytes; |
| PPBytes = ^TPBytes; |
| { End of type's } |
| |
| PArrayBGR = ^TArrayBGR; |
| TArrayBGR = array[0..10000] of TBGR; |
| |
| 66,7 → 29,7 |
|---|
| PArrayDWord = ^TArrayDWord; |
| TArrayDWord = array[0..10000] of DWord; |
| |
| { TDIBPixelFormat } |
| { TDIB } |
| |
| TDIBPixelFormat = record |
| RBitMask, GBitMask, BBitMask: DWORD; |
| 75,8 → 38,6 |
|---|
| RBitCount2, GBitCount2, BBitCount2: DWORD; |
| end; |
| |
| { TDIBSharedImage } |
| |
| TDIBSharedImage = class(TSharedImage) |
| private |
| FBitCount: Integer; |
| 103,7 → 64,7 |
|---|
| constructor Create; |
| procedure NewImage(AWidth, AHeight, ABitCount: Integer; |
| const PixelFormat: TDIBPixelFormat; const ColorTable: TRGBQuads; MemoryImage, Compressed: Boolean); |
| procedure Duplicate(Source: TDIBSharedImage; MemoryImage: Boolean); {$IFDEF VER9UP}inline;{$ENDIF} |
| procedure Duplicate(Source: TDIBSharedImage; MemoryImage: Boolean); |
| procedure Compress(Source: TDIBSharedImage); |
| procedure Decompress(Source: TDIBSharedImage; MemoryImage: Boolean); |
| procedure ReadData(Stream: TStream; MemoryImage: Boolean); |
| 115,33 → 76,6 |
|---|
| destructor Destroy; override; |
| end; |
| |
| { TFilterTypeResample } |
| |
| TFilterTypeResample = (ftrBox, ftrTriangle, ftrHermite, ftrBell, ftrBSpline, |
| ftrLanczos3, ftrMitchell); |
| |
| TDistortType = (dtFast, dtSlow); |
| {DXFusion effect type} |
| TFilterMode = (fmNormal, fmMix50, fmMix25, fmMix75); |
| |
| { TLightSource } |
| |
| TLightSource = record |
| X, Y: Integer; |
| Size1, Size2: Integer; |
| Color: TColor; |
| end; |
| |
| { TLightArray } |
| |
| TLightArray = array{$IFNDEF VER4UP} [0..0]{$ENDIF} of TLightsource; |
| |
| { TMatrixSetting } |
| |
| TMatrixSetting = array[0..9] of Integer; |
| |
| { TDIB } |
| |
| TDIB = class(TGraphic) |
| private |
| FCanvas: TCanvas; |
| 162,10 → 96,6 |
|---|
| FTopPBits: Pointer; |
| FWidth: Integer; |
| FWidthBytes: Integer; |
| FLUTDist: array[0..255, 0..255] of Integer; |
| LG_COUNT: Integer; |
| LG_DETAIL: Integer; |
| FFreeList: TList; |
| procedure AllocHandle; |
| procedure CanvasChanging(Sender: TObject); |
| procedure Changing(MemoryImage: Boolean); |
| 183,28 → 113,15 |
|---|
| function GetTopPBits: Pointer; |
| function GetTopPBitsReadOnly: Pointer; |
| procedure SetBitCount(Value: Integer); |
| procedure SetImage(Value: TDIBSharedImage); {$IFDEF VER9UP}inline;{$ENDIF} |
| procedure SetImage(Value: TDIBSharedImage); |
| procedure SetNowPixelFormat(const Value: TDIBPixelFormat); |
| procedure SetPixel(X, Y: Integer; Value: DWORD); |
| procedure StartProgress(const Name: string); |
| procedure EndProgress; |
| procedure UpdateProgress(PercentY: Integer); |
| |
| { Added these 3 functions for New Specials Effects } |
| function Interval(iMin, iMax, iValue: Integer; iMark: Boolean): Integer; {$IFDEF VER9UP}inline;{$ENDIF} |
| function IntToByte(i: Integer): Byte; {$IFDEF VER9UP}inline;{$ENDIF} |
| function TrimInt(i, Min, Max: Integer): Integer; {$IFDEF VER9UP}inline;{$ENDIF} |
| { End of 3 functions for New Special Effect } |
| |
| procedure Darkness(Amount: Integer); |
| function GetAlphaChannel: TDIB; |
| procedure SetAlphaChannel(const Value: TDIB); |
| function GetClientRect: TRect; |
| function GetRGBChannel: TDIB; |
| procedure SetRGBChannel(const Value: TDIB); |
| protected |
| procedure DefineProperties(Filer: TFiler); override; |
| procedure Draw(ACanvas: TCanvas; const ARect: TRect); override; |
| procedure Draw(ACanvas: TCanvas; const Rect: TRect); override; |
| function GetEmpty: Boolean; override; |
| function GetHeight: Integer; override; |
| function GetPalette: HPalette; override; |
| 224,9 → 141,6 |
|---|
| procedure Compress; |
| procedure Decompress; |
| procedure FreeHandle; |
| function HasAlphaChannel: Boolean; |
| function AssignAlphaChannel(ALPHA: TDIB; ForceResize: Boolean{$IFDEF VER4UP} = False{$ENDIF}): Boolean; |
| procedure RetAlphaChannel(out oDIB: TDIB); |
| procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle; |
| APalette: HPALETTE); override; |
| procedure LoadFromStream(Stream: TStream); override; |
| 233,7 → 147,7 |
|---|
| procedure SaveToClipboardFormat(var AFormat: Word; var AData: THandle; |
| var APalette: HPALETTE); override; |
| procedure SaveToStream(Stream: TStream); override; |
| procedure SetSize(AWidth, AHeight, ABitCount: Integer); {$IFDEF VER5UP}reintroduce;{$ENDIF} //{$IFDEF VER9UP} overload;{$ENDIF} |
| procedure SetSize(AWidth, AHeight, ABitCount: Integer); |
| procedure UpdatePalette; |
| { Special effect } |
| procedure Blur(ABitCount: Integer; Radius: Integer); |
| 241,160 → 155,6 |
|---|
| procedure Mirror(MirrorX, MirrorY: Boolean); |
| procedure Negative; |
| |
| { Added New Special Effect } |
| procedure Spray(Amount: Integer); |
| procedure Emboss; |
| procedure AddMonoNoise(Amount: Integer); |
| procedure AddGradiantNoise(Amount: byte); |
| function Twist(bmp: TDIB; Amount: byte): Boolean; |
| function FishEye(bmp: TDIB): Boolean; |
| function SmoothRotateWrap(Bmp: TDIB; cx, cy: Integer; Degree: Extended): Boolean; |
| procedure Lightness(Amount: Integer); |
| procedure Saturation(Amount: Integer); |
| procedure Contrast(Amount: Integer); |
| procedure AddRGB(aR, aG, aB: Byte); |
| function Filter(Dest: TDIB; Filter: TFilter): Boolean; |
| procedure Sharpen(Amount: Integer); |
| function IntToColor(i: Integer): TBGR; {$IFDEF VER9UP}inline;{$ENDIF} |
| function Rotate(Dst: TDIB; cx, cy: Integer; Angle: Double): Boolean; |
| procedure SplitBlur(Amount: Integer); |
| procedure GaussianBlur(Bmp: TDIB; Amount: Integer); |
| { End of New Special Effect } |
| { |
| New effect for TDIB |
| with Some Effects like AntiAlias, Contrast, |
| Lightness, Saturation, GaussianBlur, Mosaic, |
| Twist, Splitlight, Trace, Emboss, etc. |
| Works with 24bit color DIBs. |
| |
| This component is based on TProEffectImage component version 1.0 by |
| Written By Babak Sateli (babak_sateli@yahoo.com, http://raveland.netfirms.com) |
| |
| and modified by (c) 2004 Jaro Benes |
| for DelphiX use. |
| |
| Demo was modified into DXForm with function like original |
| |
| DISCLAIMER |
| This component is provided AS-IS without any warranty of any kind, either express or |
| implied. This component is freeware and can be used in any software product. |
| } |
| procedure DoInvert; |
| procedure DoAddColorNoise(Amount: Integer); |
| procedure DoAddMonoNoise(Amount: Integer); |
| procedure DoAntiAlias; |
| procedure DoContrast(Amount: Integer); |
| procedure DoFishEye(Amount: Integer); |
| procedure DoGrayScale; |
| procedure DoLightness(Amount: Integer); |
| procedure DoDarkness(Amount: Integer); |
| procedure DoSaturation(Amount: Integer); |
| procedure DoSplitBlur(Amount: Integer); |
| procedure DoGaussianBlur(Amount: Integer); |
| procedure DoMosaic(Size: Integer); |
| procedure DoTwist(Amount: Integer); |
| procedure DoSplitlight(Amount: Integer); |
| procedure DoTile(Amount: Integer); |
| procedure DoSpotLight(Amount: Integer; Spot: TRect); |
| procedure DoTrace(Amount: Integer); |
| procedure DoEmboss; |
| procedure DoSolorize(Amount: Integer); |
| procedure DoPosterize(Amount: Integer); |
| procedure DoBrightness(Amount: Integer); |
| procedure DoResample(AmountX, AmountY: Integer; TypeResample: TFilterTypeResample); |
| {rotate} |
| procedure DoSmoothRotate(Src: TDIB; cx, cy: Integer; Angle: Extended); |
| procedure DoColorize(ForeColor, BackColor: TColor); |
| {Simple explosion spoke effect} |
| procedure DoNovaEffect(sr, sg, sb, cx, cy, radius, |
| nspokes, randomhue, randomspok, randgauss: Integer; onProgress: TProgressEvent); |
| |
| {Simple Mandelbrot-set drawing} |
| procedure DrawMandelbrot(ao, au: Integer; bo, bu: Double); |
| |
| {Sephia effect} |
| procedure SephiaEffect(Depth: Integer{$IFDEF VER4UP} = 20{$ENDIF}); |
| |
| {Simple blend pixel} |
| procedure BlendPixel(const X, Y: Integer; aColor: Cardinal; Alpha: Byte); {$IFDEF VER9UP}inline;{$ENDIF} |
| {Line in polar system} |
| procedure LinePolar(x, y: Integer; AngleInDegree, Length: extended; |
| Color: cardinal); |
| |
| {special version Dark/Light procedure in percent} |
| procedure Darker(Percent: Integer); |
| procedure Lighter(Percent: Integer); |
| |
| {Simple graphical crypt} |
| procedure EncryptDecrypt(const Key: Integer); |
| |
| { Standalone DXFusion } |
| {--- c o n F u s i o n ---} |
| {By Joakim Back, www.back.mine.nu} |
| {Huge thanks to Ilkka Tuomioja for helping out with the project.} |
| |
| { |
| modified by (c) 2005 Jaro Benes for DelphiX use. |
| } |
| |
| procedure CreateDIBFromBitmap(const Bitmap: TBitmap); |
| {Drawing Methods.} |
| procedure DrawOn(Dest: TRect; DestCanvas: TCanvas; |
| Xsrc, Ysrc: Integer); |
| procedure DrawTo(SrcDIB: TDIB; X, Y, Width, Height, SourceX, |
| SourceY: Integer); |
| procedure DrawTransparent(SrcDIB: TDIB; const X, Y, Width, Height, |
| SourceX, SourceY: Integer; const Color: TColor); {$IFDEF VER5UP} reintroduce;{$ENDIF} //{$IFDEF VER9UP} overload;{$ENDIF} |
| procedure DrawShadow(SrcDIB: TDIB; X, Y, Width, Height, Frame: Integer; |
| FilterMode: TFilterMode); |
| procedure DrawShadows(SrcDIB: TDIB; X, Y, Width, Height, Frame: Integer; |
| Alpha: Byte); |
| procedure DrawDarken(SrcDIB: TDIB; X, Y, Width, Height, |
| Frame: Integer); |
| procedure DrawAdditive(SrcDIB: TDIB; X, Y, Width, Height: Integer; Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF}; |
| Frame: Integer{$IFDEF VER4UP} = 0{$ENDIF}); |
| procedure DrawQuickAlpha(SrcDIB: TDIB; const X, Y, Width, Height, |
| SourceX, SourceY: Integer; const Color: TColor; |
| FilterMode: TFilterMode); |
| procedure DrawTranslucent(SrcDIB: TDIB; const X, Y, Width, Height, |
| SourceX, SourceY: Integer; const Color: TColor); |
| procedure DrawMorphed(SrcDIB: TDIB; const X, Y, Width, Height, SourceX, |
| SourceY: Integer; const Color: TColor); |
| procedure DrawAlpha(SrcDIB: TDIB; const X, Y, Width, Height, SourceX, |
| SourceY, Alpha: Integer; const Color: TColor); |
| procedure DrawAlphaMask(SrcDIB, MaskDIB: TDIB; const X, Y, Width, |
| Height, SourceX, SourceY: Integer); |
| procedure DrawAntialias(SrcDIB: TDIB); |
| procedure Draw3x3Matrix(SrcDIB: TDIB; Setting: TMatrixSetting); |
| procedure DrawMono(SrcDIB: TDIB; const X, Y, Width, Height, SourceX, |
| SourceY: Integer; const TransColor, ForeColor, BackColor: TColor); |
| {One-color Filters.} |
| procedure FilterLine(X1, Y1, X2, Y2: Integer; Color: TColor; |
| FilterMode: TFilterMode); {$IFDEF VER9UP}inline;{$ENDIF} |
| procedure FilterRect(X, Y, Width, Height: Integer; Color: TColor; |
| FilterMode: TFilterMode); {$IFDEF VER9UP}inline;{$ENDIF} |
| { Lightsource. } |
| procedure InitLight(Count, Detail: Integer); |
| procedure DrawLights(FLight: TLightArray; AmbientLight: TColor); |
| // |
| // effect for special purpose |
| // |
| procedure FadeOut(DIB2: TDIB; Step: Byte); |
| procedure DoZoom(DIB2: TDIB; ZoomRatio: Real); |
| procedure DoBlur(DIB2: TDIB); |
| procedure FadeIn(DIB2: TDIB; Step: Byte); |
| procedure FillDIB8(Color: Byte); |
| procedure DoRotate(DIB1: TDIB; cX, cY, Angle: Integer); |
| procedure Distort(DIB1: TDIB; dt: TDistortType; cX, cY, Angle: Integer; Factor: Real); |
| function Ink(DIB: TDIB; const SprayInit: Boolean; const AmountSpray: Integer): Boolean; |
| // lines |
| procedure AntialiasedLine(x1, y1, x2, y2: Integer; color: TColor); {$IFDEF VER9UP} inline; {$ENDIF} |
| function GetColorBetween(StartColor, EndColor: TColor; Pointvalue, |
| FromPoint, ToPoint: Extended): TColor; |
| procedure ColoredLine(const iStart, iEnd: TPoint; iColorStyle: TColorLineStyle; |
| iGradientFrom, iGradientTo: TColor; iPixelGeometry: TColorLinePixelGeometry; |
| iRadius: WORD); |
| // standard property |
| property BitCount: Integer read FBitCount write SetBitCount; |
| property BitmapInfo: PBitmapInfo read GetBitmapInfo; |
| property BitmapInfoSize: Integer read GetBitmapInfoSize; |
| 414,15 → 174,8 |
|---|
| property TopPBitsReadOnly: Pointer read GetTopPBitsReadOnly; |
| property Width: Integer read FWidth write SetWidth; |
| property WidthBytes: Integer read FWidthBytes; |
| property AlphaChannel: TDIB read GetAlphaChannel write SetAlphaChannel; |
| property RGBChannel: TDIB read GetRGBChannel write SetRGBChannel; |
| function CreateBitmapFromDIB: TBitmap; |
| procedure Fill(aColor: TColor); |
| property ClientRect: TRect read GetClientRect; |
| end; |
| |
| { TDIBitmap } |
| |
| TDIBitmap = class(TDIB) end; |
| |
| { TCustomDXDIB } |
| 482,10 → 235,10 |
|---|
| |
| TDXPaintBox = class(TCustomDXPaintBox) |
| published |
| {$IFDEF VER4UP}property Anchors; {$ENDIF} |
| {$IFDEF DelphiX_Spt4}property Anchors;{$ENDIF} |
| property AutoStretch; |
| property Center; |
| {$IFDEF VER4UP}property Constraints; {$ENDIF} |
| {$IFDEF DelphiX_Spt4}property Constraints;{$ENDIF} |
| property DIB; |
| property KeepAspect; |
| property Stretch; |
| 508,105 → 261,34 |
|---|
| property OnMouseDown; |
| property OnMouseMove; |
| property OnMouseUp; |
| {$IFDEF VER9UP}property OnMouseWheel; {$ENDIF} |
| {$IFDEF VER9UP}property OnResize; {$ENDIF} |
| {$IFDEF VER9UP}property OnCanResize; {$ENDIF} |
| {$IFDEF VER9UP}property OnContextPopup; {$ENDIF} |
| property OnStartDrag; |
| end; |
| |
| const |
| DefaultFilterRadius: array[TFilterTypeResample] of Single = (0.5, 1, 1, 1.5, 2, 3, 2); |
| function MakeDIBPixelFormat(RBitCount, GBitCount, BBitCount: Integer): TDIBPixelFormat; |
| function MakeDIBPixelFormatMask(RBitMask, GBitMask, BBitMask: Integer): TDIBPixelFormat; |
| function pfRGB(const PixelFormat: TDIBPixelFormat; R, G, B: Byte): DWORD; |
| procedure pfGetRGB(const PixelFormat: TDIBPixelFormat; Color: DWORD; var R, G, B: Byte); |
| function pfGetRValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte; |
| function pfGetGValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte; |
| function pfGetBValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte; |
| |
| function MakeDIBPixelFormat(RBitCount, GBitCount, BBitCount: Integer): TDIBPixelFormat; {$IFDEF VER9UP}inline;{$ENDIF} |
| function MakeDIBPixelFormatMask(RBitMask, GBitMask, BBitMask: Integer): TDIBPixelFormat; {$IFDEF VER9UP}inline;{$ENDIF} |
| function pfRGB(const PixelFormat: TDIBPixelFormat; R, G, B: Byte): DWORD; {$IFDEF VER9UP}inline;{$ENDIF} |
| procedure pfGetRGB(const PixelFormat: TDIBPixelFormat; Color: DWORD; var R, G, B: Byte); {$IFDEF VER9UP}inline;{$ENDIF} |
| function pfGetRValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte; {$IFDEF VER9UP}inline;{$ENDIF} |
| function pfGetGValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte; {$IFDEF VER9UP}inline;{$ENDIF} |
| function pfGetBValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte; {$IFDEF VER9UP}inline;{$ENDIF} |
| |
| function GreyscaleColorTable: TRGBQuads; |
| |
| function RGBQuad(R, G, B: Byte): TRGBQuad; {$IFDEF VER9UP}inline;{$ENDIF} |
| function PaletteEntryToRGBQuad(const Entry: TPaletteEntry): TRGBQuad; {$IFDEF VER9UP}inline;{$ENDIF} |
| function PaletteEntriesToRGBQuads(const Entries: TPaletteEntries): TRGBQuads; {$IFDEF VER9UP}inline;{$ENDIF} |
| function RGBQuadToPaletteEntry(const RGBQuad: TRGBQuad): TPaletteEntry; {$IFDEF VER9UP}inline;{$ENDIF} |
| function RGBQuadsToPaletteEntries(const RGBQuads: TRGBQuads): TPaletteEntries; {$IFDEF VER9UP}inline;{$ENDIF} |
| function RGBQuad(R, G, B: Byte): TRGBQuad; |
| function PaletteEntryToRGBQuad(const Entry: TPaletteEntry): TRGBQuad; |
| function PaletteEntriesToRGBQuads(const Entries: TPaletteEntries): TRGBQuads; |
| function RGBQuadToPaletteEntry(const RGBQuad: TRGBQuad): TPaletteEntry; |
| function RGBQuadsToPaletteEntries(const RGBQuads: TRGBQuads): TPaletteEntries; |
| |
| function PosValue(Value: Integer): Integer; |
| |
| type |
| TOC = 0..511; |
| function DSin(const C: TOC): Single; {$IFDEF VER9UP}inline; {$ENDIF} |
| function DCos(const C: TOC): Single; {$IFDEF VER9UP}inline; {$ENDIF} |
| |
| { Added Constants for TFilter Type } |
| const |
| EdgeFilter: TFilter = ((-1, -1, -1), (-1, 8, -1), (-1, -1, -1)); |
| StrongOutlineFilter: TFilter = ((-100, 0, 0), (0, 0, 0), (0, 0, 100)); |
| Enhance3DFilter: TFilter = ((-100, 5, 5), (5, 5, 5), (5, 5, 100)); |
| LinearFilter: TFilter = ((-40, -40, -40), (-40, 255, -40), (-40, -40, -40)); |
| GranularFilter: TFilter = ((-20, 5, 20), (5, -10, 5), (100, 5, -100)); |
| SharpFilter: TFilter = ((-2, -2, -2), (-2, 20, -2), (-2, -2, -2)); |
| { End of constants } |
| |
| { Added Constants for DXFusion Type } |
| const |
| { 3x3 Matrix Presets. } |
| msEmboss: TMatrixSetting = (-1, -1, 0, -1, 6, 1, 0, 1, 1, 6); |
| msHardEmboss: TMatrixSetting = (-4, -2, -1, -2, 10, 2, -1, 2, 4, 8); |
| msBlur: TMatrixSetting = (1, 2, 1, 2, 4, 2, 1, 2, 1, 16); |
| msSharpen: TMatrixSetting = (-1, -1, -1, -1, 15, -1, -1, -1, -1, 7); |
| msEdgeDetect: TMatrixSetting = (-1, -1, -1, -1, 8, -1, -1, -1, -1, 1); |
| |
| {Proportionaly scale of size, for recountin image sizes} |
| function GetScale(SourceWidth, SourceHeight, TargetWidth, TargetHeight: Integer): Single; {$IFDEF VER9UP}inline;{$ENDIF} |
| |
| procedure MakeDib(out DIB: TDIB; const iWidth, iHeight, iBitCount: Integer; iFillColor: TColor{$IFDEF VER4UP} = clBlack{$ENDIF}); {$IFDEF VER4UP}overload; {$ENDIF} |
| procedure{$IFDEF VER4UP}MakeDib{$ELSE}MakeDIB2{$ENDIF}(out DIB: TDIB; iBitmap: TBitmap); {$IFDEF VER4UP}overload; {$ENDIF} |
| |
| implementation |
| |
| uses DXConsts, {$IFDEF PNG_GRAPHICS}pngimage,{$ENDIF} jpeg; |
| uses DXConsts; |
| |
| function GetScale(SourceWidth, SourceHeight, TargetWidth, TargetHeight: Integer): Single; |
| var |
| XScale, YScale: Single; |
| begin |
| XScale := 1; |
| YScale := 1; |
| if TargetWidth < SourceWidth then |
| XScale := TargetWidth / SourceWidth; |
| if TargetHeight < SourceHeight then |
| YScale := TargetHeight / SourceHeight; |
| Result := XScale; |
| if YScale < Result then |
| Result := YScale; |
| end; |
| |
| {$IFNDEF VER4UP} |
| function Max(B1, B2: Integer): Integer; |
| begin |
| if B1 >= B2 then Result := B1 else Result := B2; |
| end; |
| |
| function Min(B1, B2: Integer): Integer; |
| begin |
| if B1 <= B2 then Result := B1 else Result := B2; |
| end; |
| {$ENDIF} |
| |
| function DSin(const C: TOC): Single; {$IFDEF VER9UP}inline; {$ENDIF} |
| begin |
| Result := sin(((c * 360) / 511) * Pi / 180); |
| end; |
| |
| function DCos(const C: TOC): Single; {$IFDEF VER9UP}inline; {$ENDIF} |
| begin |
| Result := cos(((c * 360) / 511) * Pi / 180); |
| end; |
| |
| function MakeDIBPixelFormat(RBitCount, GBitCount, BBitCount: Integer): TDIBPixelFormat; |
| begin |
| Result.RBitMask := ((1 shl RBitCount) - 1) shl (GBitCount + BBitCount); |
| 623,7 → 305,9 |
|---|
| Result.BShift := 8 - BBitCount; |
| end; |
| |
| function GetBitCount(b: Integer): Integer; {$IFDEF VER9UP}inline;{$ENDIF} |
| function MakeDIBPixelFormatMask(RBitMask, GBitMask, BBitMask: Integer): TDIBPixelFormat; |
| |
| function GetBitCount(b: Integer): Integer; |
| var |
| i: Integer; |
| begin |
| 638,7 → 322,6 |
|---|
| end; |
| end; |
| |
| function MakeDIBPixelFormatMask(RBitMask, GBitMask, BBitMask: Integer): TDIBPixelFormat; |
| begin |
| Result := MakeDIBPixelFormat(GetBitCount(RBitMask), GetBitCount(GBitMask), |
| GetBitCount(BBitMask)); |
| 669,7 → 352,7 |
|---|
| with PixelFormat do |
| begin |
| Result := (Color and RBitMask) shr RShift; |
| Result := Result or (Result shr RBitCount2); |
| Result := Result or (Result shr RBitCount); |
| end; |
| end; |
| |
| 678,7 → 361,7 |
|---|
| with PixelFormat do |
| begin |
| Result := (Color and GBitMask) shr GShift; |
| Result := Result or (Result shr GBitCount2); |
| Result := Result or (Result shr GBitCount); |
| end; |
| end; |
| |
| 687,7 → 370,7 |
|---|
| with PixelFormat do |
| begin |
| Result := (Color and BBitMask) shl BShift; |
| Result := Result or (Result shr BBitCount2); |
| Result := Result or (Result shr BBitCount); |
| end; |
| end; |
| |
| 764,8 → 447,6 |
|---|
| RBitMask, GBitMask, BBitMask: DWORD; |
| end; |
| |
| { TPaletteItem } |
| |
| TPaletteItem = class(TCollectionItem) |
| private |
| ID: Integer; |
| 775,11 → 456,9 |
|---|
| ColorTableCount: Integer; |
| destructor Destroy; override; |
| procedure AddRef; |
| procedure Release; {$IFDEF VER17UP}reintroduce;{$ENDIF} |
| procedure Release; |
| end; |
| |
| { TPaletteManager } |
| |
| TPaletteManager = class |
| private |
| FList: TCollection; |
| 789,8 → 468,6 |
|---|
| procedure DeletePalette(var Palette: HPalette); |
| end; |
| |
| { TPaletteItem } |
| |
| destructor TPaletteItem.Destroy; |
| begin |
| DeleteObject(Palette); |
| 808,8 → 485,6 |
|---|
| if RefCount <= 0 then Free; |
| end; |
| |
| { TPaletteManager } |
| |
| constructor TPaletteManager.Create; |
| begin |
| inherited Create; |
| 902,8 → 577,6 |
|---|
| Result := FPaletteManager; |
| end; |
| |
| { TDIBSharedImage } |
| |
| constructor TDIBSharedImage.Create; |
| begin |
| inherited Create; |
| 919,10 → 592,8 |
|---|
| InfoOfs: Integer; |
| UsePixelFormat: Boolean; |
| begin |
| {$IFNDEF D17UP} |
| {self recreation is not allowed here} |
| Create; |
| {$ENDIF} |
| |
| { Pixel format check } |
| case ABitCount of |
| 1: if not ((PixelFormat.RBitMask = $FF0000) and (PixelFormat.GBitMask = $00FF00) and (PixelFormat.BBitMask = $0000FF)) then |
| 931,19 → 602,16 |
|---|
| raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat); |
| 8: if not ((PixelFormat.RBitMask = $FF0000) and (PixelFormat.GBitMask = $00FF00) and (PixelFormat.BBitMask = $0000FF)) then |
| raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat); |
| 16: |
| begin |
| 16: begin |
| if not (((PixelFormat.RBitMask = $7C00) and (PixelFormat.GBitMask = $03E0) and (PixelFormat.BBitMask = $001F)) or |
| ((PixelFormat.RBitMask = $F800) and (PixelFormat.GBitMask = $07E0) and (PixelFormat.BBitMask = $001F))) then |
| raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat); |
| end; |
| 24: |
| begin |
| 24: begin |
| if not ((PixelFormat.RBitMask = $FF0000) and (PixelFormat.GBitMask = $00FF00) and (PixelFormat.BBitMask = $0000FF)) then |
| raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat); |
| end; |
| 32: |
| begin |
| 32: begin |
| if not ((PixelFormat.RBitMask = $FF0000) and (PixelFormat.GBitMask = $00FF00) and (PixelFormat.BBitMask = $0000FF)) then |
| raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat); |
| end; |
| 1028,8 → 696,7 |
|---|
| FPBits := Pointer(GlobalAlloc(GMEM_FIXED, FSize)); |
| if FPBits = nil then |
| OutOfMemoryError; |
| end |
| else |
| end else |
| begin |
| FDC := CreateCompatibleDC(0); |
| |
| 1046,17 → 713,11 |
|---|
| |
| procedure TDIBSharedImage.Duplicate(Source: TDIBSharedImage; MemoryImage: Boolean); |
| begin |
| if Source = nil then Exit; //no source |
| |
| if Source.FSize = 0 then |
| begin |
| {$IFNDEF D17UP} |
| {self recreation is not allowed here} |
| Create; |
| {$ENDIF} |
| FMemoryImage := MemoryImage; |
| end |
| else |
| end else |
| begin |
| NewImage(Source.FWidth, Source.FHeight, Source.FBitCount, |
| Source.FPixelFormat, Source.FColorTable, MemoryImage, Source.FCompressed); |
| 1065,8 → 726,7 |
|---|
| FBitmapInfo.bmiHeader.biSizeImage := Source.FBitmapInfo.bmiHeader.biSizeImage; |
| GetMem(FPBits, FBitmapInfo.bmiHeader.biSizeImage); |
| Move(Source.FPBits^, FPBits^, FBitmapInfo.bmiHeader.biSizeImage); |
| end |
| else |
| end else |
| begin |
| Move(Source.FPBits^, FPBits^, FBitmapInfo.bmiHeader.biSizeImage); |
| end; |
| 1129,8 → 789,7 |
|---|
| |
| AllocByte^ := B1; |
| AllocByte^ := B2; |
| end |
| else |
| end else |
| if (Source.FWidth - x > 5) and ((GetPixel(x) <> GetPixel(x + 2)) or (GetPixel(x + 1) <> GetPixel(x + 3))) and |
| ((GetPixel(x + 2) = GetPixel(x + 4)) and (GetPixel(x + 3) = GetPixel(x + 5))) then |
| begin |
| 1138,8 → 797,7 |
|---|
| AllocByte^ := 2; |
| AllocByte^ := (GetPixel(x) shl 4) or GetPixel(x + 1); |
| Inc(x, 2); |
| end |
| else |
| end else |
| begin |
| if (Source.FWidth - x < 4) then |
| begin |
| 1157,8 → 815,7 |
|---|
| AllocByte^ := GetPixel(x) shl 4; |
| Inc(x); |
| end; |
| end |
| else |
| end else |
| begin |
| { Absolute mode } |
| PB1 := Size; AllocByte; |
| 1247,8 → 904,7 |
|---|
| |
| AllocByte^ := B1; |
| AllocByte^ := B2; |
| end |
| else |
| end else |
| if (Source.FWidth - x > 2) and (Src^ <> PByte(Integer(Src) + 1)^) and (PByte(Integer(Src) + 1)^ = PByte(Integer(Src) + 2)^) then |
| begin |
| { Encoding mode } |
| 1255,8 → 911,7 |
|---|
| AllocByte^ := 1; |
| AllocByte^ := Src^; Inc(Src); |
| Inc(x); |
| end |
| else |
| end else |
| begin |
| if (Source.FWidth - x < 4) then |
| begin |
| 1269,15 → 924,13 |
|---|
| AllocByte^ := 1; |
| AllocByte^ := Src^; Inc(Src); |
| Inc(x, 2); |
| end |
| else |
| end else |
| begin |
| AllocByte^ := 1; |
| AllocByte^ := Src^; Inc(Src); |
| Inc(x); |
| end; |
| end |
| else |
| end else |
| begin |
| { Absolute mode } |
| PB1 := Size; AllocByte; |
| 1326,8 → 979,7 |
|---|
| begin |
| if Source.FCompressed then |
| Duplicate(Source, Source.FMemoryImage) |
| else |
| begin |
| else begin |
| NewImage(Source.FWidth, Source.FHeight, Source.FBitCount, |
| Source.FPixelFormat, Source.FColorTable, True, True); |
| case FBitmapInfo.bmiHeader.biCompression of |
| 1378,8 → 1030,7 |
|---|
| if i and 1 = 0 then |
| begin |
| C := Src^; Inc(Src); |
| end |
| else |
| end else |
| begin |
| C := C shl 4; |
| end; |
| 1393,8 → 1044,7 |
|---|
| Inc(X); |
| end; |
| end; |
| end |
| else |
| end else |
| begin |
| { Encoding mode } |
| Dest := Pointer(Longint(FPBits) + Y * FWidthBytes); |
| 1451,8 → 1101,7 |
|---|
| { Absolute mode } |
| Move(Src^, Dest^, B2); Inc(Dest, B2); Inc(Src, B2); |
| end; |
| end |
| else |
| end else |
| begin |
| { Encoding mode } |
| FillChar(Dest^, B1, B2); Inc(Dest, B1); |
| 1466,8 → 1115,7 |
|---|
| begin |
| if not Source.FCompressed then |
| Duplicate(Source, MemoryImage) |
| else |
| begin |
| else begin |
| NewImage(Source.FWidth, Source.FHeight, Source.FBitCount, |
| Source.FPixelFormat, Source.FColorTable, MemoryImage, False); |
| case Source.FBitmapInfo.bmiHeader.biCompression of |
| 1488,7 → 1136,6 |
|---|
| procedure LoadRLE4; |
| begin |
| FSize := BI.biSizeImage; |
| //GetMem(FPBits, FSize); |
| FPBits := GlobalAllocPtr(GMEM_FIXED, FSize); |
| FBitmapInfo.bmiHeader.biSizeImage := FSize; |
| Stream.ReadBuffer(FPBits^, FSize); |
| 1497,7 → 1144,6 |
|---|
| procedure LoadRLE8; |
| begin |
| FSize := BI.biSizeImage; |
| //GetMem(FPBits, FSize); |
| FPBits := GlobalAllocPtr(GMEM_FIXED, FSize); |
| FBitmapInfo.bmiHeader.biSizeImage := FSize; |
| Stream.ReadBuffer(FPBits^, FSize); |
| 1511,8 → 1157,7 |
|---|
| begin |
| for y := 0 to Abs(BI.biHeight) - 1 do |
| Stream.ReadBuffer(Pointer(Integer(FTopPBits) + y * FNextLine)^, FWidthBytes); |
| end |
| else |
| end else |
| begin |
| Stream.ReadBuffer(FPBits^, FSize); |
| end; |
| 1525,17 → 1170,12 |
|---|
| AColorTable: TRGBQuads; |
| APixelFormat: TDIBPixelFormat; |
| begin |
| if not Assigned(Stream) then Exit; |
| |
| { Header size reading } |
| i := Stream.Read(BI.biSize, 4); |
| |
| if i = 0 then |
| begin |
| {$IFNDEF D17UP} |
| {self recreation is not allowed here} |
| Create; |
| {$ENDIF} |
| Exit; |
| end; |
| if i <> 4 then |
| 1576,8 → 1216,7 |
|---|
| Stream.ReadBuffer(Localpf, SizeOf(Localpf)); |
| with Localpf do |
| APixelFormat := MakeDIBPixelFormatMask(RBitMask, GBitMask, BBitMask); |
| end |
| else |
| end else |
| begin |
| if BI.biBitCount = 16 then |
| APixelFormat := MakeDIBPixelFormat(5, 5, 5) |
| 1604,14 → 1243,13 |
|---|
| with BCRGB[i] do |
| AColorTable[i] := RGBQuad(rgbtRed, rgbtGreen, rgbtBlue); |
| end; |
| end |
| else |
| end else |
| begin |
| { Windows type } |
| Stream.ReadBuffer(AColorTable, SizeOf(TRGBQuad) * PalCount); |
| end; |
| |
| { DIB compilation } |
| { DIB ì¬ } |
| NewImage(BI.biWidth, Abs(BI.biHeight), BI.biBitCount, APixelFormat, AColorTable, |
| MemoryImage, BI.biCompression in [BI_RLE4, BI_RLE8]); |
| |
| 1632,9 → 1270,7 |
|---|
| begin |
| if FOldHandle <> 0 then SelectObject(FDC, FOldHandle); |
| DeleteObject(FHandle); |
| end |
| else |
| // GlobalFree(THandle(FPBits)); |
| end else |
| begin |
| if FPBits <> nil then |
| GlobalFreePtr(FPBits); |
| 1697,26 → 1333,12 |
|---|
| begin |
| inherited Create; |
| SetImage(EmptyDIBImage); |
| |
| FFreeList := TList.Create; |
| end; |
| |
| destructor TDIB.Destroy; |
| var |
| D: TDIB; |
| begin |
| SetImage(EmptyDIBImage); |
| FCanvas.Free; |
| |
| while FFreeList.Count > 0 do |
| try |
| D := TDIB(FFreeList[0]); |
| FFreeList.Remove(D); |
| D.Free; |
| except |
| end; |
| FFreeList.Free; |
| |
| inherited Destroy; |
| end; |
| |
| 1750,14 → 1372,12 |
|---|
| if DIBSectionRec^.dsBm.bmBitsPixel >= 24 then |
| begin |
| PixelFormat := MakeDIBPixelFormat(8, 8, 8); |
| end |
| else |
| end else |
| if DIBSectionRec^.dsBm.bmBitsPixel > 8 then |
| begin |
| PixelFormat := MakeDIBPixelFormatMask(DIBSectionRec^.dsBitfields[0], //correct I.Ceneff, thanks |
| PixelFormat := MakeDIBPixelFormat(DIBSectionRec^.dsBitfields[0], |
| DIBSectionRec^.dsBitfields[1], DIBSectionRec^.dsBitfields[2]); |
| end |
| else |
| end else |
| begin |
| PixelFormat := MakeDIBPixelFormat(8, 8, 8); |
| end; |
| 1773,64 → 1393,14 |
|---|
| end; |
| |
| procedure AssignGraphic(Source: TGraphic); |
| {$IFDEF PNG_GRAPHICS} |
| var |
| alpha: TDIB; |
| png: {$IFDEF VER12UP}TPngImage{$ELSE}TPNGObject{$ENDIF}; |
| i, j: Integer; |
| q: pByteArray; |
| {$ENDIF} |
| begin |
| {$IFDEF PNG_GRAPHICS} |
| if Source is {$IFDEF VER12UP}TPngImage{$ELSE}TPNGObject{$ENDIF} then |
| begin |
| alpha := TDIB.Create; |
| try |
| {png image} |
| png := {$IFDEF VER12UP}TPngImage{$ELSE}TPNGObject{$ENDIF}.Create; |
| try |
| png.Assign(Source); |
| if png.TransparencyMode = ptmPartial then |
| begin |
| Alpha.SetSize(png.Width, png.Height, 8); |
| {separate alpha} |
| for i := 0 to png.Height - 1 do |
| begin |
| q := png.AlphaScanline[i]; |
| for j := 0 to png.Width - 1 do |
| alpha.Pixels[j,i] := q[j]; |
| end; |
| end; |
| SetSize(png.Width, png.Height, 32); |
| FillChar(PBits^, Size, 0); |
| Canvas.Draw(0, 0, png); |
| Transparent := png.Transparent; |
| finally |
| png.Free; |
| end; |
| if not alpha.Empty then |
| AssignAlphaChannel(alpha); |
| finally |
| alpha.Free; |
| end; |
| end |
| else |
| {$ENDIF} |
| if Source is TBitmap then |
| AssignBitmap(TBitmap(Source)) |
| else |
| begin |
| SetSize(Source.Width, Source.Height, 32); |
| FillChar(PBits^, Size, 0); |
| Canvas.Draw(0, 0, Source); |
| Transparent := Source.Transparent; |
| if not HasAlphaChannel then |
| begin |
| SetSize(Source.Width, Source.Height, 24); |
| FillChar(PBits^, Size, 0); |
| Canvas.Draw(0, 0, Source); |
| Transparent := Source.Transparent; |
| end |
| end; |
| end; |
| |
| 1855,7 → 1425,7 |
|---|
| inherited Assign(Source); |
| end; |
| |
| procedure TDIB.Draw(ACanvas: TCanvas; const ARect: TRect); |
| procedure TDIB.Draw(ACanvas: TCanvas; const Rect: TRect); |
| var |
| OldPalette: HPalette; |
| OldMode: Integer; |
| 1866,8 → 1436,7 |
|---|
| begin |
| OldPalette := SelectPalette(ACanvas.Handle, Palette, False); |
| RealizePalette(ACanvas.Handle); |
| end |
| else |
| end else |
| OldPalette := 0; |
| try |
| OldMode := SetStretchBltMode(ACanvas.Handle, COLORONCOLOR); |
| 1875,18 → 1444,14 |
|---|
| GdiFlush; |
| if FImage.FMemoryImage then |
| begin |
| with ARect do |
| with Rect do |
| StretchDIBits(ACanvas.Handle, Left, Top, Right - Left, Bottom - Top, |
| 0, 0, Width, Height, FImage.FPBits, FImage.FBitmapInfo^, DIB_RGB_COLORS , ACanvas.CopyMode); |
| end else |
| begin |
| if StretchDIBits(ACanvas.Handle, Left, Top, Right - Left, Bottom - Top, |
| 0, 0, Self.Width, Self.Height, FImage.FPBits, FImage.FBitmapInfo^, DIB_RGB_COLORS, ACanvas.CopyMode) = 0 then |
| MessageBeep(1); |
| end; |
| end |
| else |
| begin |
| with ARect do |
| with Rect do |
| StretchBlt(ACanvas.Handle, Left, Top, Right - Left, Bottom - Top, |
| FImage.FDC, 0, 0, Self.Width, Self.Height, ACanvas.CopyMode); |
| FImage.FDC, 0, 0, Width, Height, ACanvas.CopyMode); |
| end; |
| finally |
| SetStretchBltMode(ACanvas.Handle, OldMode); |
| 1992,161 → 1557,6 |
|---|
| end; |
| end; |
| |
| type |
| PRGBA = ^TRGBA; |
| TRGBA = array[0..0] of Windows.TRGBQuad; |
| |
| function TDIB.HasAlphaChannel: Boolean; |
| {give that DIB contain the alphachannel} |
| var |
| p: PRGBA; |
| X, Y: Integer; |
| begin |
| Result := True; |
| if BitCount = 32 then |
| for Y := 0 to Height - 1 do |
| begin |
| p := ScanLine[Y]; |
| for X := 0 to Width - 1 do |
| begin |
| if p[X].rgbReserved <> $0 then Exit; |
| end |
| end; |
| Result := False; |
| end; |
| |
| function TDIB.AssignAlphaChannel(ALPHA: TDIB; ForceResize: Boolean{$IFDEF VER4UP} = False{$ENDIF}): Boolean; |
| {copy alphachannel from other DIB or add from DIB8} |
| var |
| p32_0, p32_1: PRGBA; |
| p24: Pointer; |
| pB: PArrayByte; |
| X, Y: Integer; |
| tmpDIB, qAlpha: TDIB; |
| begin |
| Result := False; |
| if GetEmpty then Exit; |
| {Alphachannel can be copy into 32bit DIB only!} |
| if BitCount <> 32 then |
| begin |
| tmpDIB := TDIB.Create; |
| try |
| tmpDIB.Assign(Self); |
| Clear; |
| SetSize(tmpDIB.Width, tmpDIB.Height, 32); |
| Canvas.Draw(0, 0, tmpDIB); |
| finally |
| tmpDIB.Free; |
| end; |
| end; |
| qAlpha := TDIB.Create; |
| try |
| if not Assigned(Alpha) then Exit; |
| if ForceResize then |
| begin |
| {create temp} |
| tmpDIB := TDIB.Create; |
| try |
| {picture} |
| tmpDIB.Assign(ALPHA); |
| {resample size} |
| tmpDIB.DoResample(Width, Height, ftrBSpline); |
| {convert to greyscale} |
| tmpDIB.Greyscale(8); |
| {return picture to qAlpha} |
| qAlpha.Assign(tmpDIB); |
| finally |
| tmpDIB.Free; |
| end; |
| end |
| else |
| {Must be the same size!} |
| if not ((Width = ALPHA.Width) and (Height = ALPHA.Height)) then Exit |
| else qAlpha.Assign(ALPHA); |
| {It works now with qAlpha only} |
| case qAlpha.BitCount of |
| 24: |
| begin |
| for Y := 0 to Height - 1 do |
| begin |
| p32_0 := ScanLine[Y]; |
| p24 := qAlpha.ScanLine[Y]; |
| for X := 0 to Width - 1 do with PBGR(p24)^ do |
| begin |
| p32_0[X].rgbReserved := Round(0.30 * R + 0.59 * G + 0.11 * B); |
| end |
| end; |
| end; |
| 32: |
| begin |
| for Y := 0 to Height - 1 do |
| begin |
| p32_0 := ScanLine[Y]; |
| p32_1 := qAlpha.ScanLine[Y]; |
| for X := 0 to Width - 1 do |
| begin |
| p32_0[X].rgbReserved := p32_1[X].rgbReserved; |
| end |
| end; |
| end; |
| 8: |
| begin |
| for Y := 0 to Height - 1 do |
| begin |
| p32_0 := ScanLine[Y]; |
| pB := qAlpha.ScanLine[Y]; |
| for X := 0 to Width - 1 do |
| begin |
| p32_0[X].rgbReserved := pB[X]; |
| end |
| end; |
| end; |
| 1: |
| begin |
| for Y := 0 to Height - 1 do |
| begin |
| p32_0 := ScanLine[Y]; |
| pB := qAlpha.ScanLine[Y]; |
| for X := 0 to Width - 1 do |
| begin |
| if pB[X] = 0 then |
| p32_0[X].rgbReserved := $FF |
| else |
| p32_0[X].rgbReserved := 0 |
| end |
| end; |
| end; |
| else |
| Exit; |
| end; |
| Result := True; |
| finally |
| qAlpha.Free; |
| end; |
| end; |
| |
| procedure TDIB.RetAlphaChannel(out oDIB: TDIB); |
| {Store alphachannel information into DIB8} |
| var |
| p0: PRGBA; |
| pB: PArrayByte; |
| X, Y: Integer; |
| begin |
| oDIB := nil; |
| if not HasAlphaChannel then exit; |
| oDIB := TDIB.Create; |
| oDIB.SetSize(Width, Height, 8); |
| for Y := 0 to Height - 1 do |
| begin |
| p0 := ScanLine[Y]; |
| pB := oDIB.ScanLine[Y]; |
| for X := 0 to Width - 1 do |
| begin |
| pB[X] := p0[X].rgbReserved; |
| end |
| end; |
| end; |
| |
| function TDIB.GetBitmapInfo: PBitmapInfo; |
| begin |
| Result := FImage.FBitmapInfo; |
| 2273,7 → 1683,7 |
|---|
| begin |
| case FBitCount of |
| 1: Result := (PArrayByte(Integer(FTopPBits) + Y * FNextLine)[X shr 3] and Mask1[X and 7]) shr Shift1[X and 7]; |
| 4: Result := ((PArrayByte(Integer(FTopPBits) + Y * FNextLine)[X shr 1] and Mask4[X and 1]) shr Shift4[X and 1]); |
| 4 : Result := (PArrayByte(Integer(FTopPBits)+Y*FNextLine)[X shr 1] and Mask4[X and 1]) shr Shift4[X and 1]; |
| 8: Result := PArrayByte(Integer(FTopPBits) + Y * FNextLine)[X]; |
| 16: Result := PArrayWord(Integer(FTopPBits) + Y * FNextLine)[X]; |
| 24: with PArrayBGR(Integer(FTopPBits) + Y * FNextLine)[X] do |
| 2283,17 → 1693,6 |
|---|
| end; |
| end; |
| |
| function TDIB.GetRGBChannel: TDIB; |
| {Store RGB channel information into DIB24} |
| begin |
| Result := nil; |
| if Self.Empty then Exit; |
| Result := TDIB.Create; |
| Result.SetSize(Width, Height, 24); |
| Self.DrawOn(Bounds(0,0, Self.Width, Self.Height), Result.Canvas, 0, 0); |
| FFreeList.Add(Result); |
| end; |
| |
| procedure TDIB.SetPixel(X, Y: Integer; Value: DWORD); |
| var |
| P: PByte; |
| 2308,8 → 1707,8 |
|---|
| P^ := (P^ and Mask1n[X and 7]) or ((Value and 1) shl Shift1[X and 7]); |
| end; |
| 4: begin |
| P := (@PArrayByte(Integer(FTopPBits) + Y * FNextLine)[X shr 3]); |
| P^ := ((P^ and Mask4n[X and 1]) or ((Value and 15) shl Shift4[X and 1])); |
| P := @PArrayByte(Integer(FTopPBits)+Y*FNextLine)[X shr 3]; |
| P^ := (P^ and Mask4n[X and 1]) or ((Value and 15) shl Shift4[X and 1]); |
| end; |
| 8: PArrayByte(Integer(FTopPBits) + Y * FNextLine)[X] := Value; |
| 16: PArrayWord(Integer(FTopPBits) + Y * FNextLine)[X] := Value; |
| 2324,23 → 1723,6 |
|---|
| end; |
| end; |
| |
| procedure TDIB.SetRGBChannel(const Value: TDIB); |
| var |
| alpha: TDIB; |
| begin |
| if Self.HasAlphaChannel then |
| try |
| RetAlphaChannel(alpha); |
| Self.SetSize(Value.Width, Value.Height, 32); |
| Value.DrawOn(Bounds(0,0,Value.Width, Value.Height), Self.Canvas, 0, 0); |
| Self.AssignAlphaChannel(alpha, True); |
| finally |
| alpha.Free; |
| end |
| else |
| Self.Assign(Value); |
| end; |
| |
| procedure TDIB.DefineProperties(Filer: TFiler); |
| begin |
| inherited DefineProperties(Filer); |
| 2349,8 → 1731,6 |
|---|
| end; |
| |
| type |
| { TGlobalMemoryStream } |
| |
| TGlobalMemoryStream = class(TMemoryStream) |
| private |
| FHandle: THandle; |
| 2393,7 → 1773,6 |
|---|
| var |
| BF: TBitmapFileHeader; |
| i: Integer; |
| ImageJPEG: TJPEGImage; |
| begin |
| { File header reading } |
| i := Stream.Read(BF, SizeOf(TBitmapFileHeader)); |
| 2401,30 → 1780,6 |
|---|
| if i <> SizeOf(TBitmapFileHeader) then |
| raise EInvalidGraphic.Create(SInvalidDIB); |
| |
| { Is the head jpeg ?} |
| |
| if BF.bfType = $D8FF then |
| begin |
| ImageJPEG := TJPEGImage.Create; |
| try |
| try |
| Stream.Position := 0; |
| ImageJPEG.LoadFromStream(Stream); |
| except |
| on EInvalidGraphic do ImageJPEG := nil; |
| end; |
| if ImageJPEG <> nil then |
| begin |
| {set size and bitcount in natural units of jpeg} |
| SetSize(ImageJPEG.Width, ImageJPEG.Height, 24); |
| Canvas.Draw(0, 0, ImageJPEG); |
| Exit |
| end; |
| finally |
| ImageJPEG.Free; |
| end; |
| end |
| else |
| { Is the head 'BM'? } |
| if BF.bfType <> BitmapFileType then |
| raise EInvalidGraphic.Create(SInvalidDIB); |
| 2509,8 → 1864,7 |
|---|
| if Empty then |
| begin |
| SetSize(Max(Width, 1), Max(Height, 1), Value) |
| end |
| else |
| end else |
| begin |
| ConvertBitCount(Value); |
| end; |
| 2677,16 → 2031,13 |
|---|
| for x := 0 to Width - 1 do |
| begin |
| case Temp.BitCount of |
| 1: |
| begin |
| 1 : begin |
| i := (PArrayByte(SrcP)[X shr 3] and Mask1[X and 7]) shr Shift1[X and 7]; |
| end; |
| 4: |
| begin |
| 4 : begin |
| i := (PArrayByte(SrcP)[X and 1] and Mask4[X and 1]) shr Shift4[X and 1]; |
| end; |
| 8: |
| begin |
| 8 : begin |
| i := PByte(SrcP)^; |
| Inc(PByte(SrcP)); |
| end; |
| 2693,18 → 2044,15 |
|---|
| end; |
| |
| case BitCount of |
| 1: |
| begin |
| 1 : begin |
| P := @PArrayByte(DestP)[X shr 3]; |
| P^ := (P^ and Mask1n[X and 7]) or (i shl Shift1[X shr 3]); |
| end; |
| 4: |
| begin |
| 4 : begin |
| P := @PArrayByte(DestP)[X shr 1]; |
| P^ := (P^ and Mask4n[X and 1]) or (i shl Shift4[X and 1]); |
| end; |
| 8: |
| begin |
| 8 : begin |
| PByte(DestP)^ := i; |
| Inc(PByte(DestP)); |
| end; |
| 2731,8 → 2079,7 |
|---|
| for x := 0 to Width - 1 do |
| begin |
| case Temp.BitCount of |
| 1: |
| begin |
| 1 : begin |
| with Temp.ColorTable[(PArrayByte(SrcP)[X shr 3] and Mask1[X and 7]) shr Shift1[X and 7]] do |
| begin |
| cR := rgbRed; |
| 2740,8 → 2087,7 |
|---|
| cB := rgbBlue; |
| end; |
| end; |
| 4: |
| begin |
| 4 : begin |
| with Temp.ColorTable[(PArrayByte(SrcP)[X shr 1] and Mask4[X and 1]) shr Shift4[X and 1]] do |
| begin |
| cR := rgbRed; |
| 2749,8 → 2095,7 |
|---|
| cB := rgbBlue; |
| end; |
| end; |
| 8: |
| begin |
| 8 : begin |
| with Temp.ColorTable[PByte(SrcP)^] do |
| begin |
| cR := rgbRed; |
| 2759,13 → 2104,11 |
|---|
| end; |
| Inc(PByte(SrcP)); |
| end; |
| 16: |
| begin |
| 16: begin |
| pfGetRGB(Temp.NowPixelFormat, PWord(SrcP)^, cR, cG, cB); |
| Inc(PWord(SrcP)); |
| end; |
| 24: |
| begin |
| 24: begin |
| with PBGR(SrcP)^ do |
| begin |
| cR := R; |
| 2775,8 → 2118,7 |
|---|
| |
| Inc(PBGR(SrcP)); |
| end; |
| 32: |
| begin |
| 32: begin |
| pfGetRGB(Temp.NowPixelFormat, PDWORD(SrcP)^, cR, cG, cB); |
| Inc(PDWORD(SrcP)); |
| end; |
| 2783,13 → 2125,11 |
|---|
| end; |
| |
| case BitCount of |
| 16: |
| begin |
| 16: begin |
| PWord(DestP)^ := pfRGB(NowPixelFormat, cR, cG, cB); |
| Inc(PWord(DestP)); |
| end; |
| 24: |
| begin |
| 24: begin |
| with PBGR(DestP)^ do |
| begin |
| R := cR; |
| 2798,8 → 2138,7 |
|---|
| end; |
| Inc(PBGR(DestP)); |
| end; |
| 32: |
| begin |
| 32: begin |
| PDWORD(DestP)^ := pfRGB(NowPixelFormat, cR, cG, cB); |
| Inc(PDWORD(DestP)); |
| end; |
| 2824,8 → 2163,7 |
|---|
| if Temp.BitCount <= BitCount then |
| begin |
| PaletteToPalette_Inc; |
| end |
| else |
| end else |
| begin |
| case BitCount of |
| 1: begin |
| 2839,14 → 2177,12 |
|---|
| |
| Canvas.Draw(0, 0, Temp); |
| end; |
| end |
| else |
| end else |
| if (Temp.BitCount <= 8) and (BitCount > 8) then |
| begin |
| { The image is converted from the palette color image into the rgb color image. } |
| PaletteToRGB_or_RGBToRGB; |
| end |
| else |
| end else |
| if (Temp.BitCount > 8) and (BitCount <= 8) then |
| begin |
| { The image is converted from the rgb color image into the palette color image. } |
| 2861,8 → 2197,7 |
|---|
| UpdatePalette; |
| |
| Canvas.Draw(0, 0, Temp); |
| end |
| else |
| end else |
| if (Temp.BitCount > 8) and (BitCount > 8) then |
| begin |
| { The image is converted from the rgb color image into the rgb color image. } |
| 2916,211 → 2251,6 |
|---|
| Inc(FProgressY); |
| end; |
| |
| procedure TDIB.Mirror(MirrorX, MirrorY: Boolean); |
| var |
| x, y, Width2, c: Integer; |
| P1, P2, TempBuf: Pointer; |
| begin |
| if Empty then Exit; |
| if (not MirrorX) and (not MirrorY) then Exit; |
| |
| if (not MirrorX) and (MirrorY) then |
| begin |
| GetMem(TempBuf, WidthBytes); |
| try |
| StartProgress('Mirror'); |
| try |
| for y := 0 to Height shr 1 - 1 do |
| begin |
| P1 := ScanLine[y]; |
| P2 := ScanLine[Height - y - 1]; |
| |
| Move(P1^, TempBuf^, WidthBytes); |
| Move(P2^, P1^, WidthBytes); |
| Move(TempBuf^, P2^, WidthBytes); |
| |
| UpdateProgress(y * 2); |
| end; |
| finally |
| EndProgress; |
| end; |
| finally |
| FreeMem(TempBuf, WidthBytes); |
| end; |
| end |
| else |
| if (MirrorX) and (not MirrorY) then |
| begin |
| Width2 := Width shr 1; |
| |
| StartProgress('Mirror'); |
| try |
| for y := 0 to Height - 1 do |
| begin |
| P1 := ScanLine[y]; |
| |
| case BitCount of |
| 1: |
| begin |
| for x := 0 to Width2 - 1 do |
| begin |
| c := Pixels[x, y]; |
| Pixels[x, y] := Pixels[Width - x - 1, y]; |
| Pixels[Width - x - 1, y] := c; |
| end; |
| end; |
| 4: |
| begin |
| for x := 0 to Width2 - 1 do |
| begin |
| c := Pixels[x, y]; |
| Pixels[x, y] := Pixels[Width - x - 1, y]; |
| Pixels[Width - x - 1, y] := c; |
| end; |
| end; |
| 8: |
| begin |
| P2 := Pointer(Integer(P1) + Width - 1); |
| for x := 0 to Width2 - 1 do |
| begin |
| PByte(@c)^ := PByte(P1)^; |
| PByte(P1)^ := PByte(P2)^; |
| PByte(P2)^ := PByte(@c)^; |
| Inc(PByte(P1)); |
| Dec(PByte(P2)); |
| end; |
| end; |
| 16: |
| begin |
| P2 := Pointer(Integer(P1) + (Width - 1) * 2); |
| for x := 0 to Width2 - 1 do |
| begin |
| PWord(@c)^ := PWord(P1)^; |
| PWord(P1)^ := PWord(P2)^; |
| PWord(P2)^ := PWord(@c)^; |
| Inc(PWord(P1)); |
| Dec(PWord(P2)); |
| end; |
| end; |
| 24: |
| begin |
| P2 := Pointer(Integer(P1) + (Width - 1) * 3); |
| for x := 0 to Width2 - 1 do |
| begin |
| PBGR(@c)^ := PBGR(P1)^; |
| PBGR(P1)^ := PBGR(P2)^; |
| PBGR(P2)^ := PBGR(@c)^; |
| Inc(PBGR(P1)); |
| Dec(PBGR(P2)); |
| end; |
| end; |
| 32: |
| begin |
| P2 := Pointer(Integer(P1) + (Width - 1) * 4); |
| for x := 0 to Width2 - 1 do |
| begin |
| PDWORD(@c)^ := PDWORD(P1)^; |
| PDWORD(P1)^ := PDWORD(P2)^; |
| PDWORD(P2)^ := PDWORD(@c)^; |
| Inc(PDWORD(P1)); |
| Dec(PDWORD(P2)); |
| end; |
| end; |
| end; |
| |
| UpdateProgress(y); |
| end; |
| finally |
| EndProgress; |
| end; |
| end |
| else |
| if (MirrorX) and (MirrorY) then |
| begin |
| StartProgress('Mirror'); |
| try |
| for y := 0 to Height shr 1 - 1 do |
| begin |
| P1 := ScanLine[y]; |
| P2 := ScanLine[Height - y - 1]; |
| |
| case BitCount of |
| 1: |
| begin |
| for x := 0 to Width - 1 do |
| begin |
| c := Pixels[x, y]; |
| Pixels[x, y] := Pixels[Width - x - 1, Height - y - 1]; |
| Pixels[Width - x - 1, Height - y - 1] := c; |
| end; |
| end; |
| 4: |
| begin |
| for x := 0 to Width - 1 do |
| begin |
| c := Pixels[x, y]; |
| Pixels[x, y] := Pixels[Width - x - 1, Height - y - 1]; |
| Pixels[Width - x - 1, Height - y - 1] := c; |
| end; |
| end; |
| 8: |
| begin |
| P2 := Pointer(Integer(P2) + Width - 1); |
| for x := 0 to Width - 1 do |
| begin |
| PByte(@c)^ := PByte(P1)^; |
| PByte(P1)^ := PByte(P2)^; |
| PByte(P2)^ := PByte(@c)^; |
| Inc(PByte(P1)); |
| Dec(PByte(P2)); |
| end; |
| end; |
| 16: |
| begin |
| P2 := Pointer(Integer(P2) + (Width - 1) * 2); |
| for x := 0 to Width - 1 do |
| begin |
| PWord(@c)^ := PWord(P1)^; |
| PWord(P1)^ := PWord(P2)^; |
| PWord(P2)^ := PWord(@c)^; |
| Inc(PWord(P1)); |
| Dec(PWord(P2)); |
| end; |
| end; |
| 24: |
| begin |
| P2 := Pointer(Integer(P2) + (Width - 1) * 3); |
| for x := 0 to Width - 1 do |
| begin |
| PBGR(@c)^ := PBGR(P1)^; |
| PBGR(P1)^ := PBGR(P2)^; |
| PBGR(P2)^ := PBGR(@c)^; |
| Inc(PBGR(P1)); |
| Dec(PBGR(P2)); |
| end; |
| end; |
| 32: |
| begin |
| P2 := Pointer(Integer(P2) + (Width - 1) * 4); |
| for x := 0 to Width - 1 do |
| begin |
| PDWORD(@c)^ := PDWORD(P1)^; |
| PDWORD(P1)^ := PDWORD(P2)^; |
| PDWORD(P2)^ := PDWORD(@c)^; |
| Inc(PDWORD(P1)); |
| Dec(PDWORD(P2)); |
| end; |
| end; |
| end; |
| |
| UpdateProgress(y * 2); |
| end; |
| finally |
| EndProgress; |
| end; |
| end; |
| end; |
| |
| procedure TDIB.Blur(ABitCount: Integer; Radius: Integer); |
| type |
| TAve = record |
| 3140,8 → 2270,7 |
|---|
| R, G, B: Byte; |
| begin |
| case Temp.BitCount of |
| 1: |
| begin |
| 1 : begin |
| SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine); |
| AveP := @Ave; |
| for x := 0 to XCount - 1 do |
| 3156,8 → 2285,7 |
|---|
| Inc(AveP); |
| end; |
| end; |
| 4: |
| begin |
| 4 : begin |
| SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine); |
| AveP := @Ave; |
| for x := 0 to XCount - 1 do |
| 3172,8 → 2300,7 |
|---|
| Inc(AveP); |
| end; |
| end; |
| 8: |
| begin |
| 8 : begin |
| SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine); |
| AveP := @Ave; |
| for x := 0 to XCount - 1 do |
| 3189,8 → 2316,7 |
|---|
| Inc(AveP); |
| end; |
| end; |
| 16: |
| begin |
| 16: begin |
| SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine); |
| AveP := @Ave; |
| for x := 0 to XCount - 1 do |
| 3207,8 → 2333,7 |
|---|
| Inc(AveP); |
| end; |
| end; |
| 24: |
| begin |
| 24: begin |
| SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine); |
| AveP := @Ave; |
| for x := 0 to XCount - 1 do |
| 3224,8 → 2349,7 |
|---|
| Inc(AveP); |
| end; |
| end; |
| 32: |
| begin |
| 32: begin |
| SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine); |
| AveP := @Ave; |
| for x := 0 to XCount - 1 do |
| 3253,8 → 2377,7 |
|---|
| R, G, B: Byte; |
| begin |
| case Temp.BitCount of |
| 1: |
| begin |
| 1 : begin |
| SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine); |
| AveP := @Ave; |
| for x := 0 to XCount - 1 do |
| 3269,8 → 2392,7 |
|---|
| Inc(AveP); |
| end; |
| end; |
| 4: |
| begin |
| 4 : begin |
| SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine); |
| AveP := @Ave; |
| for x := 0 to XCount - 1 do |
| 3285,8 → 2407,7 |
|---|
| Inc(AveP); |
| end; |
| end; |
| 8: |
| begin |
| 8 : begin |
| SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine); |
| AveP := @Ave; |
| for x := 0 to XCount - 1 do |
| 3302,8 → 2423,7 |
|---|
| Inc(AveP); |
| end; |
| end; |
| 16: |
| begin |
| 16: begin |
| SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine); |
| AveP := @Ave; |
| for x := 0 to XCount - 1 do |
| 3320,8 → 2440,7 |
|---|
| Inc(AveP); |
| end; |
| end; |
| 24: |
| begin |
| 24: begin |
| SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine); |
| AveP := @Ave; |
| for x := 0 to XCount - 1 do |
| 3337,8 → 2456,7 |
|---|
| Inc(AveP); |
| end; |
| end; |
| 32: |
| begin |
| 32: begin |
| SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine); |
| AveP := @Ave; |
| for x := 0 to XCount - 1 do |
| 3461,32 → 2579,27 |
|---|
| |
| { The average is written. } |
| case BitCount of |
| 1: |
| begin |
| 1 : begin |
| P := @PArrayByte(DestP)[X shr 3]; |
| with Ave do |
| P^ := (P^ and Mask1n[X and 7]) or (DWORD(Ord(((cR + cG + cB) div c) div 3 > 127)) shl Shift1[X and 7]); |
| end; |
| 4: |
| begin |
| 4 : begin |
| P := @PArrayByte(DestP)[X shr 1]; |
| with Ave do |
| P^ := (P^ and Mask4n[X and 1]) or (((((cR + cG + cB) div c) div 3) shr 4) shl Shift4[X and 1]); |
| end; |
| 8: |
| begin |
| 8 : begin |
| with Ave do |
| PByte(DestP)^ := ((cR + cG + cB) div c) div 3; |
| Inc(PByte(DestP)); |
| end; |
| 16: |
| begin |
| 16: begin |
| with Ave do |
| PWORD(DestP)^ := pfRGB(NowPixelFormat, cR div c, cG div c, cB div c); |
| Inc(PWORD(DestP)); |
| end; |
| 24: |
| begin |
| 24: begin |
| with PBGR(DestP)^, Ave do |
| begin |
| R := cR div c; |
| 3495,8 → 2608,7 |
|---|
| end; |
| Inc(PBGR(DestP)); |
| end; |
| 32: |
| begin |
| 32: begin |
| with Ave do |
| PDWORD(DestP)^ := pfRGB(NowPixelFormat, cR div c, cG div c, cB div c); |
| Inc(PDWORD(DestP)); |
| 3546,64 → 2658,6 |
|---|
| end; |
| end; |
| |
| procedure TDIB.Negative; |
| var |
| i, i2: Integer; |
| P: Pointer; |
| begin |
| if Empty then exit; |
| |
| if BitCount <= 8 then |
| begin |
| for i := 0 to 255 do |
| with ColorTable[i] do |
| begin |
| rgbRed := 255 - rgbRed; |
| rgbGreen := 255 - rgbGreen; |
| rgbBlue := 255 - rgbBlue; |
| end; |
| UpdatePalette; |
| end else |
| begin |
| P := PBits; |
| i2 := Size; |
| asm |
| mov ecx,i2 |
| mov eax,P |
| mov edx,ecx |
| |
| { Unit of DWORD. } |
| @@qword_skip: |
| shr ecx,2 |
| jz @@dword_skip |
| |
| dec ecx |
| @@dword_loop: |
| not dword ptr [eax+ecx*4] |
| dec ecx |
| jnl @@dword_loop |
| |
| mov ecx,edx |
| shr ecx,2 |
| add eax,ecx*4 |
| |
| { Unit of Byte. } |
| @@dword_skip: |
| mov ecx,edx |
| and ecx,3 |
| jz @@byte_skip |
| |
| dec ecx |
| @@loop_byte: |
| not byte ptr [eax+ecx] |
| dec ecx |
| jnl @@loop_byte |
| |
| @@byte_skip: |
| end; |
| end; |
| end; |
| |
| procedure TDIB.Greyscale(ABitCount: Integer); |
| var |
| YTblR, YTblG, YTblB: array[0..255] of Byte; |
| 3614,7 → 2668,7 |
|---|
| DestP, SrcP: Pointer; |
| P: PByte; |
| begin |
| if Empty then Exit; |
| if Empty then exit; |
| |
| Temp := TDIB.Create; |
| try |
| 3652,36 → 2706,30 |
|---|
| for x := 0 to Width - 1 do |
| begin |
| case Temp.BitCount of |
| 1: |
| begin |
| 1 : begin |
| with Temp.ColorTable[(PArrayByte(SrcP)[X shr 3] and Mask1[X and 7]) shr Shift1[X and 7]] do |
| c := YTblR[rgbRed] + YTblG[rgbGreen] + YTblB[rgbBlue]; |
| end; |
| 4: |
| begin |
| 4 : begin |
| with Temp.ColorTable[(PArrayByte(SrcP)[X shr 1] and Mask4[X and 1]) shr Shift4[X and 1]] do |
| c := YTblR[rgbRed] + YTblG[rgbGreen] + YTblB[rgbBlue]; |
| end; |
| 8: |
| begin |
| 8 : begin |
| with Temp.ColorTable[PByte(SrcP)^] do |
| c := YTblR[rgbRed] + YTblG[rgbGreen] + YTblB[rgbBlue]; |
| Inc(PByte(SrcP)); |
| end; |
| 16: |
| begin |
| 16: begin |
| pfGetRGB(Temp.NowPixelFormat, PWord(SrcP)^, R, G, B); |
| c := YTblR[R] + YTblR[G] + YTblR[B]; |
| Inc(PWord(SrcP)); |
| end; |
| 24: |
| begin |
| 24: begin |
| with PBGR(SrcP)^ do |
| c := YTblR[R] + YTblG[G] + YTblB[B]; |
| Inc(PBGR(SrcP)); |
| end; |
| 32: |
| begin |
| 32: begin |
| pfGetRGB(Temp.NowPixelFormat, PDWORD(SrcP)^, R, G, B); |
| c := YTblR[R] + YTblR[G] + YTblR[B]; |
| Inc(PDWORD(SrcP)); |
| 3689,28 → 2737,23 |
|---|
| end; |
| |
| case BitCount of |
| 1: |
| begin |
| 1 : begin |
| P := @PArrayByte(DestP)[X shr 3]; |
| P^ := (P^ and Mask1n[X and 7]) or (DWORD(Ord(c > 127)) shl Shift1[X and 7]); |
| end; |
| 4: |
| begin |
| 4 : begin |
| P := @PArrayByte(DestP)[X shr 1]; |
| P^ := (P^ and Mask4n[X and 1]) or ((c shr 4) shl Shift4[X and 1]); |
| end; |
| 8: |
| begin |
| 8 : begin |
| PByte(DestP)^ := c; |
| Inc(PByte(DestP)); |
| end; |
| 16: |
| begin |
| 16: begin |
| PWord(DestP)^ := pfRGB(NowPixelFormat, c, c, c); |
| Inc(PWord(DestP)); |
| end; |
| 24: |
| begin |
| 24: begin |
| with PBGR(DestP)^ do |
| begin |
| R := c; |
| 3719,8 → 2762,7 |
|---|
| end; |
| Inc(PBGR(DestP)); |
| end; |
| 32: |
| begin |
| 32: begin |
| PDWORD(DestP)^ := pfRGB(NowPixelFormat, c, c, c); |
| Inc(PDWORD(DestP)); |
| end; |
| 3737,1574 → 2779,253 |
|---|
| end; |
| end; |
| |
| //-------------------------------------------------------------------------------------------------- |
| // Version : 0.1 - 26/06/2000 // |
| // Version : 0.2 - 04/07/2000 // |
| // At someone's request, i have added 3 news effects : // |
| // 1 - Rotate // |
| // 2 - SplitBlur // |
| // 3 - GaussianBlur // |
| //-------------------------------------------------------------------------------------------------- |
| // - NEW SPECIAL EFFECT - (English) // |
| //-------------------------------------------------------------------------------------------------- |
| // At the start, my idea was to create a component derived from TCustomDXDraw. Unfortunately, // |
| // it's impossible to run a graphic component (derived from TCustomDXDraw) in a conception's // |
| // mode (i don't success, but perhaps, somebody know how doing ! In that case, please help me !!!)// |
| // Then, i'm used the DIB's unit for my work, but this unit is poor in special effect. Knowing a // |
| // library with more effect, i'm undertaked to import this library in DIB's unit. You can see the // |
| // FastLib library at : // |
| // // |
| // -> Gordon Alex Cowie <gfody@jps.net> www.jps.net/gfody // |
| // // |
| // It was very difficult, because implementation's graphic was very different that DIB's unit. // |
| // Sometimes, i'm deserted the possibility of original effect, particularly in conversion of DIB // |
| // whith 256, 16 and 2 colors. If someone can implement this fonctionnality, thanks to tell me // |
| // how this miracle is possible !!! // |
| // All these procedures are translated and adapted by : // |
| // // |
| // -> Mickey (Michel HIBON) <mhibon@ifrance.com> http://mickey.tsx.org // |
| // // |
| // IMPORTANT : These procedures don't modify the DIB's unit structure // |
| // Nota Bene : I don't implement these type of graphics (32 and 16 bit per pixels), // |
| // for one reason : I haven't bitmaps of this type !!! // |
| //-------------------------------------------------------------------------------------------------- |
| //-------------------------------------------------------------------------------------------------- |
| // - NOUVEAUX EFFETS SPECIAUX - (Français) // |
| //-------------------------------------------------------------------------------------------------- |
| // Au commencement, mon idée était de dériver un composant de TCustomDXDraw. Malheureusement, // |
| // c'est impossible de faire fonctionner un composant graphique (derivé de TCustomDXDraw) en mode // |
| // conception (je n'y suis pas parvenu, mais peut-être, que quelqu'un sait comment faire ! Dans // |
| // ce cas, vous seriez aimable de m'aider !!!) // |
| // Alors, j'ai utilisé l'unité DIB pour mon travail,mais celle-ci est pauvre en effet spéciaux. // |
| // Connaissant une librairie avec beaucoup plus d'effets spéciaux, j'ai entrepris d'importer // |
| // cette librairie dans l'unité DIB. Vous pouvez voir la librairie FastLib à : // |
| // // |
| // -> Gordon Alex Cowie <gfody@jps.net> www.jps.net/gfody // |
| // // |
| // C'était très difficile car l'implémentation graphique est très différente de l'unité DIB. // |
| // Parfois, j'ai abandonné les possibilités de l'effet original, particulièrement dans la // |
| // conversion des DIB avec 256, 16 et 2 couleurs. Si quelqu'un arrive à implémenter ces // |
| // fonctionnalités, merci de me dire comment ce miracle est possible !!! // |
| // Toutes ces procédures ont été traduites et adaptées par: // |
| // // |
| // -> Mickey (Michel HIBON) <mhibon@ifrance.com> http://mickey.tsx.org // |
| // // |
| // IMPORTANT : Ces procédures ne modifient pas la structure de l'unité DIB // |
| // Nota Bene : Je n'ai pas implémenté ces types de graphiques (32 et 16 bit par pixels), // |
| // pour une raison : je n'ai pas de bitmap de ce type !!! // |
| //-------------------------------------------------------------------------------------------------- |
| |
| function TDIB.IntToColor(i: Integer): TBGR; |
| procedure TDIB.Mirror(MirrorX, MirrorY: Boolean); |
| var |
| x, y, Width2, c: Integer; |
| P1, P2, TempBuf: Pointer; |
| begin |
| Result.b := i shr 16; |
| Result.g := i shr 8; |
| Result.r := i; |
| end; |
| if Empty then exit; |
| if (not MirrorX) and (not MirrorY) then Exit; |
| |
| function TDIB.Interval(iMin, iMax, iValue: Integer; iMark: Boolean): Integer; |
| if (not MirrorX) and (MirrorY) then |
| begin |
| if iMark then |
| GetMem(TempBuf, WidthBytes); |
| try |
| StartProgress('Mirror'); |
| try |
| for y:=0 to Height shr 1-1 do |
| begin |
| if iValue < iMin then |
| Result := iMin |
| else |
| if iValue > iMax then |
| Result := iMax |
| else |
| Result := iValue; |
| end |
| else |
| begin |
| if iValue < iMin then |
| Result := iMin |
| else |
| if iValue > iMax then |
| Result := iMin |
| else |
| Result := iValue; |
| end; |
| end; |
| P1 := ScanLine[y]; |
| P2 := ScanLine[Height-y-1]; |
| |
| procedure TDIB.Contrast(Amount: Integer); |
| var |
| x, y: Integer; |
| Table1: array[0..255] of Byte; |
| i: Byte; |
| S, D: pointer; |
| Temp1: TDIB; |
| color: DWORD; |
| P: PByte; |
| R, G, B: Byte; |
| begin |
| D := nil; |
| S := nil; |
| Temp1 := nil; |
| for i := 0 to 126 do |
| begin |
| y := (Abs(128 - i) * Amount) div 256; |
| Table1[i] := IntToByte(i - y); |
| Move(P1^, TempBuf^, WidthBytes); |
| Move(P2^, P1^, WidthBytes); |
| Move(TempBuf^, P2^, WidthBytes); |
| |
| UpdateProgress(y*2); |
| end; |
| for i := 127 to 255 do |
| begin |
| y := (Abs(128 - i) * Amount) div 256; |
| Table1[i] := IntToByte(i + y); |
| finally |
| EndProgress; |
| end; |
| case BitCount of |
| 32: Exit; // I haven't bitmap of this type ! Sorry |
| 24: ; // nothing to do |
| 16: ; // I have an artificial bitmap for this type ! i don't sure that it works |
| 8, 4: |
| begin |
| Temp1 := TDIB.Create; |
| Temp1.Assign(self); |
| Temp1.SetSize(Width, Height, BitCount); |
| for i := 0 to 255 do |
| begin |
| with ColorTable[i] do |
| begin |
| rgbRed := IntToByte(Table1[rgbRed]); |
| rgbGreen := IntToByte(Table1[rgbGreen]); |
| rgbBlue := IntToByte(Table1[rgbBlue]); |
| finally |
| FreeMem(TempBuf, WidthBytes); |
| end; |
| end; |
| UpdatePalette; |
| end; |
| else |
| // if the number of pixel is equal to 1 then exit of procedure |
| Exit; |
| end; |
| for y := 0 to Pred(Height) do |
| end else if (MirrorX) and (not MirrorY) then |
| begin |
| case BitCount of |
| 24, 16: D := ScanLine[y]; |
| 8, 4: |
| begin |
| D := Temp1.ScanLine[y]; |
| S := Temp1.ScanLine[y]; |
| end; |
| else |
| end; |
| for x := 0 to Pred(Width) do |
| begin |
| case BitCount of |
| 32: ; |
| 24: |
| begin |
| PBGR(D)^.B := Table1[PBGR(D)^.B]; |
| PBGR(D)^.G := Table1[PBGR(D)^.G]; |
| PBGR(D)^.R := Table1[PBGR(D)^.R]; |
| Inc(PBGR(D)); |
| end; |
| 16: |
| begin |
| pfGetRGB(NowPixelFormat, PWord(D)^, R, G, B); |
| PWord(D)^ := Table1[R] + Table1[G] + Table1[B]; |
| Inc(PWord(D)); |
| end; |
| 8: |
| begin |
| with Temp1.ColorTable[PByte(S)^] do |
| color := rgbRed + rgbGreen + rgbBlue; |
| Inc(PByte(S)); |
| PByte(D)^ := color; |
| Inc(PByte(D)); |
| end; |
| 4: |
| begin |
| with Temp1.ColorTable[PByte(S)^] do |
| color := rgbRed + rgbGreen + rgbBlue; |
| Inc(PByte(S)); |
| P := @PArrayByte(D)[X shr 1]; |
| P^ := (P^ and Mask4n[X and 1]) or (color shl Shift4[X and 1]); |
| end; |
| else |
| end; |
| end; |
| end; |
| case BitCount of |
| 8, 4: Temp1.Free; |
| else |
| end; |
| end; |
| Width2 := Width shr 1; |
| |
| procedure TDIB.Saturation(Amount: Integer); |
| var |
| Grays: array[0..767] of Integer; |
| Alpha: array[0..255] of Word; |
| Gray, x, y: Integer; |
| i: Byte; |
| S, D: pointer; |
| Temp1: TDIB; |
| color: DWORD; |
| P: PByte; |
| R, G, B: Byte; |
| StartProgress('Mirror'); |
| try |
| for y:=0 to Height-1 do |
| begin |
| D := nil; |
| S := nil; |
| Temp1 := nil; |
| for i := 0 to 255 do |
| Alpha[i] := (i * Amount) shr 8; |
| x := 0; |
| for i := 0 to 255 do |
| begin |
| Gray := i - Alpha[i]; |
| Grays[x] := Gray; |
| Inc(x); |
| Grays[x] := Gray; |
| Inc(x); |
| Grays[x] := Gray; |
| Inc(x); |
| end; |
| case BitCount of |
| 32: Exit; // I haven't bitmap of this type ! Sorry |
| 24: ; // nothing to do |
| 16: ; // I have an artificial bitmap for this type ! i don't sure that it works |
| 8, 4: |
| begin |
| Temp1 := TDIB.Create; |
| Temp1.Assign(self); |
| Temp1.SetSize(Width, Height, BitCount); |
| for i := 0 to 255 do |
| begin |
| with ColorTable[i] do |
| begin |
| Gray := Grays[rgbRed + rgbGreen + rgbBlue]; |
| rgbRed := IntToByte(Gray + Alpha[rgbRed]); |
| rgbGreen := IntToByte(Gray + Alpha[rgbGreen]); |
| rgbBlue := IntToByte(Gray + Alpha[rgbBlue]); |
| end; |
| end; |
| UpdatePalette; |
| end; |
| else |
| // if the number of pixel is equal to 1 then exit of procedure |
| Exit; |
| end; |
| for y := 0 to Pred(Height) do |
| begin |
| case BitCount of |
| 24, 16: D := ScanLine[y]; |
| 8, 4: |
| begin |
| D := Temp1.ScanLine[y]; |
| S := Temp1.ScanLine[y]; |
| end; |
| else |
| end; |
| for x := 0 to Pred(Width) do |
| begin |
| case BitCount of |
| 32: ; |
| 24: |
| begin |
| Gray := Grays[PBGR(D)^.R + PBGR(D)^.G + PBGR(D)^.B]; |
| PBGR(D)^.B := IntToByte(Gray + Alpha[PBGR(D)^.B]); |
| PBGR(D)^.G := IntToByte(Gray + Alpha[PBGR(D)^.G]); |
| PBGR(D)^.R := IntToByte(Gray + Alpha[PBGR(D)^.R]); |
| Inc(PBGR(D)); |
| end; |
| 16: |
| begin |
| pfGetRGB(NowPixelFormat, PWord(D)^, R, G, B); |
| PWord(D)^ := IntToByte(Gray + Alpha[B]) + IntToByte(Gray + Alpha[G]) + |
| IntToByte(Gray + Alpha[R]); |
| Inc(PWord(D)); |
| end; |
| 8: |
| begin |
| with Temp1.ColorTable[PByte(S)^] do |
| color := rgbRed + rgbGreen + rgbBlue; |
| Inc(PByte(S)); |
| PByte(D)^ := color; |
| Inc(PByte(D)); |
| end; |
| 4: |
| begin |
| with Temp1.ColorTable[PByte(S)^] do |
| color := rgbRed + rgbGreen + rgbBlue; |
| Inc(PByte(S)); |
| P := @PArrayByte(D)[X shr 1]; |
| P^ := (P^ and Mask4n[X and 1]) or (color shl Shift4[X and 1]); |
| end; |
| else |
| end; |
| end; |
| end; |
| case BitCount of |
| 8, 4: Temp1.Free; |
| else |
| end; |
| end; |
| P1 := ScanLine[y]; |
| |
| procedure TDIB.Lightness(Amount: Integer); |
| var |
| x, y: Integer; |
| Table1: array[0..255] of Byte; |
| i: Byte; |
| S, D: pointer; |
| Temp1: TDIB; |
| color: DWORD; |
| P: PByte; |
| R, G, B: Byte; |
| begin |
| D := nil; |
| S := nil; |
| Temp1 := nil; |
| if Amount < 0 then |
| begin |
| Amount := -Amount; |
| for i := 0 to 255 do |
| Table1[i] := IntToByte(i - ((Amount * i) shr 8)); |
| end |
| else |
| for i := 0 to 255 do |
| Table1[i] := IntToByte(i + ((Amount * (i xor 255)) shr 8)); |
| case BitCount of |
| 32: Exit; // I haven't bitmap of this type ! Sorry |
| 24: ; // nothing to do |
| 16: ; // I have an artificial bitmap for this type ! i don't sure that it works |
| 8, 4: |
| 1 : begin |
| for x:=0 to Width2-1 do |
| begin |
| Temp1 := TDIB.Create; |
| Temp1.Assign(self); |
| Temp1.SetSize(Width, Height, BitCount); |
| for i := 0 to 255 do |
| begin |
| with ColorTable[i] do |
| begin |
| rgbRed := IntToByte(Table1[rgbRed]); |
| rgbGreen := IntToByte(Table1[rgbGreen]); |
| rgbBlue := IntToByte(Table1[rgbBlue]); |
| c := Pixels[x, y]; |
| Pixels[x, y] := Pixels[Width-x-1, y]; |
| Pixels[Width-x-1, y] := c; |
| end; |
| end; |
| UpdatePalette; |
| end; |
| else |
| // if the number of pixel is equal to 1 then exit of procedure |
| Exit; |
| end; |
| for y := 0 to Pred(Height) do |
| 4 : begin |
| for x:=0 to Width2-1 do |
| begin |
| case BitCount of |
| 24, 16: D := ScanLine[y]; |
| 8, 4: |
| begin |
| D := Temp1.ScanLine[y]; |
| S := Temp1.ScanLine[y]; |
| c := Pixels[x, y]; |
| Pixels[x, y] := Pixels[Width-x-1, y]; |
| Pixels[Width-x-1, y] := c; |
| end; |
| else |
| end; |
| for x := 0 to Pred(Width) do |
| 8 : begin |
| P2 := Pointer(Integer(P1)+Width-1); |
| for x:=0 to Width2-1 do |
| begin |
| case BitCount of |
| 32: ; |
| 24: |
| begin |
| PBGR(D)^.B := Table1[PBGR(D)^.B]; |
| PBGR(D)^.G := Table1[PBGR(D)^.G]; |
| PBGR(D)^.R := Table1[PBGR(D)^.R]; |
| Inc(PBGR(D)); |
| PByte(@c)^ := PByte(P1)^; |
| PByte(P1)^ := PByte(P2)^; |
| PByte(P2)^ := PByte(@c)^; |
| Inc(PByte(P1)); |
| Dec(PByte(P2)); |
| end; |
| 16: |
| begin |
| pfGetRGB(NowPixelFormat, PWord(D)^, R, G, B); |
| PWord(D)^ := Table1[R] + Table1[G] + Table1[B]; |
| Inc(PWord(D)); |
| end; |
| 8: |
| 16: begin |
| P2 := Pointer(Integer(P1)+(Width-1)*2); |
| for x:=0 to Width2-1 do |
| begin |
| with Temp1.ColorTable[PByte(S)^] do |
| color := rgbRed + rgbGreen + rgbBlue; |
| Inc(PByte(S)); |
| PByte(D)^ := color; |
| Inc(PByte(D)); |
| PWord(@c)^ := PWord(P1)^; |
| PWord(P1)^ := PWord(P2)^; |
| PWord(P2)^ := PWord(@c)^; |
| Inc(PWord(P1)); |
| Dec(PWord(P2)); |
| end; |
| 4: |
| begin |
| with Temp1.ColorTable[PByte(S)^] do |
| color := rgbRed + rgbGreen + rgbBlue; |
| Inc(PByte(S)); |
| P := @PArrayByte(D)[X shr 1]; |
| P^ := (P^ and Mask4n[X and 1]) or (color shl Shift4[X and 1]); |
| end; |
| else |
| end; |
| end; |
| end; |
| case BitCount of |
| 8, 4: Temp1.Free; |
| else |
| end; |
| end; |
| |
| procedure TDIB.AddRGB(aR, aG, aB: Byte); |
| var |
| Table: array[0..255] of TBGR; |
| x, y: Integer; |
| i: Byte; |
| D: pointer; |
| P: PByte; |
| color: DWORD; |
| Temp1: TDIB; |
| R, G, B: Byte; |
| 24: begin |
| P2 := Pointer(Integer(P1)+(Width-1)*3); |
| for x:=0 to Width2-1 do |
| begin |
| color := 0; |
| D := nil; |
| Temp1 := nil; |
| case BitCount of |
| 32: Exit; // I haven't bitmap of this type ! Sorry |
| 24, 16: |
| begin |
| for i := 0 to 255 do |
| begin |
| Table[i].b := IntToByte(i + aB); |
| Table[i].g := IntToByte(i + aG); |
| Table[i].r := IntToByte(i + aR); |
| PBGR(@c)^ := PBGR(P1)^; |
| PBGR(P1)^ := PBGR(P2)^; |
| PBGR(P2)^ := PBGR(@c)^; |
| Inc(PBGR(P1)); |
| Dec(PBGR(P2)); |
| end; |
| end; |
| 8, 4: |
| 32: begin |
| P2 := Pointer(Integer(P1)+(Width-1)*4); |
| for x:=0 to Width2-1 do |
| begin |
| Temp1 := TDIB.Create; |
| Temp1.Assign(self); |
| Temp1.SetSize(Width, Height, BitCount); |
| for i := 0 to 255 do |
| begin |
| with ColorTable[i] do |
| begin |
| rgbRed := IntToByte(rgbRed + aR); |
| rgbGreen := IntToByte(rgbGreen + aG); |
| rgbBlue := IntToByte(rgbBlue + aB); |
| PDWORD(@c)^ := PDWORD(P1)^; |
| PDWORD(P1)^ := PDWORD(P2)^; |
| PDWORD(P2)^ := PDWORD(@c)^; |
| Inc(PDWORD(P1)); |
| Dec(PDWORD(P2)); |
| end; |
| end; |
| UpdatePalette; |
| end; |
| else |
| // if the number of pixel is equal to 1 then exit of procedure |
| Exit; |
| end; |
| for y := 0 to Pred(Height) do |
| begin |
| case BitCount of |
| 24, 16: D := ScanLine[y]; |
| 8, 4: |
| begin |
| D := Temp1.ScanLine[y]; |
| end; |
| else |
| end; |
| for x := 0 to Pred(Width) do |
| begin |
| case BitCount of |
| 32: ; // I haven't bitmap of this type ! Sorry |
| 24: |
| begin |
| PBGR(D)^.B := Table[PBGR(D)^.B].b; |
| PBGR(D)^.G := Table[PBGR(D)^.G].g; |
| PBGR(D)^.R := Table[PBGR(D)^.R].r; |
| Inc(PBGR(D)); |
| end; |
| 16: |
| begin |
| pfGetRGB(NowPixelFormat, PWord(D)^, R, G, B); |
| PWord(D)^ := Table[R].r + Table[G].g + Table[B].b; |
| Inc(PWord(D)); |
| end; |
| 8: |
| begin |
| Inc(PByte(D)); |
| end; |
| 4: |
| begin |
| P := @PArrayByte(D)[X shr 1]; |
| P^ := (P^ and Mask4n[X and 1]) or (color shl Shift4[X and 1]); |
| end; |
| else |
| end; |
| end; |
| end; |
| case BitCount of |
| 8, 4: Temp1.Free; |
| else |
| end; |
| end; |
| |
| function TDIB.Filter(Dest: TDIB; Filter: TFilter): Boolean; |
| var |
| Sum, r, g, b, x, y: Integer; |
| a, i, j: byte; |
| tmp: TBGR; |
| Col: PBGR; |
| D: Pointer; |
| begin |
| Result := True; |
| Sum := Filter[0, 0] + Filter[1, 0] + Filter[2, 0] + |
| Filter[0, 1] + Filter[1, 1] + Filter[2, 1] + |
| Filter[0, 2] + Filter[1, 2] + Filter[2, 2]; |
| if Sum = 0 then |
| Sum := 1; |
| Col := PBits; |
| for y := 0 to Pred(Height) do |
| begin |
| D := Dest.ScanLine[y]; |
| for x := 0 to Pred(Width) do |
| begin |
| r := 0; g := 0; b := 0; |
| case BitCount of |
| 32, 16, 4, 1: |
| begin |
| Result := False; |
| Exit; |
| UpdateProgress(y); |
| end; |
| 24: |
| begin |
| for i := 0 to 2 do |
| begin |
| for j := 0 to 2 do |
| begin |
| Tmp := IntToColor(Pixels[Interval(0, Pred(Width), x + Pred(i), True), |
| Interval(0, Pred(Height), y + Pred(j), True)]); |
| Inc(b, Filter[i, j] * Tmp.b); |
| Inc(g, Filter[i, j] * Tmp.g); |
| Inc(r, Filter[i, j] * Tmp.r); |
| finally |
| EndProgress; |
| end; |
| end; |
| Col.b := IntToByte(b div Sum); |
| Col.g := IntToByte(g div Sum); |
| Col.r := IntToByte(r div Sum); |
| Dest.Pixels[x, y] := rgb(Col.r, Col.g, Col.b); |
| end; |
| 8: |
| end else if (MirrorX) and (MirrorY) then |
| begin |
| for i := 0 to 2 do |
| StartProgress('Mirror'); |
| try |
| for y:=0 to Height shr 1-1 do |
| begin |
| for j := 0 to 2 do |
| begin |
| a := (Pixels[Interval(0, Pred(Width), x + Pred(i), True), |
| Interval(0, Pred(Height), y + Pred(j), True)]); |
| tmp.r := ColorTable[a].rgbRed; |
| tmp.g := ColorTable[a].rgbGreen; |
| tmp.b := ColorTable[a].rgbBlue; |
| Inc(b, Filter[i, j] * Tmp.b); |
| Inc(g, Filter[i, j] * Tmp.g); |
| Inc(r, Filter[i, j] * Tmp.r); |
| end; |
| end; |
| Col.b := IntToByte(b div Sum); |
| Col.g := IntToByte(g div Sum); |
| Col.r := IntToByte(r div Sum); |
| PByte(D)^ := rgb(Col.r, Col.g, Col.b); |
| Inc(PByte(D)); |
| end; |
| end; |
| end; |
| end; |
| end; |
| P1 := ScanLine[y]; |
| P2 := ScanLine[Height-y-1]; |
| |
| procedure TDIB.Spray(Amount: Integer); |
| var |
| value, x, y: Integer; |
| D: Pointer; |
| color: DWORD; |
| P: PByte; |
| begin |
| for y := Pred(Height) downto 0 do |
| begin |
| D := ScanLine[y]; |
| for x := 0 to Pred(Width) do |
| begin |
| value := Random(Amount); |
| color := Pixels[Interval(0, Pred(Width), x + (value - Random(value * 2)), True), |
| Interval(0, Pred(Height), y + (value - Random(value * 2)), True)]; |
| case BitCount of |
| 32: |
| 1 : begin |
| for x:=0 to Width-1 do |
| begin |
| PDWord(D)^ := color; |
| Inc(PDWord(D)); |
| c := Pixels[x, y]; |
| Pixels[x, y] := Pixels[Width-x-1, Height-y-1]; |
| Pixels[Width-x-1, Height-y-1] := c; |
| end; |
| 24: |
| begin |
| PBGR(D)^ := IntToColor(color); |
| Inc(PBGR(D)); |
| end; |
| 16: |
| 4 : begin |
| for x:=0 to Width-1 do |
| begin |
| PWord(D)^ := color; |
| Inc(PWord(D)); |
| c := Pixels[x, y]; |
| Pixels[x, y] := Pixels[Width-x-1, Height-y-1]; |
| Pixels[Width-x-1, Height-y-1] := c; |
| end; |
| 8: |
| begin |
| PByte(D)^ := color; |
| Inc(PByte(D)); |
| end; |
| 4: |
| 8 : begin |
| P2 := Pointer(Integer(P2)+Width-1); |
| for x:=0 to Width-1 do |
| begin |
| P := @PArrayByte(D)[X shr 1]; |
| P^ := (P^ and Mask4n[X and 1]) or (color shl Shift4[X and 1]); |
| PByte(@c)^ := PByte(P1)^; |
| PByte(P1)^ := PByte(P2)^; |
| PByte(P2)^ := PByte(@c)^; |
| Inc(PByte(P1)); |
| Dec(PByte(P2)); |
| end; |
| 1: |
| begin |
| P := @PArrayByte(D)[X shr 3]; |
| P^ := (P^ and Mask1n[X and 7]) or (color shl Shift1[X and 7]); |
| end; |
| else |
| end; |
| end; |
| end; |
| end; |
| |
| procedure TDIB.Sharpen(Amount: Integer); |
| var |
| Lin0, Lin1, Lin2: PLines; |
| pc: PBGR; |
| cx, x, y: Integer; |
| Buf: array[0..8] of TBGR; |
| D: pointer; |
| c: DWORD; |
| i: byte; |
| P1: PByte; |
| Temp1: TDIB; |
| |
| 16: begin |
| P2 := Pointer(Integer(P2)+(Width-1)*2); |
| for x:=0 to Width-1 do |
| begin |
| D := nil; |
| GetMem(pc, SizeOf(TBGR)); |
| c := 0; |
| Temp1 := nil; |
| case Bitcount of |
| 32, 16, 1: Exit; |
| 24: |
| begin |
| Temp1 := TDIB.Create; |
| Temp1.Assign(self); |
| Temp1.SetSize(Width, Height, bitCount); |
| PWord(@c)^ := PWord(P1)^; |
| PWord(P1)^ := PWord(P2)^; |
| PWord(P2)^ := PWord(@c)^; |
| Inc(PWord(P1)); |
| Dec(PWord(P2)); |
| end; |
| 8: |
| begin |
| Temp1 := TDIB.Create; |
| Temp1.Assign(self); |
| Temp1.SetSize(Width, Height, bitCount); |
| for i := 0 to 255 do |
| begin |
| with Temp1.ColorTable[i] do |
| begin |
| Buf[0].B := ColorTable[i - Amount].rgbBlue; |
| Buf[0].G := ColorTable[i - Amount].rgbGreen; |
| Buf[0].R := ColorTable[i - Amount].rgbRed; |
| Buf[1].B := ColorTable[i].rgbBlue; |
| Buf[1].G := ColorTable[i].rgbGreen; |
| Buf[1].R := ColorTable[i].rgbRed; |
| Buf[2].B := ColorTable[i + Amount].rgbBlue; |
| Buf[2].G := ColorTable[i + Amount].rgbGreen; |
| Buf[2].R := ColorTable[i + Amount].rgbRed; |
| Buf[3].B := ColorTable[i - Amount].rgbBlue; |
| Buf[3].G := ColorTable[i - Amount].rgbGreen; |
| Buf[3].R := ColorTable[i - Amount].rgbRed; |
| Buf[4].B := ColorTable[i].rgbBlue; |
| Buf[4].G := ColorTable[i].rgbGreen; |
| Buf[4].R := ColorTable[i].rgbRed; |
| Buf[5].B := ColorTable[i + Amount].rgbBlue; |
| Buf[5].G := ColorTable[i + Amount].rgbGreen; |
| Buf[5].R := ColorTable[i + Amount].rgbRed; |
| Buf[6].B := ColorTable[i - Amount].rgbBlue; |
| Buf[6].G := ColorTable[i - Amount].rgbGreen; |
| Buf[6].R := ColorTable[i - Amount].rgbRed; |
| Buf[7].B := ColorTable[i].rgbBlue; |
| Buf[7].G := ColorTable[i].rgbGreen; |
| Buf[7].R := ColorTable[i].rgbRed; |
| Buf[8].B := ColorTable[i + Amount].rgbBlue; |
| Buf[8].G := ColorTable[i + Amount].rgbGreen; |
| Buf[8].R := ColorTable[i + Amount].rgbRed; |
| Temp1.colorTable[i].rgbBlue := IntToByte((256 * Buf[4].b - (Buf[0].b + Buf[1].b + Buf[2].b + Buf[3].b + |
| Buf[5].b + Buf[6].b + Buf[7].b + Buf[8].b) * 16) div 128); |
| Temp1.colorTable[i].rgbGreen := IntToByte((256 * Buf[4].g - (Buf[0].g + Buf[1].g + Buf[2].g + Buf[3].g + |
| Buf[5].g + Buf[6].g + Buf[7].g + Buf[8].g) * 16) div 128); |
| Temp1.colorTable[i].rgbRed := IntToByte((256 * Buf[4].r - (Buf[0].r + Buf[1].r + Buf[2].r + Buf[3].r + |
| Buf[5].r + Buf[6].r + Buf[7].r + Buf[8].r) * 16) div 128); |
| |
| end; |
| end; |
| Temp1.UpdatePalette; |
| end; |
| 4: |
| 24: begin |
| P2 := Pointer(Integer(P2)+(Width-1)*3); |
| for x:=0 to Width-1 do |
| begin |
| Temp1 := TDIB.Create; |
| Temp1.Assign(self); |
| Temp1.SetSize(Width, Height, bitCount); |
| for i := 0 to 255 do |
| begin |
| with Temp1.ColorTable[i] do |
| begin |
| Buf[0].B := ColorTable[i - Amount].rgbBlue; |
| Buf[0].G := ColorTable[i - Amount].rgbGreen; |
| Buf[0].R := ColorTable[i - Amount].rgbRed; |
| Buf[1].B := ColorTable[i].rgbBlue; |
| Buf[1].G := ColorTable[i].rgbGreen; |
| Buf[1].R := ColorTable[i].rgbRed; |
| Buf[2].B := ColorTable[i + Amount].rgbBlue; |
| Buf[2].G := ColorTable[i + Amount].rgbGreen; |
| Buf[2].R := ColorTable[i + Amount].rgbRed; |
| Buf[3].B := ColorTable[i - Amount].rgbBlue; |
| Buf[3].G := ColorTable[i - Amount].rgbGreen; |
| Buf[3].R := ColorTable[i - Amount].rgbRed; |
| Buf[4].B := ColorTable[i].rgbBlue; |
| Buf[4].G := ColorTable[i].rgbGreen; |
| Buf[4].R := ColorTable[i].rgbRed; |
| Buf[5].B := ColorTable[i + Amount].rgbBlue; |
| Buf[5].G := ColorTable[i + Amount].rgbGreen; |
| Buf[5].R := ColorTable[i + Amount].rgbRed; |
| Buf[6].B := ColorTable[i - Amount].rgbBlue; |
| Buf[6].G := ColorTable[i - Amount].rgbGreen; |
| Buf[6].R := ColorTable[i - Amount].rgbRed; |
| Buf[7].B := ColorTable[i].rgbBlue; |
| Buf[7].G := ColorTable[i].rgbGreen; |
| Buf[7].R := ColorTable[i].rgbRed; |
| Buf[8].B := ColorTable[i + Amount].rgbBlue; |
| Buf[8].G := ColorTable[i + Amount].rgbGreen; |
| Buf[8].R := ColorTable[i + Amount].rgbRed; |
| colorTable[i].rgbBlue := IntToByte((256 * Buf[4].b - (Buf[0].b + Buf[1].b + Buf[2].b + Buf[3].b + |
| Buf[5].b + Buf[6].b + Buf[7].b + Buf[8].b) * 16) div 128); |
| colorTable[i].rgbGreen := IntToByte((256 * Buf[4].g - (Buf[0].g + Buf[1].g + Buf[2].g + Buf[3].g + |
| Buf[5].g + Buf[6].g + Buf[7].g + Buf[8].g) * 16) div 128); |
| colorTable[i].rgbRed := IntToByte((256 * Buf[4].r - (Buf[0].r + Buf[1].r + Buf[2].r + Buf[3].r + |
| Buf[5].r + Buf[6].r + Buf[7].r + Buf[8].r) * 16) div 128); |
| PBGR(@c)^ := PBGR(P1)^; |
| PBGR(P1)^ := PBGR(P2)^; |
| PBGR(P2)^ := PBGR(@c)^; |
| Inc(PBGR(P1)); |
| Dec(PBGR(P2)); |
| end; |
| end; |
| UpdatePalette; |
| end; |
| end; |
| for y := 0 to Pred(Height) do |
| 32: begin |
| P2 := Pointer(Integer(P2)+(Width-1)*4); |
| for x:=0 to Width-1 do |
| begin |
| Lin0 := ScanLine[Interval(0, Pred(Height), y - Amount, True)]; |
| Lin1 := ScanLine[y]; |
| Lin2 := ScanLine[Interval(0, Pred(Height), y + Amount, True)]; |
| case Bitcount of |
| 24, 8, 4: D := Temp1.ScanLine[y]; |
| PDWORD(@c)^ := PDWORD(P1)^; |
| PDWORD(P1)^ := PDWORD(P2)^; |
| PDWORD(P2)^ := PDWORD(@c)^; |
| Inc(PDWORD(P1)); |
| Dec(PDWORD(P2)); |
| end; |
| for x := 0 to Pred(Width) do |
| begin |
| case BitCount of |
| 24: |
| begin |
| cx := Interval(0, Pred(Width), x - Amount, True); |
| Buf[0] := Lin0[cx]; |
| Buf[1] := Lin1[cx]; |
| Buf[2] := Lin2[cx]; |
| Buf[3] := Lin0[x]; |
| Buf[4] := Lin1[x]; |
| Buf[5] := Lin2[x]; |
| cx := Interval(0, Pred(Width), x + Amount, true); |
| Buf[6] := Lin0[cx]; |
| Buf[7] := Lin1[cx]; |
| Buf[8] := Lin0[cx]; |
| pc.b := IntToByte((256 * Buf[4].b - (Buf[0].b + Buf[1].b + Buf[2].b + Buf[3].b + |
| Buf[5].b + Buf[6].b + Buf[7].b + Buf[8].b) * 16) div 128); |
| pc.g := IntToByte((256 * Buf[4].g - (Buf[0].g + Buf[1].g + Buf[2].g + Buf[3].g + |
| Buf[5].g + Buf[6].g + Buf[7].g + Buf[8].g) * 16) div 128); |
| pc.r := IntToByte((256 * Buf[4].r - (Buf[0].r + Buf[1].r + Buf[2].r + Buf[3].r + |
| Buf[5].r + Buf[6].r + Buf[7].r + Buf[8].r) * 16) div 128); |
| PBGR(D)^.B := pc.b; |
| PBGR(D)^.G := pc.g; |
| PBGR(D)^.R := pc.r; |
| Inc(PBGR(D)); |
| end; |
| 8: |
| begin |
| Inc(PByte(D)); |
| end; |
| 4: |
| begin |
| P1 := @PArrayByte(D)[X shr 1]; |
| P1^ := ((P1^ and Mask4n[X and 1]) or ((c shl Shift4[X and 1]))); |
| end; |
| end; |
| end; |
| end; |
| case BitCount of |
| 24, 8: |
| begin |
| Assign(Temp1); |
| Temp1.Free; |
| end; |
| 4: Temp1.Free; |
| end; |
| FreeMem(pc, SizeOf(TBGR)); |
| end; |
| |
| procedure TDIB.Emboss; |
| var |
| x, y: longint; |
| D, D1, P: pointer; |
| color: TBGR; |
| c: DWORD; |
| P1: PByte; |
| |
| begin |
| D := nil; |
| D1 := nil; |
| P := nil; |
| case BitCount of |
| 32, 16, 1: Exit; |
| 24: |
| begin |
| D := PBits; |
| D1 := Ptr(Integer(D) + 3); |
| UpdateProgress(y*2); |
| end; |
| else |
| finally |
| EndProgress; |
| end; |
| for y := 0 to Pred(Height) do |
| begin |
| case Bitcount of |
| 8, 4: |
| begin |
| P := ScanLine[y]; |
| end; |
| end; |
| for x := 0 to Pred(Width) do |
| begin |
| case BitCount of |
| 24: |
| begin |
| PBGR(D)^.B := ((PBGR(D)^.B + (PBGR(D1)^.B xor $FF)) shr 1); |
| PBGR(D)^.G := ((PBGR(D)^.G + (PBGR(D1)^.G xor $FF)) shr 1); |
| PBGR(D)^.R := ((PBGR(D)^.R + (PBGR(D1)^.R xor $FF)) shr 1); |
| Inc(PBGR(D)); |
| if (y < Height - 2) and (x < Width - 2) then |
| Inc(PBGR(D1)); |
| end; |
| 8: |
| begin |
| color.R := (((Pixels[x, y] + (Pixels[x + 3, y] xor $FF)) shr 1) + 30) div 3; |
| color.G := (((Pixels[x, y] + (Pixels[x + 3, y] xor $FF)) shr 1) + 30) div 3; |
| color.B := (((Pixels[x, y] + (Pixels[x + 3, y] xor $FF)) shr 1) + 30) div 3; |
| c := (color.R + color.G + color.B) shr 1; |
| PByte(P)^ := c; |
| Inc(PByte(P)); |
| end; |
| 4: |
| begin |
| color.R := (((Pixels[x, y] + (Pixels[x + 3, y] xor $FF) + 1) shr 1) + 30) div 3; |
| color.G := (((Pixels[x, y] + (Pixels[x + 3, y] xor $FF) - 1) shr 1) + 30) div 3; |
| color.B := (((Pixels[x, y] + (Pixels[x + 3, y] xor $FF) + 1) shr 1) + 30) div 3; |
| c := (color.R + color.G + color.B) shr 1; |
| if c > 64 then |
| c := c - 8; |
| P1 := @PArrayByte(P)[X shr 1]; |
| P1^ := (P1^ and Mask4n[X and 1]) or ((c) shl Shift4[X and 1]); |
| end; |
| else |
| end; |
| end; |
| case BitCount of |
| 24: |
| begin |
| D := Ptr(Integer(D1)); |
| if y < Height - 2 then |
| D1 := Ptr(Integer(D1) + 6) |
| else |
| D1 := Ptr(Integer(ScanLine[Pred(Height)]) + 3); |
| end; |
| else |
| end; |
| end; |
| end; |
| |
| procedure TDIB.AddMonoNoise(Amount: Integer); |
| procedure TDIB.Negative; |
| var |
| value: cardinal; |
| x, y: longint; |
| a: byte; |
| D: pointer; |
| color: DWORD; |
| P: PByte; |
| i, i2: Integer; |
| P: Pointer; |
| begin |
| for y := 0 to Pred(Height) do |
| begin |
| D := ScanLine[y]; |
| for x := 0 to Pred(Width) do |
| begin |
| case BitCount of |
| 32: Exit; // I haven't bitmap of this type ! Sorry |
| 24: |
| begin |
| value := Random(Amount) - (Amount shr 1); |
| PBGR(D)^.B := IntToByte(PBGR(D)^.B + value); |
| PBGR(D)^.G := IntToByte(PBGR(D)^.G + value); |
| PBGR(D)^.R := IntToByte(PBGR(D)^.R + value); |
| Inc(PBGR(D)); |
| end; |
| 16: Exit; // I haven't bitmap of this type ! Sorry |
| 8: |
| begin |
| a := ((Random(Amount shr 1) - (Amount div 4))) div 8; |
| color := Interval(0, 255, (pixels[x, y] - a), True); |
| PByte(D)^ := color; |
| Inc(PByte(D)); |
| end; |
| 4: |
| begin |
| a := ((Random(Amount shr 1) - (Amount div 4))) div 16; |
| color := Interval(0, 15, (pixels[x, y] - a), True); |
| P := @PArrayByte(D)[X shr 1]; |
| P^ := ((P^ and Mask4n[X and 1]) or ((color shl Shift4[X and 1]))); |
| end; |
| 1: |
| begin |
| a := ((Random(Amount shr 1) - (Amount div 4))) div 32; |
| color := Interval(0, 1, (pixels[x, y] - a), True); |
| P := @PArrayByte(D)[X shr 3]; |
| P^ := (P^ and Mask1n[X and 7]) or (color shl Shift1[X and 7]); |
| end; |
| else |
| end; |
| end; |
| end; |
| end; |
| if Empty then exit; |
| |
| procedure TDIB.AddGradiantNoise(Amount: byte); |
| var |
| a, i: byte; |
| x, y: Integer; |
| Table: array[0..255] of TBGR; |
| S, D: pointer; |
| color: DWORD; |
| Temp1: TDIB; |
| P: PByte; |
| |
| if BitCount<=8 then |
| begin |
| D := nil; |
| S := nil; |
| Temp1 := nil; |
| case BitCount of |
| 32: Exit; // I haven't bitmap of this type ! Sorry |
| 24: |
| begin |
| for i := 0 to 255 do |
| begin |
| a := Random(Amount); |
| Table[i].b := IntToByte(i + a); |
| Table[i].g := IntToByte(i + a); |
| Table[i].r := IntToByte(i + a); |
| end; |
| end; |
| 16: Exit; // I haven't bitmap of this type ! Sorry |
| 8, 4: |
| begin |
| Temp1 := TDIB.Create; |
| Temp1.Assign(self); |
| Temp1.SetSize(Width, Height, BitCount); |
| for i := 0 to 255 do |
| begin |
| with ColorTable[i] do |
| begin |
| a := Random(Amount); |
| rgbRed := IntToByte(rgbRed + a); |
| rgbGreen := IntToByte(rgbGreen + a); |
| rgbBlue := IntToByte(rgbBlue + a); |
| rgbRed := 255-rgbRed; |
| rgbGreen := 255-rgbGreen; |
| rgbBlue := 255-rgbBlue; |
| end; |
| end; |
| UpdatePalette; |
| end; |
| else |
| // if the number of pixel is equal to 1 then exit of procedure |
| Exit; |
| end; |
| for y := 0 to Pred(Height) do |
| end else |
| begin |
| case BitCount of |
| 24: D := ScanLine[y]; |
| 8, 4: |
| begin |
| D := Temp1.ScanLine[y]; |
| S := Temp1.ScanLine[y]; |
| end; |
| else |
| end; |
| for x := 0 to Pred(Width) do |
| begin |
| case BitCount of |
| 32: ; // I haven't bitmap of this type ! Sorry |
| 24: |
| begin |
| PBGR(D)^.B := Table[PBGR(D)^.B].b; |
| PBGR(D)^.G := Table[PBGR(D)^.G].g; |
| PBGR(D)^.R := Table[PBGR(D)^.R].r; |
| Inc(PBGR(D)); |
| end; |
| 16: ; // I haven't bitmap of this type ! Sorry |
| 8: |
| begin |
| with Temp1.ColorTable[PByte(S)^] do |
| color := rgbRed + rgbGreen + rgbBlue; |
| Inc(PByte(S)); |
| PByte(D)^ := color; |
| Inc(PByte(D)); |
| end; |
| 4: |
| begin |
| with Temp1.ColorTable[PByte(S)^] do |
| color := rgbRed + rgbGreen + rgbBlue; |
| Inc(PByte(S)); |
| P := @PArrayByte(D)[X shr 1]; |
| P^ := (P^ and Mask4n[X and 1]) or (color shl Shift4[X and 1]); |
| end; |
| else |
| end; |
| end; |
| end; |
| case BitCount of |
| 8, 4: Temp1.Free; |
| else |
| end; |
| end; |
| P := PBits; |
| i2 := Size; |
| asm |
| mov ecx,i2 |
| mov eax,P |
| mov edx,ecx |
| |
| function TDIB.FishEye(bmp: TDIB): Boolean; |
| var |
| weight, xmid, ymid, fx, fy, r1, r2, dx, dy, rmax: Double; |
| Amount, ifx, ify, ty, tx, new_red, new_green, new_blue, ix, iy: Integer; |
| weight_x, weight_y: array[0..1] of Double; |
| total_red, total_green, total_blue: Double; |
| sli, slo: PLines; |
| D: Pointer; |
| begin |
| Result := True; |
| case BitCount of |
| 32, 16, 8, 4, 1: |
| begin |
| Result := False; |
| Exit; |
| end; |
| end; |
| Amount := 1; |
| xmid := Width / 2; |
| ymid := Height / 2; |
| rmax := Max(Bmp.Width, Bmp.Height) * Amount; |
| for ty := 0 to Pred(Height) do |
| begin |
| for tx := 0 to Pred(Width) do |
| begin |
| dx := tx - xmid; |
| dy := ty - ymid; |
| r1 := Sqrt(Sqr(dx) + Sqr(dy)); |
| if r1 <> 0 then |
| begin |
| r2 := rmax / 2 * (1 / (1 - r1 / rmax) - 1); |
| fx := dx * r2 / r1 + xmid; |
| fy := dy * r2 / r1 + ymid; |
| end |
| else |
| begin |
| fx := xmid; |
| fy := ymid; |
| end; |
| ify := Trunc(fy); |
| ifx := Trunc(fx); |
| 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 := Pred(Width) - (-ifx mod Width) |
| else |
| if ifx > Pred(Width) then |
| ifx := ifx mod Width; |
| if ify < 0 then |
| ify := Pred(Height) - (-ify mod Height) |
| else |
| if ify > Pred(Height) then |
| ify := ify mod 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 < Height then |
| sli := ScanLine[ify + iy] |
| else |
| sli := ScanLine[Height - ify - iy]; |
| if ifx + ix < Width then |
| begin |
| new_red := sli^[ifx + ix].r; |
| new_green := sli^[ifx + ix].g; |
| new_blue := sli^[ifx + ix].b; |
| end |
| else |
| begin |
| new_red := sli^[Width - ifx - ix].r; |
| new_green := sli^[Width - ifx - ix].g; |
| new_blue := sli^[Width - ifx - ix].b; |
| 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; |
| case bitCount of |
| 24: |
| begin |
| slo := Bmp.ScanLine[ty]; |
| slo^[tx].r := Round(total_red); |
| slo^[tx].g := Round(total_green); |
| slo^[tx].b := Round(total_blue); |
| end; |
| else |
| // You can implement this procedure for 16,8,4,2 and 32 BitCount's DIB |
| Exit; |
| end; |
| end; |
| end; |
| end; |
| { Unit of DWORD. } |
| @@qword_skip: |
| shr ecx,2 |
| jz @@dword_skip |
| |
| function TDIB.SmoothRotateWrap(Bmp: TDIB; cx, cy: Integer; Degree: Extended): Boolean; |
| var |
| weight, Theta, cosTheta, sinTheta, sfrom_y, sfrom_x: Double; |
| ifrom_y, ifrom_x, xDiff, yDiff, to_y, to_x: Integer; |
| weight_x, weight_y: array[0..1] of Double; |
| ix, iy, new_red, new_green, new_blue: Integer; |
| total_red, total_green, total_blue: Double; |
| sli, slo: PLines; |
| begin |
| Result := True; |
| case BitCount of |
| 32, 16, 8, 4, 1: |
| begin |
| Result := False; |
| Exit; |
| end; |
| end; |
| Theta := -Degree * Pi / 180; |
| sinTheta := Sin(Theta); |
| cosTheta := Cos(Theta); |
| xDiff := (Bmp.Width - Width) div 2; |
| yDiff := (Bmp.Height - Height) div 2; |
| for to_y := 0 to Pred(Bmp.Height) do |
| begin |
| for to_x := 0 to Pred(Bmp.Width) do |
| begin |
| sfrom_x := (cx + (to_x - cx) * cosTheta - (to_y - cy) * sinTheta) - xDiff; |
| ifrom_x := Trunc(sfrom_x); |
| sfrom_y := (cy + (to_x - cx) * sinTheta + (to_y - cy) * cosTheta) - yDiff; |
| ifrom_y := Trunc(sfrom_y); |
| if sfrom_y >= 0 then |
| begin |
| weight_y[1] := sfrom_y - ifrom_y; |
| weight_y[0] := 1 - weight_y[1]; |
| end |
| else |
| begin |
| weight_y[0] := -(sfrom_y - ifrom_y); |
| weight_y[1] := 1 - weight_y[0]; |
| end; |
| if sfrom_x >= 0 then |
| begin |
| weight_x[1] := sfrom_x - ifrom_x; |
| weight_x[0] := 1 - weight_x[1]; |
| end |
| else |
| begin |
| weight_x[0] := -(sfrom_x - ifrom_x); |
| Weight_x[1] := 1 - weight_x[0]; |
| end; |
| if ifrom_x < 0 then |
| ifrom_x := Pred(Width) - (-ifrom_x mod Width) |
| else |
| if ifrom_x > Pred(Width) then |
| ifrom_x := ifrom_x mod Width; |
| if ifrom_y < 0 then |
| ifrom_y := Pred(Height) - (-ifrom_y mod Height) |
| else |
| if ifrom_y > Pred(Height) then |
| ifrom_y := ifrom_y mod 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 ifrom_y + iy < Height then |
| sli := ScanLine[ifrom_y + iy] |
| else |
| sli := ScanLine[Height - ifrom_y - iy]; |
| if ifrom_x + ix < Width then |
| begin |
| new_red := sli^[ifrom_x + ix].r; |
| new_green := sli^[ifrom_x + ix].g; |
| new_blue := sli^[ifrom_x + ix].b; |
| end |
| else |
| begin |
| new_red := sli^[Width - ifrom_x - ix].r; |
| new_green := sli^[Width - ifrom_x - ix].g; |
| new_blue := sli^[Width - ifrom_x - ix].b; |
| 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; |
| case bitCount of |
| 24: |
| begin |
| slo := Bmp.ScanLine[to_y]; |
| slo^[to_x].r := Round(total_red); |
| slo^[to_x].g := Round(total_green); |
| slo^[to_x].b := Round(total_blue); |
| end; |
| else |
| // You can implement this procedure for 16,8,4,2 and 32 BitCount's DIB |
| Exit; |
| end; |
| end; |
| end; |
| end; |
| dec ecx |
| @@dword_loop: |
| not dword ptr [eax+ecx*4] |
| dec ecx |
| jnl @@dword_loop |
| |
| function TDIB.Rotate(Dst: TDIB; cx, cy: Integer; Angle: Double): Boolean; |
| var |
| x, y, dx, dy, sdx, sdy, xDiff, yDiff, isinTheta, icosTheta: Integer; |
| D, S: Pointer; |
| sinTheta, cosTheta, Theta: Double; |
| Col: TBGR; |
| i: byte; |
| color: DWORD; |
| P: PByte; |
| begin |
| D := nil; |
| S := nil; |
| Result := True; |
| dst.SetSize(Width, Height, Bitcount); |
| dst.Canvas.Brush.Color := clBlack; |
| Dst.Canvas.FillRect(Bounds(0, 0, Width, Height)); |
| case BitCount of |
| 32, 16: |
| begin |
| Result := False; |
| Exit; |
| end; |
| 8, 4, 1: |
| begin |
| for i := 0 to 255 do |
| Dst.ColorTable[i] := ColorTable[i]; |
| Dst.UpdatePalette; |
| end; |
| end; |
| Theta := -Angle * Pi / 180; |
| sinTheta := Sin(Theta); |
| cosTheta := Cos(Theta); |
| xDiff := (Dst.Width - Width) div 2; |
| yDiff := (Dst.Height - Height) div 2; |
| isinTheta := Round(sinTheta * $10000); |
| icosTheta := Round(cosTheta * $10000); |
| for y := 0 to Pred(Dst.Height) do |
| begin |
| case BitCount of |
| 4, 1: |
| begin |
| D := Dst.ScanLine[y]; |
| S := ScanLine[y]; |
| end; |
| else |
| end; |
| sdx := Round(((cx + (-cx) * cosTheta - (y - cy) * sinTheta) - xDiff) * $10000); |
| sdy := Round(((cy + (-cy) * sinTheta + (y - cy) * cosTheta) - yDiff) * $10000); |
| for x := 0 to Pred(Dst.Width) do |
| begin |
| dx := (sdx shr 16); |
| dy := (sdy shr 16); |
| if (dx > -1) and (dx < Width) and (dy > -1) and (dy < Height) then |
| begin |
| case bitcount of |
| 8, 24: Dst.pixels[x, y] := Pixels[dx, dy]; |
| 4: |
| begin |
| pfGetRGB(NowPixelFormat, Pixels[dx, dy], col.r, col.g, col.b); |
| color := col.r + col.g + col.b; |
| Inc(PByte(S)); |
| P := @PArrayByte(D)[x shr 1]; |
| P^ := (P^ and Mask4n[x and 1]) or (color shl Shift4[x and 1]); |
| end; |
| 1: |
| begin |
| pfGetRGB(NowPixelFormat, Pixels[dx, dy], col.r, col.g, col.b); |
| color := col.r + col.g + col.b; |
| Inc(PByte(S)); |
| P := @PArrayByte(D)[X shr 3]; |
| P^ := (P^ and Mask1n[X and 7]) or (color shl Shift1[X and 7]); |
| end; |
| end; |
| end; |
| Inc(sdx, icosTheta); |
| Inc(sdy, isinTheta); |
| end; |
| end; |
| end; |
| mov ecx,edx |
| shr ecx,2 |
| add eax,ecx*4 |
| |
| procedure TDIB.GaussianBlur(Bmp: TDIB; Amount: Integer); |
| var |
| i: Integer; |
| begin |
| for i := 1 to Amount do |
| Bmp.SplitBlur(i); |
| end; |
| { Unit of Byte. } |
| @@dword_skip: |
| mov ecx,edx |
| and ecx,3 |
| jz @@byte_skip |
| |
| procedure TDIB.SplitBlur(Amount: Integer); |
| var |
| Lin1, Lin2: PLines; |
| cx, x, y: Integer; |
| Buf: array[0..3] of TBGR; |
| D: Pointer; |
| dec ecx |
| @@loop_byte: |
| not byte ptr [eax+ecx] |
| dec ecx |
| jnl @@loop_byte |
| |
| begin |
| case Bitcount of |
| 32, 16, 8, 4, 1: Exit; |
| @@byte_skip: |
| end; |
| for y := 0 to Pred(Height) do |
| begin |
| Lin1 := ScanLine[TrimInt(y + Amount, 0, Pred(Height))]; |
| Lin2 := ScanLine[TrimInt(y - Amount, 0, Pred(Height))]; |
| D := ScanLine[y]; |
| for x := 0 to Pred(Width) do |
| begin |
| cx := TrimInt(x + Amount, 0, Pred(Width)); |
| Buf[0] := Lin1[cx]; |
| Buf[1] := Lin2[cx]; |
| cx := TrimInt(x - Amount, 0, Pred(Width)); |
| Buf[2] := Lin1[cx]; |
| Buf[3] := Lin2[cx]; |
| PBGR(D)^.b := (Buf[0].b + Buf[1].b + Buf[2].b + Buf[3].b) shr 2; |
| PBGR(D)^.g := (Buf[0].g + Buf[1].g + Buf[2].g + Buf[3].g) shr 2; |
| PBGR(D)^.r := (Buf[0].r + Buf[1].r + Buf[2].r + Buf[3].r) shr 2; |
| Inc(PBGR(D)); |
| end; |
| end; |
| end; |
| |
| function TDIB.Twist(bmp: TDIB; Amount: byte): Boolean; |
| var |
| fxmid, fymid: Single; |
| txmid, tymid: Single; |
| fx, fy: Single; |
| tx2, ty2: Single; |
| r: Single; |
| theta: Single; |
| ifx, ify: Integer; |
| dx, dy: Single; |
| OFFSET: Single; |
| ty, tx, ix, iy: Integer; |
| weight_x, weight_y: array[0..1] of Single; |
| weight: Single; |
| new_red, new_green, new_blue: Integer; |
| total_red, total_green, total_blue: Single; |
| sli, slo: PLines; |
| |
| function ArcTan2(xt, yt: Single): Single; {$IFDEF VER9UP}inline;{$ENDIF} |
| begin |
| if xt = 0 then |
| if yt > 0 then |
| Result := Pi / 2 |
| else |
| Result := -(Pi / 2) |
| else |
| begin |
| Result := ArcTan(yt / xt); |
| if xt < 0 then |
| Result := Pi + ArcTan(yt / xt); |
| end; |
| end; |
| |
| begin |
| Result := True; |
| case BitCount of |
| 32, 16, 8, 4, 1: |
| begin |
| Result := False; |
| Exit; |
| end; |
| end; |
| if Amount = 0 then |
| Amount := 1; |
| OFFSET := -(Pi / 2); |
| dx := Pred(Width); |
| dy := Pred(Height); |
| r := Sqrt(dx * dx + dy * dy); |
| tx2 := r; |
| ty2 := r; |
| txmid := (Pred(Width)) / 2; |
| tymid := (Pred(Height)) / 2; |
| fxmid := (Pred(Width)) / 2; |
| fymid := (Pred(Height)) / 2; |
| if tx2 >= Width then |
| tx2 := Pred(Width); |
| if ty2 >= Height then |
| ty2 := Pred(Height); |
| for ty := 0 to Round(ty2) do |
| begin |
| for tx := 0 to Round(tx2) do |
| begin |
| dx := tx - txmid; |
| dy := ty - tymid; |
| r := Sqrt(dx * dx + dy * dy); |
| if r = 0 then |
| begin |
| fx := 0; |
| fy := 0; |
| end |
| else |
| begin |
| theta := ArcTan2(dx, dy) - r / Amount - OFFSET; |
| fx := r * Cos(theta); |
| fy := r * Sin(theta); |
| end; |
| fx := fx + fxmid; |
| fy := fy + fymid; |
| ify := Trunc(fy); |
| ifx := Trunc(fx); |
| 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 := Pred(Width) - (-ifx mod Width) |
| else |
| if ifx > Pred(Width) then |
| ifx := ifx mod Width; |
| if ify < 0 then |
| ify := Pred(Height) - (-ify mod Height) |
| else |
| if ify > Pred(Height) then |
| ify := ify mod 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 < Height then |
| sli := ScanLine[ify + iy] |
| else |
| sli := ScanLine[Height - ify - iy]; |
| if ifx + ix < Width then |
| begin |
| new_red := sli^[ifx + ix].r; |
| new_green := sli^[ifx + ix].g; |
| new_blue := sli^[ifx + ix].b; |
| end |
| else |
| begin |
| new_red := sli^[Width - ifx - ix].r; |
| new_green := sli^[Width - ifx - ix].g; |
| new_blue := sli^[Width - ifx - ix].b; |
| 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; |
| case bitCount of |
| 24: |
| begin |
| slo := bmp.ScanLine[ty]; |
| slo^[tx].r := Round(total_red); |
| slo^[tx].g := Round(total_green); |
| slo^[tx].b := Round(total_blue); |
| end; |
| else |
| // You can implement this procedure for 16,8,4,2 and 32 BitCount's DIB |
| Exit; |
| end; |
| end; |
| end; |
| end; |
| |
| function TDIB.TrimInt(i, Min, Max: Integer): Integer; |
| begin |
| if i > Max then |
| Result := Max |
| else |
| if i < Min then |
| Result := Min |
| else |
| Result := i; |
| end; |
| |
| function TDIB.IntToByte(i: Integer): Byte; |
| begin |
| if i > 255 then |
| Result := 255 |
| else |
| if i < 0 then |
| Result := 0 |
| else |
| Result := i; |
| end; |
| |
| //-------------------------------------------------------------------------------------------------- |
| // End of these New Special Effect // |
| // Please contributes to add effects and filters to this collection // |
| // Please, work to implement 32,16,8,4,2 BitCount's DIB // |
| // Have fun - Mickey - Good job // |
| //-------------------------------------------------------------------------------------------------- |
| |
| function TDIB.GetAlphaChannel: TDIB; |
| begin |
| RetAlphaChannel(Result); |
| |
| FFreeList.Add(Result); |
| end; |
| |
| procedure TDIB.SetAlphaChannel(const Value: TDIB); |
| begin |
| if not AssignAlphaChannel(Value{$IFNDEF VER4UP}, False{$ENDIF}) then |
| Exception.Create('Cannot set alphachannel from DIB.'); |
| end; |
| |
| procedure TDIB.Fill(aColor: TColor); |
| begin |
| Canvas.Brush.Color := aColor; |
| Canvas.FillRect(ClientRect); |
| end; |
| |
| function TDIB.GetClientRect: TRect; |
| begin |
| Result := Bounds(0, 0, Width, Height); |
| end; |
| |
| { TCustomDXDIB } |
| |
| constructor TCustomDXDIB.Create(AOnwer: TComponent); |
| 5357,20 → 3078,17 |
|---|
| begin |
| inherited Canvas.StretchDraw(Bounds(-(Width - ClientWidth) div 2, |
| -(Height - ClientHeight) div 2, Width, Height), FDIB); |
| end |
| else |
| end else |
| begin |
| inherited Canvas.StretchDraw(Bounds(0, 0, Width, Height), FDIB); |
| end; |
| end |
| else |
| end else |
| begin |
| if FCenter then |
| begin |
| inherited Canvas.Draw(-(Width - ClientWidth) div 2, -(Height - ClientHeight) div 2, |
| FDIB); |
| end |
| else |
| end else |
| begin |
| inherited Canvas.Draw(0, 0, FDIB); |
| end; |
| 5410,14 → 3128,11 |
|---|
| if r > r2 then |
| r := r2; |
| Draw2(Round(r * ClientWidth), Round(r * ClientHeight)); |
| end |
| else |
| end else |
| Draw2(ViewWidth2, ViewHeight2); |
| end |
| else |
| end else |
| Draw2(ViewWidth2, ViewHeight2); |
| end |
| else |
| end else |
| begin |
| if FAutoStretch then |
| begin |
| 5428,11 → 3143,9 |
|---|
| if r > r2 then |
| r := r2; |
| Draw2(Round(r * FDIB.Width), Round(r * FDIB.Height)); |
| end |
| else |
| end else |
| Draw2(FDIB.Width, FDIB.Height); |
| end |
| else |
| end else |
| if FStretch then |
| begin |
| if FKeepAspect then |
| 5442,11 → 3155,9 |
|---|
| if r > r2 then |
| r := r2; |
| Draw2(Round(r * FDIB.Width), Round(r * FDIB.Height)); |
| end |
| else |
| end else |
| Draw2(ClientWidth, ClientHeight); |
| end |
| else |
| end else |
| Draw2(FDIB.Width, FDIB.Height); |
| end; |
| end; |
| 5517,4382 → 3228,6 |
|---|
| end; |
| end; |
| |
| { DXFusion -> } |
| |
| function PosValue(Value: Integer): Integer; |
| begin |
| if Value < 0 then result := 0 else result := Value; |
| end; |
| |
| procedure TDIB.CreateDIBFromBitmap(const Bitmap: TBitmap); |
| var |
| pf: Integer; |
| begin |
| if Bitmap.PixelFormat = pf32bit then pf := 32 else pf := 24; |
| SetSize(Bitmap.Width, Bitmap.Height, pf); {always >=24} |
| Canvas.Draw(0, 0, Bitmap); |
| end; |
| |
| function TDIB.CreateBitmapFromDIB: TBitmap; |
| //var |
| // X, Y: Integer; |
| begin |
| Result := TBitmap.Create; |
| if BitCount = 32 then |
| Result.PixelFormat := pf32bit |
| else if BitCount = 24 then |
| Result.PixelFormat := pf24bit |
| else if BitCount = 16 then |
| Result.PixelFormat := pf16bit |
| else if BitCount = 8 then |
| Result.PixelFormat := pf8bit |
| else Result.PixelFormat := pf24bit; |
| Result.Width := Width; |
| Result.Height := Height; |
| Result.Canvas.Draw(0, 0, Self); |
| // for Y := 0 to Height - 1 do |
| // for X := 0 to Width - 1 do |
| // Result.Canvas.Pixels[X, Y] := Canvas.Pixels[X, Y]; |
| end; |
| |
| procedure TDIB.DrawTo(SrcDIB: TDIB; X, Y, Width, Height, |
| SourceX, SourceY: Integer); |
| begin |
| SrcDIB.DrawOn(Rect(X, Y, Width, Height), Self.Canvas, SourceX, SourceY); |
| end; |
| |
| procedure TDIB.DrawTransparent(SrcDIB: TDIB; const X, Y, Width, Height, |
| SourceX, SourceY: Integer; const Color: TColor); |
| var |
| i, j: Integer; |
| k1, k2: Integer; |
| n: Integer; |
| p1, p2: PByteArray; |
| |
| Startk1, Startk2: Integer; |
| |
| StartY: Integer; |
| EndY: Integer; |
| |
| DestStartY: Integer; |
| begin |
| if Self.BitCount <> 24 then Exit; |
| if SrcDIB.BitCount <> 24 then Exit; |
| Startk1 := 3 * SourceX; |
| Startk2 := 3 * X; |
| |
| DestStartY := Y - SourceY; |
| |
| StartY := SourceY; |
| EndY := SourceY + Height; |
| |
| if (StartY + DestStartY < 0) then |
| StartY := -DestStartY; |
| if (EndY + DestStartY > Self.Height) then |
| EndY := Self.Height - DestStartY; |
| |
| if (StartY < 0) then |
| StartY := 0; |
| if (EndY > SrcDIB.Height) then |
| EndY := SrcDIB.Height; |
| |
| for j := StartY to EndY - 1 do |
| begin |
| p1 := Self.Scanline[j + DestStartY]; |
| p2 := SrcDIB.Scanline[j]; |
| |
| k1 := Startk1; |
| k2 := Startk2; |
| |
| for i := SourceX to SourceX + Width - 1 do |
| begin |
| n := (p2[k1] shl 16) + (p2[k1 + 1] shl 8) + p2[k1 + 2]; |
| |
| if not (n = Color) then |
| begin |
| p1[k2] := p2[k1]; |
| p1[k2 + 1] := p2[k1 + 1]; |
| p1[k2 + 2] := p2[k1 + 2]; |
| end; |
| |
| k1 := k1 + 3; |
| k2 := k2 + 3; |
| end; |
| end; |
| end; |
| |
| procedure TDIB.DrawShadow(SrcDIB: TDIB; X, Y, Width, Height, |
| Frame: Integer; FilterMode: TFilterMode); |
| var |
| i, j: Integer; |
| p1, p2: PByte; |
| FW: Integer; |
| begin |
| if Self.BitCount <> 24 then Exit; |
| if SrcDIB.BitCount <> 24 then Exit; |
| |
| FW := Frame * Width; |
| for i := 1 to Height - 1 do |
| begin |
| p1 := Self.Scanline[i + Y]; |
| p2 := SrcDIB.Scanline[i]; |
| Inc(p1, 3 * (X + 1)); |
| Inc(p2, 3 * (FW + 1)); |
| for j := 1 to Width - 1 do |
| begin |
| if (p2^ = 0) then |
| begin |
| case FilterMode of |
| fmNormal, fmMix50: |
| begin |
| p1^ := p1^ shr 1; // Blue |
| Inc(p1); |
| p1^ := p1^ shr 1; // Green |
| Inc(p1); |
| p1^ := p1^ shr 1; // Red |
| Inc(p1); |
| end; |
| fmMix25: |
| begin |
| p1^ := p1^ - p1^ shr 2; // Blue |
| Inc(p1); |
| p1^ := p1^ - p1^ shr 2; // Green |
| Inc(p1); |
| p1^ := p1^ - p1^ shr 2; // Red |
| Inc(p1); |
| end; |
| fmMix75: |
| begin |
| p1^ := p1^ shr 2; // Blue |
| Inc(p1); |
| p1^ := p1^ shr 2; // Green |
| Inc(p1); |
| p1^ := p1^ shr 2; // Red |
| Inc(p1); |
| end; |
| end; |
| end |
| else |
| Inc(p1, 3); // Not in the loop... |
| Inc(p2, 3); |
| end; |
| end; |
| end; |
| |
| procedure TDIB.DrawShadows(SrcDIB: TDIB; X, Y, Width, Height, |
| Frame: Integer; Alpha: Byte); |
| {plynule nastavovani stiny dle alpha} |
| type |
| P3ByteArray = ^T3ByteArray; |
| T3ByteArray = array[0..32767] of TBGR; |
| var |
| i, j, l1, l2: Integer; |
| p1, p2: P3ByteArray; |
| FW: Integer; |
| begin |
| if Self.BitCount <> 24 then Exit; |
| if SrcDIB.BitCount <> 24 then Exit; |
| |
| FW := Frame * Width; |
| for i := 0 to Height - 1 do |
| begin |
| p1 := Self.Scanline[i + Y]; |
| p2 := SrcDIB.Scanline[i]; |
| l1 := X; |
| l2 := FW; |
| for j := 0 to Width - 1 do |
| begin |
| if (p2[j + l2].B = 0) and (p2[j + l2].G = 0) and (p2[j + l2].R = 0) then |
| begin |
| p1[J + l1].B := Round(p1[J + l1].B / $FF * Alpha); |
| p1[J + l1].G := Round(p1[J + l1].G / $FF * Alpha); |
| p1[J + l1].R := Round(p1[J + l1].R / $FF * Alpha); |
| end |
| end; |
| end; |
| end; |
| |
| procedure TDIB.DrawDarken(SrcDIB: TDIB; X, Y, Width, Height, |
| Frame: Integer); |
| var |
| frameoffset, i, j: Integer; |
| p1, p2: pByte; |
| XOffset: Integer; |
| begin |
| if Self.BitCount <> 24 then Exit; |
| if SrcDIB.BitCount <> 24 then Exit; |
| |
| frameoffset := 3 * (Frame * Width) + 3; |
| XOffset := 3 * X + 3; |
| for i := 1 to Height - 1 do |
| begin |
| p1 := Self.Scanline[i + Y]; |
| p2 := SrcDIB.Scanline[i]; |
| inc(p1, XOffset); |
| inc(p2, frameoffset); |
| for j := 1 to Width - 1 do |
| begin |
| p1^ := (p2^ * p1^) shr 8; // R |
| inc(p1); |
| inc(p2); |
| p1^ := (p2^ * p1^) shr 8; // G |
| inc(p1); |
| inc(p2); |
| p1^ := (p2^ * p1^) shr 8; // B |
| inc(p1); |
| inc(p2); |
| end; |
| end; |
| end; |
| |
| procedure TDIB.DrawQuickAlpha(SrcDIB: TDIB; const X, Y, Width, Height, |
| SourceX, SourceY: Integer; const Color: TColor; FilterMode: TFilterMode); |
| var |
| i, j: Integer; |
| k1, k2: Integer; |
| n: Integer; |
| p1, p2: PByteArray; |
| BitSwitch1, BitSwitch2: Boolean; |
| |
| Startk1, Startk2: Integer; |
| StartY: Integer; |
| EndY: Integer; |
| |
| DestStartY: Integer; |
| begin |
| if Self.BitCount <> 24 then Exit; |
| if SrcDIB.BitCount <> 24 then Exit; |
| |
| Startk1 := 3 * SourceX; |
| Startk2 := 3 * X; |
| |
| DestStartY := Y - SourceY; |
| |
| StartY := SourceY; |
| EndY := SourceY + Height; |
| |
| if (StartY + DestStartY < 0) then |
| StartY := -DestStartY; |
| if (EndY + DestStartY > Self.Height) then |
| EndY := Self.Height - DestStartY; |
| |
| if (StartY < 0) then |
| StartY := 0; |
| if (EndY > SrcDIB.Height) then |
| EndY := SrcDIB.Height; |
| |
| if Odd(Y) then BitSwitch1 := true else BitSwitch1 := false; |
| if Odd(X) then BitSwitch2 := true else BitSwitch2 := false; |
| |
| for j := StartY to EndY - 1 do |
| begin |
| BitSwitch1 := not BitSwitch1; |
| p1 := Self.Scanline[j + DestStartY]; |
| p2 := SrcDIB.Scanline[j]; |
| |
| k1 := Startk1; |
| k2 := Startk2; |
| |
| for i := SourceX to SourceX + Width - 1 do |
| begin |
| BitSwitch2 := not BitSwitch2; |
| |
| n := (p2[k1] shl 16) + (p2[k1 + 1] shl 8) + p2[k1 + 2]; |
| |
| case FilterMode of |
| fmNormal, fmMix50: if not (n = Color) and (BitSwitch1 xor BitSwitch2) then |
| begin |
| p1[k2] := p2[k1]; |
| p1[k2 + 1] := p2[k1 + 1]; |
| p1[k2 + 2] := p2[k1 + 2]; |
| end; |
| fmMix25: if not (n = Color) and (BitSwitch1 and BitSwitch2) then |
| begin |
| p1[k2] := p2[k1]; |
| p1[k2 + 1] := p2[k1 + 1]; |
| p1[k2 + 2] := p2[k1 + 2]; |
| end; |
| fmMix75: if not (n = Color) and (BitSwitch1 or BitSwitch2) then |
| begin |
| p1[k2] := p2[k1]; |
| p1[k2 + 1] := p2[k1 + 1]; |
| p1[k2 + 2] := p2[k1 + 2]; |
| end; |
| end; |
| |
| k1 := k1 + 3; |
| k2 := k2 + 3; |
| end; |
| end; |
| end; |
| |
| procedure TDIB.DrawAdditive(SrcDIB: TDIB; X, Y, Width, Height, Alpha, Frame: |
| Integer); |
| var |
| frameoffset, i, j, Wid: Integer; |
| p1, p2: pByte; |
| begin |
| if Self.BitCount <> 24 then Exit; |
| if SrcDIB.BitCount <> 24 then Exit; |
| |
| if (Alpha < 1) or (Alpha > 256) then Exit; |
| Wid := Width shl 1 + Width; |
| frameoffset := Wid * Frame; |
| for i := 1 to Height - 1 do |
| begin |
| if (i + Y) > (Self.Height - 1) then Break; //add 25.5.2004 JB. |
| p1 := Self.Scanline[i + Y]; |
| p2 := SrcDIB.Scanline[i]; |
| inc(p1, X shl 1 + X + 3); |
| inc(p2, frameoffset + 3); |
| for j := 3 to Wid - 4 do |
| begin |
| inc(p1^, (Alpha - p1^) * p2^ shr 8); |
| inc(p1); |
| inc(p2); |
| end; |
| end; |
| end; |
| |
| procedure TDIB.DrawTranslucent(SrcDIB: TDIB; const X, Y, Width, Height, |
| SourceX, SourceY: Integer; const Color: TColor); |
| var |
| i, j: Integer; |
| k1, k2: Integer; |
| n: Integer; |
| p1, p2: PByteArray; |
| |
| Startk1, Startk2: Integer; |
| StartY: Integer; |
| EndY: Integer; |
| |
| DestStartY: Integer; |
| begin |
| if Self.BitCount <> 24 then Exit; |
| if SrcDIB.BitCount <> 24 then Exit; |
| |
| Startk1 := 3 * SourceX; |
| Startk2 := 3 * X; |
| |
| DestStartY := Y - SourceY; |
| |
| StartY := SourceY; |
| EndY := SourceY + Height; |
| |
| if (StartY + DestStartY < 0) then |
| StartY := -DestStartY; |
| if (EndY + DestStartY > Self.Height) then |
| EndY := Self.Height - DestStartY; |
| |
| if (StartY < 0) then |
| StartY := 0; |
| if (EndY > SrcDIB.Height) then |
| EndY := SrcDIB.Height; |
| |
| for j := StartY to EndY - 1 do |
| begin |
| p1 := Self.Scanline[j + DestStartY]; |
| p2 := SrcDIB.Scanline[j]; |
| |
| k1 := Startk1; |
| k2 := Startk2; |
| |
| for i := SourceX to SourceX + Width - 1 do |
| begin |
| n := (p2[k1] shl 16) + (p2[k1 + 1] shl 8) + p2[k1 + 2]; |
| |
| if not (n = Color) then |
| begin |
| p1[k2] := (p1[k2] + p2[k1]) shr 1; |
| p1[k2 + 1] := (p1[k2 + 1] + p2[k1 + 1]) shr 1; |
| p1[k2 + 2] := (p1[k2 + 2] + p2[k1 + 2]) shr 1; |
| end; |
| |
| k1 := k1 + 3; |
| k2 := k2 + 3; |
| end; |
| end; |
| end; |
| |
| procedure TDIB.DrawAlpha(SrcDIB: TDIB; const X, Y, Width, Height, |
| SourceX, SourceY, Alpha: Integer; const Color: TColor); |
| var |
| i, j: Integer; |
| k1, k2: Integer; |
| n: Integer; |
| p1, p2: PByteArray; |
| |
| Startk1, Startk2: Integer; |
| StartY: Integer; |
| EndY: Integer; |
| |
| DestStartY: Integer; |
| begin |
| if Self.BitCount <> 24 then Exit; |
| if SrcDIB.BitCount <> 24 then Exit; |
| |
| Startk1 := 3 * SourceX; |
| Startk2 := 3 * x; |
| |
| DestStartY := Y - SourceY; |
| |
| StartY := SourceY; |
| EndY := SourceY + Height; |
| |
| if (EndY + DestStartY > Self.Height) then |
| EndY := Self.Height - DestStartY; |
| |
| if (EndY > SrcDIB.Height) then |
| EndY := SrcDIB.Height; |
| |
| if (StartY < 0) then |
| StartY := 0; |
| |
| if (StartY + DestStartY < 0) then |
| StartY := DestStartY; |
| |
| for j := StartY to EndY - 1 do |
| begin |
| p1 := Self.Scanline[j + DestStartY]; |
| p2 := SrcDIB.Scanline[j]; |
| |
| k1 := Startk1; |
| k2 := Startk2; |
| |
| for i := SourceX to SourceX + Width - 1 do |
| begin |
| n := (p2[k1] shl 16) + (p2[k1 + 1] shl 8) + p2[k1 + 2]; |
| |
| if not (n = Color) then |
| begin |
| p1[k2] := (p1[k2] * (256 - Alpha) + p2[k1] * Alpha) shr 8; |
| p1[k2 + 1] := (p1[k2 + 1] * (256 - Alpha) + p2[k1 + 1] * Alpha) shr 8; |
| p1[k2 + 2] := (p1[k2 + 2] * (256 - Alpha) + p2[k1 + 2] * Alpha) shr 8; |
| end; |
| |
| k1 := k1 + 3; |
| k2 := k2 + 3; |
| end; |
| end; |
| end; |
| |
| procedure TDIB.DrawAlphaMask(SrcDIB, MaskDIB: TDIB; const X, Y, |
| Width, Height, SourceX, SourceY: Integer); |
| var |
| i, j: Integer; |
| k1, k2, k3: Integer; |
| p1, p2, p3: PByteArray; |
| |
| Startk1, Startk2: Integer; |
| StartY: Integer; |
| EndY: Integer; |
| |
| DestStartY: Integer; |
| begin |
| if Self.BitCount <> 24 then Exit; |
| if SrcDIB.BitCount <> 24 then Exit; |
| |
| Startk1 := 3 * SourceX; |
| Startk2 := 3 * x; |
| |
| DestStartY := Y - SourceY; |
| |
| StartY := SourceY; |
| EndY := SourceY + Height; |
| |
| if (EndY + DestStartY > Self.Height) then |
| EndY := Self.Height - DestStartY; |
| |
| if (EndY > SrcDIB.Height) then |
| EndY := SrcDIB.Height; |
| |
| if (StartY < 0) then |
| StartY := 0; |
| |
| if (StartY + DestStartY < 0) then |
| StartY := DestStartY; |
| |
| for j := StartY to EndY - 1 do |
| begin |
| p1 := Self.Scanline[j + DestStartY]; |
| p2 := SrcDIB.Scanline[j]; |
| p3 := MaskDIB.Scanline[j]; |
| |
| k1 := Startk1; |
| k2 := Startk2; |
| k3 := 0; |
| |
| for i := SourceX to SourceX + Width - 1 do |
| begin |
| p1[k2] := (p1[k2] * (256 - p3[k3]) + p2[k1] * p3[k3]) shr 8; |
| p1[k2 + 1] := (p1[k2 + 1] * (256 - p3[k3]) + p2[k1 + 1] * p3[k3]) shr 8; |
| p1[k2 + 2] := (p1[k2 + 2] * (256 - p3[k3]) + p2[k1 + 2] * p3[k3]) shr 8; |
| |
| k1 := k1 + 3; |
| k2 := k2 + 3; |
| k3 := k3 + 3; |
| end; |
| end; |
| end; |
| |
| procedure TDIB.DrawMorphed(SrcDIB: TDIB; const X, Y, Width, Height, |
| SourceX, SourceY: Integer; const Color: TColor); |
| var |
| i, j, r, g, b: Integer; |
| k1, k2: Integer; |
| n: Integer; |
| p1, p2: PByteArray; |
| |
| Startk1, Startk2: Integer; |
| StartY: Integer; |
| EndY: Integer; |
| |
| DestStartY: Integer; |
| begin |
| if Self.BitCount <> 24 then Exit; |
| if SrcDIB.BitCount <> 24 then Exit; |
| |
| Startk1 := 3 * SourceX; |
| Startk2 := 3 * x; |
| |
| DestStartY := Y - SourceY; |
| |
| StartY := SourceY; |
| EndY := SourceY + Height; |
| |
| if (EndY + DestStartY > Self.Height) then |
| EndY := Self.Height - DestStartY; |
| |
| if (EndY > SrcDIB.Height) then |
| EndY := SrcDIB.Height; |
| |
| if (StartY < 0) then |
| StartY := 0; |
| |
| if (StartY + DestStartY < 0) then |
| StartY := DestStartY; |
| |
| r := 0; |
| g := 0; |
| b := 0; |
| |
| for j := StartY to EndY - 1 do |
| begin |
| p1 := Self.Scanline[j + DestStartY]; |
| p2 := SrcDIB.Scanline[j]; |
| |
| k1 := Startk1; |
| k2 := Startk2; |
| |
| for i := SourceX to SourceX + Width - 1 do |
| begin |
| n := (p2[k1] shl 16) + (p2[k1 + 1] shl 8) + p2[k1 + 2]; |
| |
| if Random(100) < 50 then |
| begin |
| b := p1[k2]; |
| g := p1[k2 + 1]; |
| r := p1[k2 + 2]; |
| end; |
| |
| if not (n = Color) then |
| begin |
| p1[k2] := b; |
| p1[k2 + 1] := g; |
| p1[k2 + 2] := r; |
| end; |
| |
| k1 := k1 + 3; |
| k2 := k2 + 3; |
| end; |
| end; |
| end; |
| |
| procedure TDIB.DrawMono(SrcDIB: TDIB; const X, Y, Width, Height, |
| SourceX, SourceY: Integer; const TransColor, ForeColor, BackColor: TColor); |
| var |
| i, j, r1, g1, b1, r2, g2, b2: Integer; |
| k1, k2: Integer; |
| n: Integer; |
| p1, p2: PByteArray; |
| Startk1, Startk2, StartY, EndY, DestStartY: Integer; |
| begin |
| if Self.BitCount <> 24 then Exit; |
| if SrcDIB.BitCount <> 24 then Exit; |
| |
| Startk1 := 3 * SourceX; |
| Startk2 := 3 * x; |
| |
| DestStartY := Y - SourceY; |
| |
| StartY := SourceY; |
| EndY := SourceY + Height; |
| |
| if (EndY + DestStartY > Self.Height) then |
| EndY := Self.Height - DestStartY; |
| |
| if (EndY > SrcDIB.Height) then |
| EndY := SrcDIB.Height; |
| |
| if (StartY < 0) then |
| StartY := 0; |
| |
| if (StartY + DestStartY < 0) then |
| StartY := DestStartY; |
| |
| r1 := GetRValue(BackColor); |
| g1 := GetGValue(BackColor); |
| b1 := GetBValue(BackColor); |
| |
| r2 := GetRValue(ForeColor); |
| g2 := GetGValue(ForeColor); |
| b2 := GetBValue(ForeColor); |
| |
| |
| for j := StartY to EndY - 1 do |
| begin |
| p1 := Self.Scanline[j + DestStartY]; |
| p2 := SrcDIB.Scanline[j]; |
| |
| k1 := Startk1; |
| k2 := Startk2; |
| |
| for i := SourceX to SourceX + Width - 1 do |
| begin |
| n := (p2[k1] shl 16) + (p2[k1 + 1] shl 8) + p2[k1 + 2]; |
| |
| if (n = TransColor) then |
| begin |
| p1[k2] := b1; |
| p1[k2 + 1] := g1; |
| p1[k2 + 2] := r1; |
| end |
| else |
| begin |
| p1[k2] := b2; |
| p1[k2 + 1] := g2; |
| p1[k2 + 2] := r2; |
| end; |
| |
| k1 := k1 + 3; |
| k2 := k2 + 3; |
| end; |
| end; |
| end; |
| |
| procedure TDIB.Draw3x3Matrix(SrcDIB: TDIB; Setting: TMatrixSetting); |
| var i, j, k: Integer; |
| p1, p2, p3, p4: PByteArray; |
| begin |
| if Self.BitCount <> 24 then Exit; |
| if SrcDIB.BitCount <> 24 then Exit; |
| |
| for i := 1 to SrcDIB.Height - 2 do |
| begin |
| p1 := SrcDIB.ScanLine[i - 1]; |
| p2 := SrcDIB.ScanLine[i]; |
| p3 := SrcDIB.ScanLine[i + 1]; |
| p4 := Self.ScanLine[i]; |
| for j := 3 to 3 * SrcDIB.Width - 4 do |
| begin |
| k := (p1[j - 3] * Setting[0] + p1[j] * Setting[1] + p1[j + 3] * Setting[2] + |
| p2[j - 3] * Setting[3] + p2[j] * Setting[4] + p2[j + 3] * Setting[5] + |
| p3[j - 3] * Setting[6] + p3[j] * Setting[7] + p3[j + 3] * Setting[8]) |
| div Setting[9]; |
| if k < 0 then k := 0; |
| if k > 255 then k := 255; |
| p4[j] := k; |
| end; |
| end; |
| end; |
| |
| procedure TDIB.DrawAntialias(SrcDIB: TDIB); |
| var i, j, k, l, m: Integer; |
| p1, p2, p3: PByteArray; |
| begin |
| if Self.BitCount <> 24 then Exit; |
| if SrcDIB.BitCount <> 24 then Exit; |
| |
| for i := 1 to Self.Height - 1 do |
| begin |
| k := i shl 1; |
| p1 := SrcDIB.Scanline[k]; |
| p2 := SrcDIB.Scanline[k + 1]; |
| p3 := Self.Scanline[i]; |
| for j := 1 to Self.Width - 1 do |
| begin |
| m := 3 * j; |
| l := m shl 1; |
| p3[m] := (p1[l] + p1[l + 3] + p2[l] + p2[l + 3]) shr 2; |
| p3[m + 1] := (p1[l + 1] + p1[l + 4] + p2[l + 1] + p2[l + 4]) shr 2; |
| p3[m + 2] := (p1[l + 2] + p1[l + 5] + p2[l + 2] + p2[l + 5]) shr 2; |
| end; |
| end; |
| end; |
| |
| procedure TDIB.FilterLine(X1, Y1, X2, Y2: Integer; Color: TColor; |
| FilterMode: TFilterMode); |
| var |
| i, j: Integer; |
| t: TColor; |
| r1, g1, b1, r2, g2, b2: Integer; |
| begin |
| j := ROUND(Sqrt(Sqr(ABS(X2 - X1)) + Sqr(ABS(Y2 - Y1)))); |
| if j < 1 then Exit; |
| |
| r1 := GetRValue(Color); |
| g1 := GetGValue(Color); |
| b1 := GetBValue(Color); |
| |
| for i := 0 to j do |
| begin |
| t := Self.Pixels[X1 + ((X2 - X1) * i div j), Y1 + ((Y2 - Y1) * i div j)]; |
| r2 := GetRValue(t); |
| g2 := GetGValue(t); |
| b2 := GetBValue(t); |
| case FilterMode of |
| fmNormal: t := RGB(r1 + (((256 - r1) * r2) shr 8), |
| g1 + (((256 - g1) * g2) shr 8), |
| b1 + (((256 - b1) * b2) shr 8)); |
| fmMix25: t := RGB((r1 + r2 * 3) shr 2, (g1 + g2 * 3) shr 2, (b1 + b2 * 3) shr 2); |
| fmMix50: t := RGB((r1 + r2) shr 1, (g1 + g2) shr 1, (b1 + b2) shr 1); |
| fmMix75: t := RGB((r1 * 3 + r2) shr 2, (g1 * 3 + g2) shr 2, (b1 * 3 + b2) shr 2); |
| end; |
| Self.Pixels[X1 + ((X2 - X1) * i div j), Y1 + ((Y2 - Y1) * i div j)] := t; |
| end; |
| end; |
| |
| procedure TDIB.FilterRect(X, Y, Width, Height: Integer; |
| Color: TColor; FilterMode: TFilterMode); |
| var |
| i, j, r, g, b, C1: Integer; |
| p1, p2, p3: pByte; |
| begin |
| if Self.BitCount <> 24 then Exit; |
| |
| r := GetRValue(Color); |
| g := GetGValue(Color); |
| b := GetBValue(Color); |
| |
| for i := 0 to Height - 1 do |
| begin |
| p1 := Self.Scanline[i + Y]; |
| Inc(p1, (3 * X)); |
| for j := 0 to Width - 1 do |
| begin |
| case FilterMode of |
| fmNormal: |
| begin |
| p2 := p1; |
| Inc(p2); |
| p3 := p2; |
| Inc(p3); |
| C1 := (p1^ + p2^ + p3^) div 3; |
| |
| p1^ := (C1 * b) shr 8; |
| Inc(p1); |
| p1^ := (C1 * g) shr 8; |
| Inc(p1); |
| p1^ := (C1 * r) shr 8; |
| Inc(p1); |
| end; |
| fmMix25: |
| begin |
| p1^ := (3 * p1^ + b) shr 2; |
| Inc(p1); |
| p1^ := (3 * p1^ + g) shr 2; |
| Inc(p1); |
| p1^ := (3 * p1^ + r) shr 2; |
| Inc(p1); |
| end; |
| fmMix50: |
| begin |
| p1^ := (p1^ + b) shr 1; |
| Inc(p1); |
| p1^ := (p1^ + g) shr 1; |
| Inc(p1); |
| p1^ := (p1^ + r) shr 1; |
| Inc(p1); |
| end; |
| fmMix75: |
| begin |
| p1^ := (p1^ + 3 * b) shr 2; |
| Inc(p1); |
| p1^ := (p1^ + 3 * g) shr 2; |
| Inc(p1); |
| p1^ := (p1^ + 3 * r) shr 2; |
| Inc(p1); |
| end; |
| end; |
| end; |
| end; |
| end; |
| |
| procedure TDIB.InitLight(Count, Detail: Integer); |
| var |
| i, j: Integer; |
| begin |
| LG_COUNT := Count; |
| LG_DETAIL := Detail; |
| |
| for i := 0 to 255 do // Build Lightning LUT |
| for j := 0 to 255 do |
| FLUTDist[i, j] := ROUND(Sqrt(Sqr(i * 10) + Sqr(j * 10))); |
| end; |
| |
| procedure TDIB.DrawLights(FLight: TLightArray; |
| AmbientLight: TColor); |
| var |
| i, j, l, m, n, o, q, D1, D2, R, G, B, AR, AG, AB: Integer; |
| P: array{$IFNDEF VER4UP} [0..4096]{$ENDIF} of PByteArray; |
| begin |
| if Self.BitCount <> 24 then Exit; |
| |
| {$IFDEF VER4UP} |
| SetLength(P, LG_DETAIL); |
| {$ENDIF} |
| AR := GetRValue(AmbientLight); |
| AG := GetGValue(AmbientLight); |
| AB := GetBValue(AmbientLight); |
| |
| for i := (Self.Height div (LG_DETAIL + 1)) downto 1 do |
| begin |
| for o := 0 to LG_DETAIL do |
| P[o] := Self.Scanline[(LG_DETAIL + 1) * i - o]; |
| |
| for j := (Self.Width div (LG_DETAIL + 1)) downto 1 do |
| begin |
| R := AR; |
| G := AG; |
| B := AB; |
| |
| for l := LG_COUNT - 1 downto 0 do // Check the lightsources |
| begin |
| D1 := ABS(j * (LG_DETAIL + 1) - FLight[l].X) div FLight[l].Size1; |
| D2 := ABS(i * (LG_DETAIL + 1) - FLight[l].Y) div FLight[l].Size2; |
| if D1 > 255 then D1 := 255; |
| if D2 > 255 then D2 := 255; |
| |
| m := 255 - FLUTDist[D1, D2]; |
| if m < 0 then m := 0; |
| |
| Inc(R, (PosValue(GetRValue(FLight[l].Color) - R) * m shr 8)); |
| Inc(G, (PosValue(GetGValue(FLight[l].Color) - G) * m shr 8)); |
| Inc(B, (PosValue(GetBValue(FLight[l].Color) - B) * m shr 8)); |
| end; |
| |
| for q := LG_DETAIL downto 0 do |
| begin |
| n := 3 * (j * (LG_DETAIL + 1) - q); |
| |
| for o := LG_DETAIL downto 0 do |
| begin |
| P[o][n] := (P[o][n] * B) shr 8; |
| P[o][n + 1] := (P[o][n + 1] * G) shr 8; |
| P[o][n + 2] := (P[o][n + 2] * R) shr 8; |
| end; |
| end; |
| end; |
| end; |
| {$IFDEF VER4UP} |
| SetLength(P, 0); |
| {$ENDIF} |
| end; |
| |
| procedure TDIB.DrawOn(Dest: TRect; DestCanvas: TCanvas; Xsrc, Ysrc: Integer); |
| {procedure is supplement of original TDIBUltra function} |
| begin |
| //if not AsSigned(SrcCanvas) then Exit; |
| if (Xsrc < 0) then |
| begin |
| Dec(Dest.Left, Xsrc); |
| Inc(Dest.Right {Width }, Xsrc); |
| Xsrc := 0 |
| end; |
| if (Ysrc < 0) then |
| begin |
| Dec(Dest.Top, Ysrc); |
| Inc(Dest.Bottom {Height}, Ysrc); |
| Ysrc := 0 |
| end; |
| BitBlt(DestCanvas.Handle, Dest.Left, Dest.Top, Dest.Right, Dest.Bottom, Self.Canvas.Handle, Xsrc, Ysrc, SRCCOPY); |
| end; |
| |
| { DXFusion <- } |
| |
| { added effect for DIB } |
| |
| function IntToByte(i: Integer): Byte; |
| begin |
| if i > 255 then Result := 255 |
| else if i < 0 then Result := 0 |
| else Result := i; |
| end; |
| |
| {standalone routine} |
| |
| procedure TDIB.Darker(Percent: Integer); |
| {color to dark in percent} |
| var |
| p0: pbytearray; |
| r, g, b, x, y: Integer; |
| begin |
| if Self.BitCount <> 24 then Exit; |
| for y := 0 to Self.Height - 1 do |
| begin |
| p0 := Self.ScanLine[y]; |
| for x := 0 to Self.Width - 1 do |
| begin |
| r := p0[x * 3]; |
| g := p0[x * 3 + 1]; |
| b := p0[x * 3 + 2]; |
| p0[x * 3] := Round(R * Percent / 100); |
| p0[x * 3 + 1] := Round(G * Percent / 100); |
| p0[x * 3 + 2] := Round(B * Percent / 100); |
| end; |
| end; |
| end; |
| |
| procedure TDIB.Lighter(Percent: Integer); |
| var |
| p0: pbytearray; |
| r, g, b, x, y: Integer; |
| begin |
| if Self.BitCount <> 24 then Exit; |
| for y := 0 to Self.Height - 1 do |
| begin |
| p0 := Self.ScanLine[y]; |
| for x := 0 to Self.Width - 1 do |
| begin |
| r := p0[x * 3]; |
| g := p0[x * 3 + 1]; |
| b := p0[x * 3 + 2]; |
| p0[x * 3] := Round(R * Percent / 100) + Round(255 - Percent / 100 * 255); |
| p0[x * 3 + 1] := Round(G * Percent / 100) + Round(255 - Percent / 100 * 255); |
| p0[x * 3 + 2] := Round(B * Percent / 100) + Round(255 - Percent / 100 * 255); |
| end; |
| end; |
| end; |
| |
| procedure TDIB.Darkness(Amount: Integer); |
| var |
| p0: pbytearray; |
| r, g, b, x, y: Integer; |
| begin |
| if Self.BitCount <> 24 then Exit; |
| for y := 0 to Self.Height - 1 do |
| begin |
| p0 := Self.ScanLine[y]; |
| for x := 0 to Self.Width - 1 do |
| begin |
| r := p0[x * 3]; |
| g := p0[x * 3 + 1]; |
| b := p0[x * 3 + 2]; |
| p0[x * 3] := IntToByte(r - ((r) * Amount) div 255); |
| p0[x * 3 + 1] := IntToByte(g - ((g) * Amount) div 255); |
| p0[x * 3 + 2] := IntToByte(b - ((b) * Amount) div 255); |
| end; |
| end; |
| end; |
| |
| function TrimInt(i, Min, Max: Integer): Integer; {$IFDEF VER9UP}inline;{$ENDIF} |
| begin |
| if i > Max then Result := Max |
| else if i < Min then Result := Min |
| else Result := i; |
| end; |
| |
| procedure TDIB.DoSmoothRotate(Src: TDIB; cx, cy: Integer; Angle: Extended); |
| var |
| Top, Bottom, Left, Right, eww, nsw, fx, fy, wx, wy: Extended; |
| cAngle, sAngle: Double; |
| xDiff, yDiff, ifx, ify, px, py, ix, iy, x, y: Integer; |
| nw, ne, sw, se: TBGR; |
| P1, P2, P3: Pbytearray; |
| begin |
| Angle := angle; |
| Angle := -Angle * Pi / 180; |
| sAngle := Sin(Angle); |
| cAngle := Cos(Angle); |
| xDiff := (Self.Width - Src.Width) div 2; |
| yDiff := (Self.Height - Src.Height) div 2; |
| for y := 0 to Self.Height - 1 do |
| begin |
| P3 := Self.scanline[y]; |
| py := 2 * (y - cy) + 1; |
| for x := 0 to Self.Width - 1 do |
| begin |
| px := 2 * (x - cx) + 1; |
| fx := (((px * cAngle - py * sAngle) - 1) / 2 + cx) - xDiff; |
| fy := (((px * sAngle + py * cAngle) - 1) / 2 + cy) - yDiff; |
| ifx := Round(fx); |
| ify := Round(fy); |
| |
| if (ifx > -1) and (ifx < Src.Width) and (ify > -1) and (ify < Src.Height) then |
| begin |
| eww := fx - ifx; |
| nsw := fy - ify; |
| iy := TrimInt(ify + 1, 0, Src.Height - 1); |
| ix := TrimInt(ifx + 1, 0, Src.Width - 1); |
| P1 := Src.scanline[ify]; |
| P2 := Src.scanline[iy]; |
| nw.r := P1[ifx * 3]; |
| nw.g := P1[ifx * 3 + 1]; |
| nw.b := P1[ifx * 3 + 2]; |
| ne.r := P1[ix * 3]; |
| ne.g := P1[ix * 3 + 1]; |
| ne.b := P1[ix * 3 + 2]; |
| sw.r := P2[ifx * 3]; |
| sw.g := P2[ifx * 3 + 1]; |
| sw.b := P2[ifx * 3 + 2]; |
| se.r := P2[ix * 3]; |
| se.g := P2[ix * 3 + 1]; |
| se.b := P2[ix * 3 + 2]; |
| |
| Top := nw.b + eww * (ne.b - nw.b); |
| Bottom := sw.b + eww * (se.b - sw.b); |
| P3[x * 3 + 2] := IntToByte(Round(Top + nsw * (Bottom - Top))); |
| |
| Top := nw.g + eww * (ne.g - nw.g); |
| Bottom := sw.g + eww * (se.g - sw.g); |
| P3[x * 3 + 1] := IntToByte(Round(Top + nsw * (Bottom - Top))); |
| |
| Top := nw.r + eww * (ne.r - nw.r); |
| Bottom := sw.r + eww * (se.r - sw.r); |
| P3[x * 3] := IntToByte(Round(Top + nsw * (Bottom - Top))); |
| end; |
| end; |
| end; |
| end; |
| |
| //---------------------- |
| //--- 24 bit count routines ---------------------- |
| //---------------------- |
| |
| procedure TDIB.DoInvert; |
| procedure PicInvert(src: TDIB); |
| var w, h, x, y: Integer; |
| p: pbytearray; |
| begin |
| w := src.width; |
| h := src.height; |
| src.BitCount := 24; |
| for y := 0 to h - 1 do |
| begin |
| p := src.scanline[y]; |
| for x := 0 to w - 1 do |
| begin |
| p[x * 3] := not p[x * 3]; |
| p[x * 3 + 1] := not p[x * 3 + 1]; |
| p[x * 3 + 2] := not p[x * 3 + 2]; |
| end; |
| end; |
| end; |
| begin |
| PicInvert(Self); |
| end; |
| |
| procedure TDIB.DoAddColorNoise(Amount: Integer); |
| procedure AddColorNoise(var clip: TDIB; 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; |
| var BB: TDIB; |
| begin |
| BB := TDIB.Create; |
| BB.BitCount := 24; |
| BB.Assign(Self); |
| AddColorNoise(bb, Amount); |
| Self.Assign(BB); |
| BB.Free; |
| end; |
| |
| procedure TDIB.DoAddMonoNoise(Amount: Integer); |
| procedure _AddMonoNoise(var clip: TDIB; 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; |
| var BB: TDIB; |
| begin |
| BB := TDIB.Create; |
| BB.BitCount := 24; |
| BB.Assign(Self); |
| _AddMonoNoise(bb, Amount); |
| Self.Assign(BB); |
| BB.Free; |
| end; |
| |
| procedure TDIB.DoAntiAlias; |
| procedure AntiAlias(clip: TDIB); |
| procedure AntiAliasRect(clip: TDIB; 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.BitCount := 24; |
| 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; |
| begin |
| AntiAliasRect(clip, 0, 0, clip.width, clip.height); |
| end; |
| begin |
| AntiAlias(Self); |
| end; |
| |
| procedure TDIB.DoContrast(Amount: Integer); |
| procedure _Contrast(var clip: TDIB; 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; |
| var BB: TDIB; |
| begin |
| BB := TDIB.Create; |
| BB.BitCount := 24; |
| BB.Assign(Self); |
| _Contrast(bb, Amount); |
| Self.Assign(BB); |
| BB.Free; |
| end; |
| |
| procedure TDIB.DoFishEye(Amount: Integer); |
| procedure _FishEye(var Bmp, Dst: TDIB; 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; |
| var BB1, BB2: TDIB; |
| begin |
| BB1 := TDIB.Create; |
| BB1.BitCount := 24; |
| BB1.Assign(Self); |
| BB2 := TDIB.Create; |
| BB2.BitCount := 24; |
| BB2.Assign(BB1); |
| _FishEye(BB1, BB2, Amount); |
| Self.Assign(BB2); |
| BB1.Free; |
| BB2.Free; |
| end; |
| |
| procedure TDIB.DoGrayScale; |
| procedure GrayScale(var clip: TDIB); |
| var |
| p0: pbytearray; |
| Gray, 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 |
| Gray := Round(p0[x * 3] * 0.3 + p0[x * 3 + 1] * 0.59 + p0[x * 3 + 2] * 0.11); |
| p0[x * 3] := Gray; |
| p0[x * 3 + 1] := Gray; |
| p0[x * 3 + 2] := Gray; |
| end; |
| end; |
| end; |
| var BB: TDIB; |
| begin |
| BB := TDIB.Create; |
| BB.BitCount := 24; |
| BB.Assign(Self); |
| GrayScale(BB); |
| Self.Assign(BB); |
| BB.Free; |
| end; |
| |
| procedure TDIB.DoLightness(Amount: Integer); |
| procedure _Lightness(var clip: TDIB; Amount: Integer); |
| var |
| p0: pbytearray; |
| 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]; |
| p0[x * 3] := IntToByte(r + ((255 - r) * Amount) div 255); |
| p0[x * 3 + 1] := IntToByte(g + ((255 - g) * Amount) div 255); |
| p0[x * 3 + 2] := IntToByte(b + ((255 - b) * Amount) div 255); |
| end; |
| end; |
| end; |
| var BB: TDIB; |
| begin |
| BB := TDIB.Create; |
| BB.BitCount := 24; |
| BB.Assign(Self); |
| _Lightness(BB, Amount); |
| Self.Assign(BB); |
| BB.Free; |
| end; |
| |
| procedure TDIB.DoDarkness(Amount: Integer); |
| var BB: TDIB; |
| begin |
| BB := TDIB.Create; |
| BB.BitCount := 24; |
| BB.Assign(Self); |
| BB.Darkness(Amount); |
| Self.Assign(BB); |
| BB.Free; |
| end; |
| |
| procedure TDIB.DoSaturation(Amount: Integer); |
| procedure _Saturation(var clip: TDIB; Amount: Integer); |
| var |
| p0: pbytearray; |
| Gray, 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]; |
| Gray := (r + g + b) div 3; |
| p0[x * 3] := IntToByte(Gray + (((r - Gray) * Amount) div 255)); |
| p0[x * 3 + 1] := IntToByte(Gray + (((g - Gray) * Amount) div 255)); |
| p0[x * 3 + 2] := IntToByte(Gray + (((b - Gray) * Amount) div 255)); |
| end; |
| end; |
| end; |
| var BB: TDIB; |
| begin |
| BB := TDIB.Create; |
| BB.BitCount := 24; |
| BB.Assign(Self); |
| _Saturation(BB, Amount); |
| Self.Assign(BB); |
| BB.Free; |
| end; |
| |
| procedure TDIB.DoSplitBlur(Amount: Integer); |
| {NOTE: For a gaussian blur is amount 3} |
| procedure _SplitBlur(var clip: TDIB; Amount: Integer); |
| var |
| p0, p1, p2: pbytearray; |
| cx, x, y: Integer; |
| Buf: array[0..3, 0..2] of byte; |
| begin |
| if Amount = 0 then Exit; |
| for y := 0 to clip.Height - 1 do |
| begin |
| p0 := clip.scanline[y]; |
| if y - Amount < 0 then p1 := clip.scanline[y] |
| else {y-Amount>0} p1 := clip.ScanLine[y - Amount]; |
| if y + Amount < clip.Height then p2 := clip.ScanLine[y + Amount] |
| else {y+Amount>=Height} p2 := clip.ScanLine[clip.Height - y]; |
| |
| for x := 0 to clip.Width - 1 do |
| begin |
| if x - Amount < 0 then cx := x |
| else {x-Amount>0} cx := x - Amount; |
| Buf[0, 0] := p1[cx * 3]; |
| Buf[0, 1] := p1[cx * 3 + 1]; |
| Buf[0, 2] := p1[cx * 3 + 2]; |
| Buf[1, 0] := p2[cx * 3]; |
| Buf[1, 1] := p2[cx * 3 + 1]; |
| Buf[1, 2] := p2[cx * 3 + 2]; |
| if x + Amount < clip.Width then cx := x + Amount |
| else {x+Amount>=Width} cx := clip.Width - x; |
| Buf[2, 0] := p1[cx * 3]; |
| Buf[2, 1] := p1[cx * 3 + 1]; |
| Buf[2, 2] := p1[cx * 3 + 2]; |
| Buf[3, 0] := p2[cx * 3]; |
| Buf[3, 1] := p2[cx * 3 + 1]; |
| Buf[3, 2] := p2[cx * 3 + 2]; |
| p0[x * 3] := (Buf[0, 0] + Buf[1, 0] + Buf[2, 0] + Buf[3, 0]) shr 2; |
| p0[x * 3 + 1] := (Buf[0, 1] + Buf[1, 1] + Buf[2, 1] + Buf[3, 1]) shr 2; |
| p0[x * 3 + 2] := (Buf[0, 2] + Buf[1, 2] + Buf[2, 2] + Buf[3, 2]) shr 2; |
| end; |
| end; |
| end; |
| var BB: TDIB; |
| begin |
| BB := TDIB.Create; |
| BB.BitCount := 24; |
| BB.Assign(Self); |
| _SplitBlur(BB, Amount); |
| Self.Assign(BB); |
| BB.Free; |
| end; |
| |
| procedure TDIB.DoGaussianBlur(Amount: Integer); |
| var BB: TDIB; |
| begin |
| BB := TDIB.Create; |
| BB.BitCount := 24; |
| BB.BitCount := 24; |
| BB.Assign(Self); |
| GaussianBlur(BB, Amount); |
| Self.Assign(BB); |
| BB.Free; |
| end; |
| |
| procedure TDIB.DoMosaic(Size: Integer); |
| procedure Mosaic(var Bm: TDIB; size: Integer); |
| var |
| x, y, i, j: Integer; |
| p1, p2: pbytearray; |
| r, g, b: byte; |
| begin |
| y := 0; |
| repeat |
| p1 := bm.scanline[y]; |
| repeat |
| j := 1; |
| repeat |
| p2 := bm.scanline[y]; |
| x := 0; |
| repeat |
| r := p1[x * 3]; |
| g := p1[x * 3 + 1]; |
| b := p1[x * 3 + 2]; |
| i := 1; |
| repeat |
| p2[x * 3] := r; |
| p2[x * 3 + 1] := g; |
| p2[x * 3 + 2] := b; |
| inc(x); |
| inc(i); |
| until (x >= bm.width) or (i > size); |
| until x >= bm.width; |
| inc(j); |
| inc(y); |
| until (y >= bm.height) or (j > size); |
| until (y >= bm.height) or (x >= bm.width); |
| until y >= bm.height; |
| end; |
| var BB: TDIB; |
| begin |
| BB := TDIB.Create; |
| BB.BitCount := 24; |
| BB.Assign(Self); |
| Mosaic(BB, Size); |
| Self.Assign(BB); |
| BB.Free; |
| end; |
| |
| procedure TDIB.DoTwist(Amount: Integer); |
| procedure _Twist(var Bmp, Dst: TDIB; Amount: Integer); |
| var |
| fxmid, fymid: Single; |
| txmid, tymid: Single; |
| fx, fy: Single; |
| tx2, ty2: Single; |
| r: Single; |
| theta: Single; |
| ifx, ify: Integer; |
| dx, dy: Single; |
| OFFSET: 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; |
| |
| function ArcTan2(xt, yt: Single): Single; {$IFDEF VER9UP}inline;{$ENDIF} |
| begin |
| if xt = 0 then |
| if yt > 0 then |
| Result := Pi / 2 |
| else |
| Result := -(Pi / 2) |
| else |
| begin |
| Result := ArcTan(yt / xt); |
| if xt < 0 then |
| Result := Pi + ArcTan(yt / xt); |
| end; |
| end; |
| |
| begin |
| OFFSET := -(Pi / 2); |
| dx := Bmp.Width - 1; |
| dy := Bmp.Height - 1; |
| r := Sqrt(dx * dx + dy * dy); |
| tx2 := r; |
| ty2 := r; |
| txmid := (Bmp.Width - 1) / 2; //Adjust these to move center of rotation |
| tymid := (Bmp.Height - 1) / 2; //Adjust these to move ...... |
| fxmid := (Bmp.Width - 1) / 2; |
| fymid := (Bmp.Height - 1) / 2; |
| if tx2 >= Bmp.Width then tx2 := Bmp.Width - 1; |
| if ty2 >= Bmp.Height then ty2 := Bmp.Height - 1; |
| |
| for ty := 0 to Round(ty2) do |
| begin |
| for tx := 0 to Round(tx2) do |
| begin |
| dx := tx - txmid; |
| dy := ty - tymid; |
| r := Sqrt(dx * dx + dy * dy); |
| if r = 0 then |
| begin |
| fx := 0; |
| fy := 0; |
| end |
| else |
| begin |
| theta := ArcTan2(dx, dy) - r / Amount - OFFSET; |
| fx := r * Cos(theta); |
| fy := r * Sin(theta); |
| end; |
| fx := fx + fxmid; |
| fy := fy + fymid; |
| |
| 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; |
| var BB1, BB2: TDIB; |
| begin |
| BB1 := TDIB.Create; |
| BB1.BitCount := 24; |
| BB1.Assign(Self); |
| BB2 := TDIB.Create; |
| BB2.BitCount := 24; |
| BB2.Assign(BB1); |
| _Twist(BB1, BB2, Amount); |
| Self.Assign(BB2); |
| BB1.Free; |
| BB2.Free; |
| end; |
| |
| procedure TDIB.DoTrace(Amount: Integer); |
| procedure Trace(src: TDIB; intensity: Integer); |
| var |
| x, y, i: Integer; |
| P1, P2, P3, P4: PByteArray; |
| tb, TraceB: byte; |
| hasb: Boolean; |
| bitmap: TDIB; |
| begin |
| bitmap := TDIB.create; |
| bitmap.width := src.width; |
| bitmap.height := src.height; |
| bitmap.canvas.draw(0, 0, src); |
| bitmap.BitCount := 8; |
| src.BitCount := 24; |
| hasb := false; |
| TraceB := $00; tb := 0; |
| for i := 1 to Intensity do |
| begin |
| for y := 0 to BitMap.height - 2 do |
| begin |
| P1 := BitMap.ScanLine[y]; |
| P2 := BitMap.scanline[y + 1]; |
| P3 := src.scanline[y]; |
| P4 := src.scanline[y + 1]; |
| x := 0; |
| repeat |
| if p1[x] <> p1[x + 1] then |
| begin |
| if not hasb then |
| begin |
| tb := p1[x + 1]; |
| hasb := true; |
| p3[x * 3] := TraceB; |
| p3[x * 3 + 1] := TraceB; |
| p3[x * 3 + 2] := TraceB; |
| end |
| else |
| begin |
| if p1[x] <> tb then |
| begin |
| p3[x * 3] := TraceB; |
| p3[x * 3 + 1] := TraceB; |
| p3[x * 3 + 2] := TraceB; |
| end |
| else |
| begin |
| p3[(x + 1) * 3] := TraceB; |
| p3[(x + 1) * 3 + 1] := TraceB; |
| p3[(x + 1) * 3 + 1] := TraceB; |
| end; |
| end; |
| end; |
| if p1[x] <> p2[x] then |
| begin |
| if not hasb then |
| begin |
| tb := p2[x]; |
| hasb := true; |
| p3[x * 3] := TraceB; |
| p3[x * 3 + 1] := TraceB; |
| p3[x * 3 + 2] := TraceB; |
| end |
| else |
| begin |
| if p1[x] <> tb then |
| begin |
| p3[x * 3] := TraceB; |
| p3[x * 3 + 1] := TraceB; |
| p3[x * 3 + 2] := TraceB; |
| end |
| else |
| begin |
| p4[x * 3] := TraceB; |
| p4[x * 3 + 1] := TraceB; |
| p4[x * 3 + 2] := TraceB; |
| end; |
| end; |
| end; |
| inc(x); |
| until x >= (BitMap.width - 2); |
| end; |
| if i > 1 then |
| for y := BitMap.height - 1 downto 1 do |
| begin |
| P1 := BitMap.ScanLine[y]; |
| P2 := BitMap.scanline[y - 1]; |
| P3 := src.scanline[y]; |
| P4 := src.scanline[y - 1]; |
| x := Bitmap.width - 1; |
| repeat |
| if p1[x] <> p1[x - 1] then |
| begin |
| if not hasb then |
| begin |
| tb := p1[x - 1]; |
| hasb := true; |
| p3[x * 3] := TraceB; |
| p3[x * 3 + 1] := TraceB; |
| p3[x * 3 + 2] := TraceB; |
| end |
| else |
| begin |
| if p1[x] <> tb then |
| begin |
| p3[x * 3] := TraceB; |
| p3[x * 3 + 1] := TraceB; |
| p3[x * 3 + 2] := TraceB; |
| end |
| else |
| begin |
| p3[(x - 1) * 3] := TraceB; |
| p3[(x - 1) * 3 + 1] := TraceB; |
| p3[(x - 1) * 3 + 2] := TraceB; |
| end; |
| end; |
| end; |
| if p1[x] <> p2[x] then |
| begin |
| if not hasb then |
| begin |
| tb := p2[x]; |
| hasb := true; |
| p3[x * 3] := TraceB; |
| p3[x * 3 + 1] := TraceB; |
| p3[x * 3 + 2] := TraceB; |
| end |
| else |
| begin |
| if p1[x] <> tb then |
| begin |
| p3[x * 3] := TraceB; |
| p3[x * 3 + 1] := TraceB; |
| p3[x * 3 + 2] := TraceB; |
| end |
| else |
| begin |
| p4[x * 3] := TraceB; |
| p4[x * 3 + 1] := TraceB; |
| p4[x * 3 + 2] := TraceB; |
| end; |
| end; |
| end; |
| dec(x); |
| until x <= 1; |
| end; |
| end; |
| bitmap.free; |
| end; |
| var BB1, BB2: TDIB; |
| begin |
| BB1 := TDIB.Create; |
| BB1.BitCount := 24; |
| BB1.Assign(Self); |
| BB2 := TDIB.Create; |
| BB2.BitCount := 24; |
| BB2.Assign(BB1); |
| Trace(BB2, Amount); |
| Self.Assign(BB2); |
| BB1.Free; |
| BB2.Free; |
| end; |
| |
| procedure TDIB.DoSplitlight(Amount: Integer); |
| procedure Splitlight(var clip: TDIB; amount: Integer); |
| var |
| x, y, i: Integer; |
| p1: pbytearray; |
| |
| function sinpixs(a: Integer): Integer; |
| begin |
| result := variant(sin(a / 255 * pi / 2) * 255); |
| end; |
| begin |
| for i := 1 to amount do |
| for y := 0 to clip.height - 1 do |
| begin |
| p1 := clip.scanline[y]; |
| for x := 0 to clip.width - 1 do |
| begin |
| p1[x * 3] := sinpixs(p1[x * 3]); |
| p1[x * 3 + 1] := sinpixs(p1[x * 3 + 1]); |
| p1[x * 3 + 2] := sinpixs(p1[x * 3 + 2]); |
| end; |
| end; |
| end; |
| var BB1 {,BB2}: TDIB; |
| begin |
| BB1 := TDIB.Create; |
| BB1.BitCount := 24; |
| BB1.Assign(Self); |
| // BB2 := TDIB.Create; |
| // BB2.BitCount := 24; |
| // BB2.Assign (BB1); |
| Splitlight(BB1, Amount); |
| Self.Assign(BB1); |
| BB1.Free; |
| // BB2.Free; |
| end; |
| |
| procedure TDIB.DoTile(Amount: Integer); |
| procedure SmoothResize(var Src, Dst: TDIB); |
| var |
| x, y, xP, yP, |
| yP2, xP2: Integer; |
| Read, Read2: PByteArray; |
| t, z, z2, iz2: Integer; |
| pc: PBytearray; |
| w1, w2, w3, w4: Integer; |
| Col1r, col1g, col1b, Col2r, col2g, col2b: byte; |
| begin |
| xP2 := ((src.Width - 1) shl 15) div Dst.Width; |
| yP2 := ((src.Height - 1) shl 15) div Dst.Height; |
| yP := 0; |
| for y := 0 to Dst.Height - 1 do |
| begin |
| xP := 0; |
| Read := src.ScanLine[yP shr 15]; |
| if yP shr 16 < src.Height - 1 then |
| Read2 := src.ScanLine[yP shr 15 + 1] |
| else |
| Read2 := src.ScanLine[yP shr 15]; |
| pc := Dst.scanline[y]; |
| z2 := yP and $7FFF; |
| iz2 := $8000 - z2; |
| for x := 0 to Dst.Width - 1 do |
| begin |
| t := xP shr 15; |
| Col1r := Read[t * 3]; |
| Col1g := Read[t * 3 + 1]; |
| Col1b := Read[t * 3 + 2]; |
| Col2r := Read2[t * 3]; |
| Col2g := Read2[t * 3 + 1]; |
| Col2b := Read2[t * 3 + 2]; |
| z := xP and $7FFF; |
| w2 := (z * iz2) shr 15; |
| w1 := iz2 - w2; |
| w4 := (z * z2) shr 15; |
| w3 := z2 - w4; |
| pc[x * 3 + 2] := |
| (Col1b * w1 + Read[(t + 1) * 3 + 2] * w2 + |
| Col2b * w3 + Read2[(t + 1) * 3 + 2] * w4) shr 15; |
| pc[x * 3 + 1] := |
| (Col1g * w1 + Read[(t + 1) * 3 + 1] * w2 + |
| Col2g * w3 + Read2[(t + 1) * 3 + 1] * w4) shr 15; |
| pc[x * 3] := |
| (Col1r * w1 + Read2[(t + 1) * 3] * w2 + |
| Col2r * w3 + Read2[(t + 1) * 3] * w4) shr 15; |
| Inc(xP, xP2); |
| end; |
| Inc(yP, yP2); |
| end; |
| end; |
| procedure Tile(src, dst: TDIB; amount: Integer); |
| var |
| w, h, w2, h2, i, j: Integer; |
| bm: TDIB; |
| begin |
| w := src.width; |
| h := src.height; |
| dst.width := w; |
| dst.height := h; |
| dst.Canvas.draw(0, 0, src); |
| if (amount <= 0) or ((w div amount) < 5) or ((h div amount) < 5) then exit; |
| h2 := h div amount; |
| w2 := w div amount; |
| bm := TDIB.create; |
| bm.width := w2; |
| bm.height := h2; |
| bm.BitCount := 24; |
| smoothresize(src, bm); |
| for j := 0 to amount - 1 do |
| for i := 0 to amount - 1 do |
| dst.canvas.Draw(i * w2, j * h2, bm); |
| bm.free; |
| end; |
| var BB1, BB2: TDIB; |
| begin |
| BB1 := TDIB.Create; |
| BB1.BitCount := 24; |
| BB1.Assign(Self); |
| BB2 := TDIB.Create; |
| BB2.BitCount := 24; |
| BB2.Assign(BB1); |
| Tile(BB1, BB2, Amount); |
| Self.Assign(BB2); |
| BB1.Free; |
| BB2.Free; |
| end; |
| |
| procedure TDIB.DoSpotLight(Amount: Integer; Spot: TRect); |
| procedure SpotLight(var src: TDIB; Amount: Integer; Spot: TRect); |
| var |
| bm, z: TDIB; |
| w, h: Integer; |
| begin |
| z := TDIB.Create; |
| try |
| z.SetSize(src.Width, src.Height, 24); |
| z.DrawTo(src, 0, 0, src.Width, src.Height, 0, 0); |
| w := z.Width; |
| h := z.Height; |
| bm := TDIB.create; |
| try |
| bm.Width := w; |
| bm.Height := h; |
| bm.Canvas.Brush.color := clblack; |
| bm.Canvas.FillRect(rect(0, 0, w, h)); |
| bm.Canvas.Brush.Color := clwhite; |
| bm.Canvas.Ellipse(Spot.left, spot.top, spot.right, spot.bottom); |
| bm.Transparent := true; |
| z.Canvas.CopyMode := cmSrcAnd; {as transparentcolor for white} |
| z.Canvas.Draw(0, 0, src); |
| z.Canvas.Draw(0, 0, bm); |
| src.Darkness(Amount); |
| src.Canvas.CopyMode := cmSrcPaint; |
| src.DrawTransparent(z, 0, 0, z.Width, z.Height, 0, 0, clBlack); |
| finally |
| bm.Free; |
| end; |
| finally |
| z.Free |
| end; |
| end; |
| var BB1, BB2: TDIB; |
| begin |
| BB1 := TDIB.Create; |
| BB1.BitCount := 24; |
| BB1.Assign(Self); |
| BB2 := TDIB.Create; |
| BB2.BitCount := 24; |
| BB2.Assign(BB1); |
| SpotLight(BB2, Amount, Spot); |
| Self.Assign(BB2); |
| BB1.Free; |
| BB2.Free; |
| end; |
| |
| procedure TDIB.DoEmboss; |
| procedure Emboss(var Bmp: TDIB); |
| var |
| x, y: Integer; |
| p1, p2: Pbytearray; |
| begin |
| for y := 0 to Bmp.Height - 2 do |
| begin |
| p1 := bmp.scanline[y]; |
| p2 := bmp.scanline[y + 1]; |
| for x := 0 to Bmp.Width - 4 do |
| begin |
| p1[x * 3] := (p1[x * 3] + (p2[(x + 3) * 3] xor $FF)) shr 1; |
| p1[x * 3 + 1] := (p1[x * 3 + 1] + (p2[(x + 3) * 3 + 1] xor $FF)) shr 1; |
| p1[x * 3 + 2] := (p1[x * 3 + 2] + (p2[(x + 3) * 3 + 2] xor $FF)) shr 1; |
| end; |
| end; |
| end; |
| var BB1, BB2: TDIB; |
| begin |
| BB1 := TDIB.Create; |
| BB1.BitCount := 24; |
| BB1.Assign(Self); |
| BB2 := TDIB.Create; |
| BB2.BitCount := 24; |
| BB2.Assign(BB1); |
| Emboss(BB2); |
| Self.Assign(BB2); |
| BB1.Free; |
| BB2.Free; |
| end; |
| |
| procedure TDIB.DoSolorize(Amount: Integer); |
| procedure Solorize(src, dst: TDIB; amount: Integer); |
| var |
| w, h, x, y: Integer; |
| ps, pd: pbytearray; |
| c: Integer; |
| begin |
| w := src.width; |
| h := src.height; |
| src.BitCount := 24; |
| dst.BitCount := 24; |
| for y := 0 to h - 1 do |
| begin |
| ps := src.scanline[y]; |
| pd := dst.scanline[y]; |
| for x := 0 to w - 1 do |
| begin |
| c := (ps[x * 3] + ps[x * 3 + 1] + ps[x * 3 + 2]) div 3; |
| if c > amount then |
| begin |
| pd[x * 3] := 255 - ps[x * 3]; |
| pd[x * 3 + 1] := 255 - ps[x * 3 + 1]; |
| pd[x * 3 + 2] := 255 - ps[x * 3 + 2]; |
| end |
| else |
| begin |
| pd[x * 3] := ps[x * 3]; |
| pd[x * 3 + 1] := ps[x * 3 + 1]; |
| pd[x * 3 + 2] := ps[x * 3 + 2]; |
| end; |
| end; |
| end; |
| end; |
| var BB1, BB2: TDIB; |
| begin |
| BB1 := TDIB.Create; |
| BB1.BitCount := 24; |
| BB1.Assign(Self); |
| BB2 := TDIB.Create; |
| BB2.BitCount := 24; |
| BB2.Assign(BB1); |
| Solorize(BB1, BB2, Amount); |
| Self.Assign(BB2); |
| BB1.Free; |
| BB2.Free; |
| end; |
| |
| procedure TDIB.DoPosterize(Amount: Integer); |
| procedure Posterize(src, dst: TDIB; amount: Integer); |
| var |
| w, h, x, y: Integer; |
| ps, pd: pbytearray; |
| begin |
| w := src.width; |
| h := src.height; |
| src.BitCount := 24; |
| dst.BitCount := 24; |
| for y := 0 to h - 1 do |
| begin |
| ps := src.scanline[y]; |
| pd := dst.scanline[y]; |
| for x := 0 to w - 1 do |
| begin |
| pd[x * 3] := round(ps[x * 3] / amount) * amount; |
| pd[x * 3 + 1] := round(ps[x * 3 + 1] / amount) * amount; |
| pd[x * 3 + 2] := round(ps[x * 3 + 2] / amount) * amount; |
| end; |
| end; |
| end; |
| var BB1, BB2: TDIB; |
| begin |
| BB1 := TDIB.Create; |
| BB1.BitCount := 24; |
| BB1.Assign(Self); |
| BB2 := TDIB.Create; |
| BB2.BitCount := 24; |
| BB2.Assign(BB1); |
| Posterize(BB1, BB2, Amount); |
| Self.Assign(BB2); |
| BB1.Free; |
| BB2.Free; |
| end; |
| |
| procedure TDIB.DoBrightness(Amount: Integer); |
| procedure Brightness(src, dst: TDIB; level: Integer); |
| const |
| MaxPixelCount = 32768; |
| type |
| pRGBArray = ^TRGBArray; |
| TRGBArray = array[0..MaxPixelCount - 1] of TRGBTriple; |
| var |
| i, j, value: Integer; |
| OrigRow, DestRow: pRGBArray; |
| begin |
| // get brightness increment value |
| value := level; |
| src.BitCount := 24; |
| dst.BitCount := 24; |
| // for each row of pixels |
| for i := 0 to src.Height - 1 do |
| begin |
| OrigRow := src.ScanLine[i]; |
| DestRow := dst.ScanLine[i]; |
| // for each pixel in row |
| for j := 0 to src.Width - 1 do |
| begin |
| // add brightness value to pixel's RGB values |
| if value > 0 then |
| begin |
| // RGB values must be less than 256 |
| DestRow[j].rgbtRed := Min(255, OrigRow[j].rgbtRed + value); |
| DestRow[j].rgbtGreen := Min(255, OrigRow[j].rgbtGreen + value); |
| DestRow[j].rgbtBlue := Min(255, OrigRow[j].rgbtBlue + value); |
| end |
| else |
| begin |
| // RGB values must be greater or equal than 0 |
| DestRow[j].rgbtRed := Max(0, OrigRow[j].rgbtRed + value); |
| DestRow[j].rgbtGreen := Max(0, OrigRow[j].rgbtGreen + value); |
| DestRow[j].rgbtBlue := Max(0, OrigRow[j].rgbtBlue + value); |
| end; |
| end; |
| end; |
| end; |
| var BB1, BB2: TDIB; |
| begin |
| BB1 := TDIB.Create; |
| BB1.BitCount := 24; |
| BB1.Assign(Self); |
| BB2 := TDIB.Create; |
| BB2.BitCount := 24; |
| BB2.Assign(BB1); |
| Brightness(BB1, BB2, Amount); |
| Self.Assign(BB2); |
| BB1.Free; |
| BB2.Free; |
| end; |
| |
| procedure TDIB.DoResample(AmountX, AmountY: Integer; TypeResample: TFilterTypeResample); |
| procedure Resample(Src, Dst: TDIB; filtertype: TFilterTypeResample; fwidth: single); |
| // ----------------------------------------------------------------------------- |
| // |
| // Filter functions |
| // |
| // ----------------------------------------------------------------------------- |
| |
| // 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; |
| |
| // 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; |
| |
| // 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; |
| |
| // 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; |
| |
| // 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; |
| |
| // 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; |
| |
| // ----------------------------------------------------------------------------- |
| // |
| // Interpolator |
| // |
| // ----------------------------------------------------------------------------- |
| type |
| // Contributor for a pixel |
| TContributor = record |
| pixel: Integer; // Source pixel |
| weight: single; // Pixel weight |
| end; |
| |
| TContributorList = array[0..0] of TContributor; |
| PContributorList = ^TContributorList; |
| |
| // List of source pixels contributing to a destination pixel |
| TCList = record |
| n: Integer; |
| p: PContributorList; |
| end; |
| |
| TCListList = array[0..0] of TCList; |
| PCListList = ^TCListList; |
| |
| TRGB = packed record |
| r, g, b: single; |
| end; |
| |
| // Physical bitmap pixel |
| TColorRGB = packed record |
| r, g, b: BYTE; |
| end; |
| PColorRGB = ^TColorRGB; |
| |
| // Physical bitmap scanline (row) |
| TRGBList = packed array[0..0] of TColorRGB; |
| PRGBList = ^TRGBList; |
| |
| var |
| xscale, yscale: single; // Zoom scale factors |
| i, j, k: Integer; // Loop variables |
| center: single; // Filter calculation variables |
| width, fscale, weight: single; // Filter calculation variables |
| left, right: Integer; // Filter calculation variables |
| n: Integer; // Pixel number |
| Work: TDIB; |
| contrib: PCListList; |
| rgb: TRGB; |
| color: TColorRGB; |
| {$IFDEF USE_SCANLINE} |
| SourceLine, |
| DestLine: PRGBList; |
| SourcePixel, |
| DestPixel: PColorRGB; |
| Delta, |
| DestDelta: Integer; |
| {$ENDIF} |
| SrcWidth, |
| SrcHeight, |
| DstWidth, |
| DstHeight: Integer; |
| |
| function Color2RGB(Color: TColor): TColorRGB; |
| begin |
| Result.r := Color and $000000FF; |
| Result.g := (Color and $0000FF00) shr 8; |
| Result.b := (Color and $00FF0000) shr 16; |
| end; |
| |
| function RGB2Color(Color: TColorRGB): TColor; |
| begin |
| Result := Color.r or (Color.g shl 8) or (Color.b shl 16); |
| end; |
| |
| begin |
| DstWidth := Dst.Width; |
| DstHeight := Dst.Height; |
| SrcWidth := Src.Width; |
| SrcHeight := Src.Height; |
| if (SrcWidth < 1) or (SrcHeight < 1) then |
| raise Exception.Create('Source bitmap too small'); |
| |
| // Create intermediate image to hold horizontal zoom |
| Work := TDIB.Create; |
| try |
| Work.Height := SrcHeight; |
| Work.Width := DstWidth; |
| // xscale := DstWidth / SrcWidth; |
| // yscale := DstHeight / SrcHeight; |
| // Improvement suggested by David Ullrich: |
| if (SrcWidth = 1) then |
| xscale := DstWidth / SrcWidth |
| else |
| xscale := (DstWidth - 1) / (SrcWidth - 1); |
| if (SrcHeight = 1) then |
| yscale := DstHeight / SrcHeight |
| else |
| yscale := (DstHeight - 1) / (SrcHeight - 1); |
| // This implementation only works on 24-bit images because it uses |
| // TDIB.Scanline |
| {$IFDEF USE_SCANLINE} |
| //Src.PixelFormat := pf24bit; |
| Src.BitCount := 24; |
| //Dst.PixelFormat := Src.PixelFormat; |
| dst.BitCount := 24; |
| //Work.PixelFormat := Src.PixelFormat; |
| work.BitCount := 24; |
| {$ENDIF} |
| |
| // -------------------------------------------- |
| // Pre-calculate filter contributions for a row |
| // ----------------------------------------------- |
| GetMem(contrib, DstWidth * sizeof(TCList)); |
| // Horizontal sub-sampling |
| // Scales from bigger to smaller width |
| if (xscale < 1.0) then |
| begin |
| width := fwidth / xscale; |
| fscale := 1.0 / xscale; |
| for i := 0 to DstWidth - 1 do |
| begin |
| contrib^[i].n := 0; |
| GetMem(contrib^[i].p, trunc(width * 2.0 + 1) * sizeof(TContributor)); |
| center := i / xscale; |
| // Original code: |
| // left := ceil(center - width); |
| // right := floor(center + width); |
| left := floor(center - width); |
| right := ceil(center + width); |
| for j := left to right do |
| begin |
| case filtertype of |
| ftrBox: weight := boxfilter((center - j) / fscale) / fscale; |
| ftrTriangle: weight := trianglefilter((center - j) / fscale) / fscale; |
| ftrHermite: weight := hermitefilter((center - j) / fscale) / fscale; |
| ftrBell: weight := bellfilter((center - j) / fscale) / fscale; |
| ftrBSpline: weight := splinefilter((center - j) / fscale) / fscale; |
| ftrLanczos3: weight := Lanczos3filter((center - j) / fscale) / fscale; |
| ftrMitchell: weight := Mitchellfilter((center - j) / fscale) / fscale; |
| else |
| weight := 0 |
| end; |
| if (weight = 0.0) then |
| continue; |
| if (j < 0) then |
| n := -j |
| else if (j >= SrcWidth) then |
| n := SrcWidth - j + SrcWidth - 1 |
| else |
| n := j; |
| k := contrib^[i].n; |
| contrib^[i].n := contrib^[i].n + 1; |
| contrib^[i].p^[k].pixel := n; |
| contrib^[i].p^[k].weight := weight; |
| end; |
| end; |
| end |
| else |
| // Horizontal super-sampling |
| // Scales from smaller to bigger width |
| begin |
| for i := 0 to DstWidth - 1 do |
| begin |
| contrib^[i].n := 0; |
| GetMem(contrib^[i].p, trunc(fwidth * 2.0 + 1) * sizeof(TContributor)); |
| center := i / xscale; |
| // Original code: |
| // left := ceil(center - fwidth); |
| // right := floor(center + fwidth); |
| left := floor(center - fwidth); |
| right := ceil(center + fwidth); |
| for j := left to right do |
| begin |
| case filtertype of |
| ftrBox: weight := boxfilter(center - j); |
| ftrTriangle: weight := trianglefilter(center - j); |
| ftrHermite: weight := hermitefilter(center - j); |
| ftrBell: weight := bellfilter(center - j); |
| ftrBSpline: weight := splinefilter(center - j); |
| ftrLanczos3: weight := Lanczos3filter(center - j); |
| ftrMitchell: weight := Mitchellfilter(center - j); |
| else |
| weight := 0 |
| end; |
| if (weight = 0.0) then |
| continue; |
| if (j < 0) then |
| n := -j |
| else if (j >= SrcWidth) then |
| n := SrcWidth - j + SrcWidth - 1 |
| else |
| n := j; |
| k := contrib^[i].n; |
| contrib^[i].n := contrib^[i].n + 1; |
| contrib^[i].p^[k].pixel := n; |
| contrib^[i].p^[k].weight := weight; |
| end; |
| end; |
| end; |
| |
| // ---------------------------------------------------- |
| // Apply filter to sample horizontally from Src to Work |
| // ---------------------------------------------------- |
| for k := 0 to SrcHeight - 1 do |
| begin |
| {$IFDEF USE_SCANLINE} |
| SourceLine := Src.ScanLine[k]; |
| DestPixel := Work.ScanLine[k]; |
| {$ENDIF} |
| for i := 0 to DstWidth - 1 do |
| begin |
| rgb.r := 0.0; |
| rgb.g := 0.0; |
| rgb.b := 0.0; |
| for j := 0 to contrib^[i].n - 1 do |
| begin |
| {$IFDEF USE_SCANLINE} |
| color := SourceLine^[contrib^[i].p^[j].pixel]; |
| {$ELSE} |
| color := Color2RGB(Src.Canvas.Pixels[contrib^[i].p^[j].pixel, k]); |
| {$ENDIF} |
| weight := contrib^[i].p^[j].weight; |
| if (weight = 0.0) then |
| continue; |
| rgb.r := rgb.r + color.r * weight; |
| rgb.g := rgb.g + color.g * weight; |
| rgb.b := rgb.b + color.b * weight; |
| end; |
| if (rgb.r > 255.0) then |
| color.r := 255 |
| else if (rgb.r < 0.0) then |
| color.r := 0 |
| else |
| color.r := round(rgb.r); |
| if (rgb.g > 255.0) then |
| color.g := 255 |
| else if (rgb.g < 0.0) then |
| color.g := 0 |
| else |
| color.g := round(rgb.g); |
| if (rgb.b > 255.0) then |
| color.b := 255 |
| else if (rgb.b < 0.0) then |
| color.b := 0 |
| else |
| color.b := round(rgb.b); |
| {$IFDEF USE_SCANLINE} |
| // Set new pixel value |
| DestPixel^ := color; |
| // Move on to next column |
| inc(DestPixel); |
| {$ELSE} |
| Work.Canvas.Pixels[i, k] := RGB2Color(color); |
| {$ENDIF} |
| end; |
| end; |
| |
| // Free the memory allocated for horizontal filter weights |
| for i := 0 to DstWidth - 1 do |
| FreeMem(contrib^[i].p); |
| |
| FreeMem(contrib); |
| |
| // ----------------------------------------------- |
| // Pre-calculate filter contributions for a column |
| // ----------------------------------------------- |
| GetMem(contrib, DstHeight * sizeof(TCList)); |
| // Vertical sub-sampling |
| // Scales from bigger to smaller height |
| if (yscale < 1.0) then |
| begin |
| width := fwidth / yscale; |
| fscale := 1.0 / yscale; |
| for i := 0 to DstHeight - 1 do |
| begin |
| contrib^[i].n := 0; |
| GetMem(contrib^[i].p, trunc(width * 2.0 + 1) * sizeof(TContributor)); |
| center := i / yscale; |
| // Original code: |
| // left := ceil(center - width); |
| // right := floor(center + width); |
| left := floor(center - width); |
| right := ceil(center + width); |
| for j := left to right do |
| begin |
| case filtertype of |
| ftrBox: weight := boxfilter((center - j) / fscale) / fscale; |
| ftrTriangle: weight := trianglefilter((center - j) / fscale) / fscale; |
| ftrHermite: weight := hermitefilter((center - j) / fscale) / fscale; |
| ftrBell: weight := bellfilter((center - j) / fscale) / fscale; |
| ftrBSpline: weight := splinefilter((center - j) / fscale) / fscale; |
| ftrLanczos3: weight := Lanczos3filter((center - j) / fscale) / fscale; |
| ftrMitchell: weight := Mitchellfilter((center - j) / fscale) / fscale; |
| else |
| weight := 0 |
| end; |
| if (weight = 0.0) then |
| continue; |
| if (j < 0) then |
| n := -j |
| else if (j >= SrcHeight) then |
| n := SrcHeight - j + SrcHeight - 1 |
| else |
| n := j; |
| k := contrib^[i].n; |
| contrib^[i].n := contrib^[i].n + 1; |
| contrib^[i].p^[k].pixel := n; |
| contrib^[i].p^[k].weight := weight; |
| end; |
| end |
| end |
| else |
| // Vertical super-sampling |
| // Scales from smaller to bigger height |
| begin |
| for i := 0 to DstHeight - 1 do |
| begin |
| contrib^[i].n := 0; |
| GetMem(contrib^[i].p, trunc(fwidth * 2.0 + 1) * sizeof(TContributor)); |
| center := i / yscale; |
| // Original code: |
| // left := ceil(center - fwidth); |
| // right := floor(center + fwidth); |
| left := floor(center - fwidth); |
| right := ceil(center + fwidth); |
| for j := left to right do |
| begin |
| case filtertype of |
| ftrBox: weight := boxfilter(center - j); |
| ftrTriangle: weight := trianglefilter(center - j); |
| ftrHermite: weight := hermitefilter(center - j); |
| ftrBell: weight := bellfilter(center - j); |
| ftrBSpline: weight := splinefilter(center - j); |
| ftrLanczos3: weight := Lanczos3filter(center - j); |
| ftrMitchell: weight := Mitchellfilter(center - j); |
| else |
| weight := 0 |
| end; |
| if (weight = 0.0) then |
| continue; |
| if (j < 0) then |
| n := -j |
| else if (j >= SrcHeight) then |
| n := SrcHeight - j + SrcHeight - 1 |
| else |
| n := j; |
| k := contrib^[i].n; |
| contrib^[i].n := contrib^[i].n + 1; |
| contrib^[i].p^[k].pixel := n; |
| contrib^[i].p^[k].weight := weight; |
| end; |
| end; |
| end; |
| |
| // -------------------------------------------------- |
| // Apply filter to sample vertically from Work to Dst |
| // -------------------------------------------------- |
| {$IFDEF USE_SCANLINE} |
| SourceLine := Work.ScanLine[0]; |
| Delta := Integer(Work.ScanLine[1]) - Integer(SourceLine); |
| DestLine := Dst.ScanLine[0]; |
| DestDelta := Integer(Dst.ScanLine[1]) - Integer(DestLine); |
| {$ENDIF} |
| for k := 0 to DstWidth - 1 do |
| begin |
| {$IFDEF USE_SCANLINE} |
| DestPixel := pointer(DestLine); |
| {$ENDIF} |
| for i := 0 to DstHeight - 1 do |
| begin |
| rgb.r := 0; |
| rgb.g := 0; |
| rgb.b := 0; |
| // weight := 0.0; |
| for j := 0 to contrib^[i].n - 1 do |
| begin |
| {$IFDEF USE_SCANLINE} |
| color := PColorRGB(Integer(SourceLine) + contrib^[i].p^[j].pixel * Delta)^; |
| {$ELSE} |
| color := Color2RGB(Work.Canvas.Pixels[k, contrib^[i].p^[j].pixel]); |
| {$ENDIF} |
| weight := contrib^[i].p^[j].weight; |
| if (weight = 0.0) then |
| continue; |
| rgb.r := rgb.r + color.r * weight; |
| rgb.g := rgb.g + color.g * weight; |
| rgb.b := rgb.b + color.b * weight; |
| end; |
| if (rgb.r > 255.0) then |
| color.r := 255 |
| else if (rgb.r < 0.0) then |
| color.r := 0 |
| else |
| color.r := round(rgb.r); |
| if (rgb.g > 255.0) then |
| color.g := 255 |
| else if (rgb.g < 0.0) then |
| color.g := 0 |
| else |
| color.g := round(rgb.g); |
| if (rgb.b > 255.0) then |
| color.b := 255 |
| else if (rgb.b < 0.0) then |
| color.b := 0 |
| else |
| color.b := round(rgb.b); |
| {$IFDEF USE_SCANLINE} |
| DestPixel^ := color; |
| inc(Integer(DestPixel), DestDelta); |
| {$ELSE} |
| Dst.Canvas.Pixels[k, i] := RGB2Color(color); |
| {$ENDIF} |
| end; |
| {$IFDEF USE_SCANLINE} |
| Inc(SourceLine, 1); |
| Inc(DestLine, 1); |
| {$ENDIF} |
| end; |
| |
| // Free the memory allocated for vertical filter weights |
| for i := 0 to DstHeight - 1 do |
| FreeMem(contrib^[i].p); |
| |
| FreeMem(contrib); |
| |
| finally |
| Work.Free; |
| end; |
| end; |
| var BB1, BB2: TDIB; |
| begin |
| BB1 := TDIB.Create; |
| BB1.BitCount := 24; |
| BB1.Assign(Self); |
| BB2 := TDIB.Create; |
| BB2.SetSize(AmountX, AmountY, 24); |
| Resample(BB1, BB2, TypeResample, DefaultFilterRadius[TypeResample]); |
| Self.Assign(BB2); |
| BB1.Free; |
| BB2.Free; |
| end; |
| |
| procedure TDIB.DoColorize(ForeColor, BackColor: TColor); |
| procedure Colorize(src, dst: TDIB; iForeColor, iBackColor: TColor; iDither: Boolean{$IFDEF VER4UP} = False{$ENDIF}); |
| {for monochromatic picture change colors} |
| procedure InvertBitmap(Bmp: TDIB); |
| begin |
| Bmp.Canvas.CopyMode := cmDstInvert; |
| Bmp.Canvas.CopyRect(rect(0, 0, Bmp.Width, Bmp.Height), |
| Bmp.Canvas, rect(0, 0, Bmp.Width, Bmp.Height)); |
| end; |
| var |
| fForeColor: TColor; |
| fForeDither: Boolean; |
| lTempBitmap: TDIB; |
| lTempBitmap2: TDIB; |
| lDitherBitmap: TDIB; |
| lCRect: TRect; |
| x, y, w, h: Integer; |
| begin |
| {--} |
| //fColor := iBackColor; ; |
| fForeColor := iForeColor; |
| fForeDither := iDither; |
| w := src.Width; |
| h := src.Height; |
| lDitherBitmap := nil; |
| lTempBitmap := TDIB.Create; |
| lTempBitmap.SetSize(w, h, 24); |
| lTempBitmap2 := TDIB.Create; |
| lTempBitmap2.SetSize(w, h, 24); |
| lCRect := rect(0, 0, w, h); |
| with lTempBitmap.Canvas do |
| begin |
| Brush.Style := bsSolid; |
| Brush.Color := iBackColor; |
| FillRect(lCRect); |
| CopyMode := cmSrcInvert; |
| CopyRect(lCRect, src.Canvas, lCRect); |
| InvertBitmap(src); |
| CopyMode := cmSrcPaint; |
| CopyRect(lCRect, src.Canvas, lCRect); |
| InvertBitmap(lTempBitmap); |
| CopyMode := cmSrcInvert; |
| CopyRect(lCRect, src.Canvas, lCRect); |
| InvertBitmap(src); |
| end; |
| with lTempBitmap2.Canvas do |
| begin |
| Brush.Style := bsSolid; |
| Brush.Color := clBlack; |
| FillRect(lCRect); |
| if fForeDither then |
| begin |
| InvertBitmap(src); |
| lDitherBitmap := TDIB.Create; |
| lDitherBitmap.SetSize(8, 8, 24); |
| with lDitherBitmap.Canvas do |
| begin |
| for x := 0 to 7 do |
| for y := 0 to 7 do |
| if ((x mod 2 = 0) and (y mod 2 > 0)) or ((x mod 2 > 0) and (y mod 2 = 0)) then |
| pixels[x, y] := fForeColor |
| else |
| pixels[x, y] := iBackColor; |
| end; |
| Brush.Bitmap.Assign(lDitherBitmap); |
| end |
| else |
| begin |
| Brush.Style := bsSolid; |
| Brush.Color := fForeColor; |
| end; |
| if not fForeDither then |
| InvertBitmap(src); |
| CopyMode := cmPatPaint; |
| CopyRect(lCRect, src.Canvas, lCRect); |
| if fForeDither then |
| if Assigned(lDitherBitmap) then |
| lDitherBitmap.Free; |
| CopyMode := cmSrcInvert; |
| CopyRect(lCRect, src.Canvas, lCRect); |
| end; |
| lTempBitmap.Canvas.CopyMode := cmSrcInvert; |
| lTempBitmap.Canvas.Copyrect(lCRect, lTempBitmap2.Canvas, lCRect); |
| InvertBitmap(src); |
| lTempBitmap.Canvas.CopyMode := cmSrcErase; |
| lTempBitmap.Canvas.Copyrect(lCRect, src.Canvas, lCRect); |
| InvertBitmap(src); |
| lTempBitmap.Canvas.CopyMode := cmSrcInvert; |
| lTempBitmap.Canvas.Copyrect(lCRect, lTempBitmap2.Canvas, lCRect); |
| InvertBitmap(lTempBitmap); |
| InvertBitmap(src); |
| dst.Assign(lTempBitmap); |
| lTempBitmap.Free; |
| end; |
| var BB1, BB2: TDIB; |
| begin |
| BB1 := TDIB.Create; |
| BB1.BitCount := 24; |
| BB1.Assign(Self); |
| BB2 := TDIB.Create; |
| Colorize(BB1, BB2, ForeColor, BackColor{$IFNDEF VER4UP}, False{$ENDIF}); |
| Self.Assign(BB2); |
| BB1.Free; |
| BB2.Free; |
| end; |
| |
| { procedure for special purpose } |
| |
| procedure TDIB.FadeOut(DIB2: TDIB; Step: Byte); |
| var |
| P1, P2: PByteArray; |
| W, H: Integer; |
| begin |
| P1 := ScanLine[DIB2.Height - 1]; |
| P2 := DIB2.ScanLine[DIB2.Height - 1]; |
| W := WidthBytes; |
| H := Height; |
| asm |
| PUSH ESI |
| PUSH EDI |
| MOV ESI, P1 |
| MOV EDI, P2 |
| MOV EDX, W |
| MOV EAX, H |
| IMUL EDX |
| MOV ECX, EAX |
| @@1: |
| MOV AL, Step |
| MOV AH, [ESI] |
| CMP AL, AH |
| JA @@2 |
| MOV AL, AH |
| @@2: |
| MOV [EDI], AL |
| INC ESI |
| INC EDI |
| DEC ECX |
| JNZ @@1 |
| POP EDI |
| POP ESI |
| end; |
| end; |
| |
| procedure TDIB.DoZoom(DIB2: TDIB; ZoomRatio: Real); |
| var |
| P1, P2: PByteArray; |
| W, H: Integer; |
| x, y: Integer; |
| xr, yr, xstep, ystep: real; |
| xstart: real; |
| begin |
| W := WidthBytes; |
| H := Height; |
| xstart := (W - (W * ZoomRatio)) / 2; |
| |
| xr := xstart; |
| yr := (H - (H * ZoomRatio)) / 2; |
| xstep := ZoomRatio; |
| ystep := ZoomRatio; |
| |
| for y := 1 to Height - 1 do |
| begin |
| P2 := DIB2.ScanLine[y]; |
| if (yr >= 0) and (yr <= H) then |
| begin |
| P1 := ScanLine[Trunc(yr)]; |
| for x := 1 to Width - 1 do |
| begin |
| if (xr >= 0) and (xr <= W) then |
| begin |
| P2[x] := P1[Trunc(xr)]; |
| end |
| else |
| begin |
| P2[x] := 0; |
| end; |
| xr := xr + xstep; |
| end; |
| end |
| else |
| begin |
| for x := 1 to Width - 1 do |
| begin |
| P2[x] := 0; |
| end; |
| end; |
| xr := xstart; |
| yr := yr + ystep; |
| end; |
| end; |
| |
| procedure TDIB.DoBlur(DIB2: TDIB); |
| var |
| P1, P2: PByteArray; |
| W: Integer; |
| x, y: Integer; |
| begin |
| W := WidthBytes; |
| for y := 1 to Height - 1 do |
| begin |
| P1 := ScanLine[y]; |
| P2 := DIB2.ScanLine[y]; |
| for x := 1 to Width - 1 do |
| begin |
| P2[x] := (P1[x] + P1[x - 1] + P1[x + 1] + P1[x + W] + P1[x - W]) div 5; |
| end; |
| end; |
| end; |
| |
| procedure TDIB.FadeIn(DIB2: TDIB; Step: Byte); |
| var |
| P1, P2: PByteArray; |
| W, H: Integer; |
| begin |
| P1 := ScanLine[DIB2.Height - 1]; |
| P2 := DIB2.ScanLine[DIB2.Height - 1]; |
| W := WidthBytes; |
| H := Height; |
| asm |
| PUSH ESI |
| PUSH EDI |
| MOV ESI, P1 |
| MOV EDI, P2 |
| MOV EDX, W |
| MOV EAX, H |
| IMUL EDX |
| MOV ECX, EAX |
| @@1: |
| MOV AL, Step |
| MOV AH, [ESI] |
| CMP AL, AH |
| JB @@2 |
| MOV AL, AH |
| @@2: |
| MOV [EDI], AL |
| INC ESI |
| INC EDI |
| DEC ECX |
| JNZ @@1 |
| POP EDI |
| POP ESI |
| end; |
| end; |
| |
| procedure TDIB.FillDIB8(Color: Byte); |
| var |
| P: PByteArray; |
| W, H: Integer; |
| begin |
| P := ScanLine[Height - 1]; |
| W := WidthBytes; |
| H := Height; |
| asm |
| PUSH ESI |
| MOV ESI, P |
| MOV EDX, W |
| MOV EAX, H |
| IMUL EDX |
| MOV ECX, EAX |
| MOV AL, Color |
| @@1: |
| MOV [ESI], AL |
| INC ESI |
| DEC ECX |
| JNZ @@1 |
| POP ESI |
| end; |
| end; |
| |
| procedure TDIB.DoRotate(DIB1: TDIB; cX, cY, Angle: Integer); |
| type |
| T3Byte = array[0..2] of Byte; |
| P3ByteArray = ^T3ByteArray; |
| T3ByteArray = array[0..32767] of T3Byte; |
| PLongArray = ^TLongArray; |
| TLongArray = array[0..32767] of LongInt; |
| var |
| p, p2: PByteArray; |
| x, y, x2, y2, angled: Integer; |
| cosy, siny: real; |
| begin |
| angled := 384 + Angle; |
| for y := 0 to Height - 1 do |
| begin |
| p := DIB1.ScanLine[y]; |
| cosy := (y - cY) * dcos(angled and $1FF); |
| siny := (y - cY) * dsin(angled and $1FF); |
| for x := 0 to Width - 1 do |
| begin |
| x2 := Trunc((x - cX) * dsin(angled and $1FF) + cosy) + cX; |
| y2 := Trunc((x - cX) * dcos(angled and $1FF) - siny) + cY; |
| case bitcount of |
| 8: |
| begin |
| if (y2 >= 0) and (y2 < Height) and (x2 >= 0) and (x2 < Width) then |
| begin |
| p2 := ScanLine[y2]; |
| p[x] := p2[Width - x2]; |
| end |
| else |
| begin |
| if p[x] > 4 then |
| p[x] := p[x] - 4 |
| else |
| p[x] := 0; |
| end; |
| end; |
| 16: |
| begin |
| if (y2 >= 0) and (y2 < Height) and (x2 >= 0) and (x2 < Width) then |
| begin |
| PWordArray(p2) := ScanLine[y2]; |
| PWordArray(p)[x] := PWordArray(p2)[Width - x2]; |
| end |
| else |
| begin |
| if PWordArray(p)[x] > 4 then |
| PWordArray(p)[x] := PWordArray(p)[x] - 4 |
| else |
| PWordArray(p)[x] := 0; |
| end; |
| end; |
| 24: |
| begin |
| if (y2 >= 0) and (y2 < Height) and (x2 >= 0) and (x2 < Width) then |
| begin |
| P3ByteArray(p2) := ScanLine[y2]; |
| P3ByteArray(p)[x] := P3ByteArray(p2)[Width - x2]; |
| end |
| else |
| begin |
| if P3ByteArray(p)[x][0] > 4 then |
| P3ByteArray(p)[x][0] := P3ByteArray(p)[x][0] - 4 |
| else if P3ByteArray(p)[x][1] > 4 then |
| P3ByteArray(p)[x][1] := P3ByteArray(p)[x][1] - 4 |
| else if P3ByteArray(p)[x][2] > 4 then |
| P3ByteArray(p)[x][2] := P3ByteArray(p)[x][2] - 4 |
| else |
| begin |
| P3ByteArray(p)[x][0] := 0; |
| P3ByteArray(p)[x][1] := 0; |
| P3ByteArray(p)[x][2] := 0; |
| end; |
| end; |
| end; |
| 32: begin |
| if (y2 >= 0) and (y2 < Height) and (x2 >= 0) and (x2 < Width) then |
| begin |
| plongarray(p2) := ScanLine[y2]; |
| plongarray(p)[x] := plongarray(p2)[Width - x2]; |
| end |
| else |
| begin |
| if plongarray(p)[x] > 4 then |
| plongarray(p)[x] := plongarray(p)[x] - 4 |
| else |
| plongarray(p)[x] := 0; |
| end; |
| end; |
| end |
| end; |
| end; |
| end; |
| |
| function TDIB.Ink(DIB: TDIB; const SprayInit: Boolean; const AmountSpray: Integer): Boolean; |
| type |
| T3Byte = array[0..2] of Byte; |
| P3ByteArray = ^T3ByteArray; |
| T3ByteArray = array[0..32767] of T3Byte; |
| PLongArray = ^TLongArray; |
| TLongArray = array[0..32767] of LongInt; |
| function ColorToRGBTriple(const Color: TColor): TRGBTriple; |
| begin |
| with RESULT do |
| begin |
| rgbtRed := GetRValue(Color); |
| rgbtGreen := GetGValue(Color); |
| rgbtBlue := GetBValue(Color) |
| end |
| end {ColorToRGBTriple}; |
| |
| function TestQuad(T: T3Byte; Color: Integer): Boolean; |
| begin |
| Result := (T[0] > GetRValue(Color)) and |
| (T[1] > GetGValue(Color)) and |
| (T[2] > GetBValue(Color)) |
| end; |
| var |
| p0, p, p2: PByteArray; |
| x, y, c: Integer; |
| z: Integer; |
| begin |
| if SprayInit then |
| begin |
| DIB.Assign(Self); |
| { Spray seeds } |
| for c := 0 to AmountSpray do |
| begin |
| DIB.Pixels[Random(Width - 1), Random(Height - 1)] := 0; |
| end; |
| end; |
| Result := True; {all is black} |
| for y := 0 to DIB.Height - 1 do |
| begin |
| p := DIB.ScanLine[y]; |
| for x := 0 to DIB.Width - 1 do |
| begin |
| case bitcount of |
| 8: |
| begin |
| if p[x] < 16 then |
| begin |
| if p[x] > 0 then Result := False; |
| if y > 0 then |
| begin |
| p0 := DIB.ScanLine[y - 1]; |
| if p0[x] > 4 then |
| p0[x] := p0[x] - 4 |
| else |
| p0[x] := 0; |
| if x > 0 then |
| if p0[x - 1] > 2 then |
| p0[x - 1] := p0[x - 1] - 2 |
| else |
| p0[x - 1] := 0; |
| if x < (DIB.Width - 1) then |
| if p0[x + 1] > 2 then |
| p0[x + 1] := p0[x + 1] - 2 |
| else |
| p0[x + 1] := 0; |
| end; |
| if y < (DIB.Height - 1) then |
| begin |
| p2 := DIB.ScanLine[y + 1]; |
| if p2[x] > 4 then |
| p2[x] := p2[x] - 4 |
| else |
| p2[x] := 0; |
| if x > 0 then |
| if p2[x - 1] > 2 then |
| p2[x - 1] := p2[x - 1] - 2 |
| else |
| p2[x - 1] := 0; |
| if x < (DIB.Width - 1) then |
| if p2[x + 1] > 2 then |
| p2[x + 1] := p2[x + 1] - 2 |
| else |
| p2[x + 1] := 0; |
| end; |
| if p[x] > 8 then |
| p[x] := p[x] - 8 |
| else |
| p[x] := 0; |
| if x > 0 then |
| if p[x - 1] > 4 then |
| p[x - 1] := p[x - 1] - 4 |
| else |
| p[x - 1] := 0; |
| if x < (DIB.Width - 1) then |
| if p[x + 1] > 4 then |
| p[x + 1] := p[x + 1] - 4 |
| else |
| p[x + 1] := 0; |
| end; |
| end; |
| 16: |
| begin |
| if pwordarray(p)[x] < 16 then |
| begin |
| if pwordarray(p)[x] > 0 then Result := False; |
| if y > 0 then |
| begin |
| pwordarray(p0) := DIB.ScanLine[y - 1]; |
| if pwordarray(p0)[x] > 4 then |
| pwordarray(p0)[x] := pwordarray(p0)[x] - 4 |
| else |
| pwordarray(p0)[x] := 0; |
| if x > 0 then |
| if pwordarray(p0)[x - 1] > 2 then |
| pwordarray(p0)[x - 1] := pwordarray(p0)[x - 1] - 2 |
| else |
| pwordarray(p0)[x - 1] := 0; |
| if x < (DIB.Width - 1) then |
| if pwordarray(p0)[x + 1] > 2 then |
| pwordarray(p0)[x + 1] := pwordarray(p0)[x + 1] - 2 |
| else |
| pwordarray(p0)[x + 1] := 0; |
| end; |
| if y < (DIB.Height - 1) then |
| begin |
| pwordarray(p2) := DIB.ScanLine[y + 1]; |
| if pwordarray(p2)[x] > 4 then |
| pwordarray(p2)[x] := pwordarray(p2)[x] - 4 |
| else |
| pwordarray(p2)[x] := 0; |
| if x > 0 then |
| if pwordarray(p2)[x - 1] > 2 then |
| pwordarray(p2)[x - 1] := pwordarray(p2)[x - 1] - 2 |
| else |
| pwordarray(p2)[x - 1] := 0; |
| if x < (DIB.Width - 1) then |
| if pwordarray(p2)[x + 1] > 2 then |
| pwordarray(p2)[x + 1] := pwordarray(p2)[x + 1] - 2 |
| else |
| pwordarray(p2)[x + 1] := 0; |
| end; |
| if pwordarray(p)[x] > 8 then |
| pwordarray(p)[x] := pwordarray(p)[x] - 8 |
| else |
| pwordarray(p)[x] := 0; |
| if x > 0 then |
| if pwordarray(p)[x - 1] > 4 then |
| pwordarray(p)[x - 1] := pwordarray(p)[x - 1] - 4 |
| else |
| pwordarray(p)[x - 1] := 0; |
| if x < (DIB.Width - 1) then |
| if pwordarray(p)[x + 1] > 4 then |
| pwordarray(p)[x + 1] := pwordarray(p)[x + 1] - 4 |
| else |
| pwordarray(p)[x + 1] := 0; |
| end; |
| end; |
| 24: |
| begin |
| if not TestQuad(P3ByteArray(p)[x], 16) then |
| begin |
| if TestQuad(P3ByteArray(p)[x], 0) then Result := False; |
| if y > 0 then |
| begin |
| P3ByteArray(p0) := DIB.ScanLine[y - 1]; |
| if TestQuad(P3ByteArray(p0)[x], 4) then |
| begin |
| for z := 0 to 2 do |
| if P3ByteArray(p0)[x][z] > 4 then |
| P3ByteArray(p0)[x][z] := P3ByteArray(p0)[x][z] - 4 |
| end |
| else |
| for z := 0 to 2 do |
| P3ByteArray(p0)[x][z] := 0; |
| if x > 0 then |
| if TestQuad(P3ByteArray(p0)[x - 1], 2) then |
| begin |
| for z := 0 to 2 do |
| if P3ByteArray(p0)[x - 1][z] > 2 then |
| P3ByteArray(p0)[x - 1][z] := P3ByteArray(p0)[x - 1][z] - 2 |
| end |
| else |
| for z := 0 to 2 do |
| P3ByteArray(p0)[x - 1][z] := 0; |
| if x < (DIB.Width - 1) then |
| if TestQuad(P3ByteArray(p0)[x + 1], 2) then |
| begin |
| for z := 0 to 2 do |
| if P3ByteArray(p0)[x + 1][z] > 2 then |
| P3ByteArray(p0)[x + 1][z] := P3ByteArray(p0)[x + 1][z] - 2 |
| end |
| else |
| for z := 0 to 2 do |
| P3ByteArray(p0)[x + 1][z] := 0; |
| end; |
| if y < (DIB.Height - 1) then |
| begin |
| P3ByteArray(p2) := DIB.ScanLine[y + 1]; |
| if TestQuad(P3ByteArray(p2)[x], 4) then |
| begin |
| for z := 0 to 2 do |
| if P3ByteArray(p2)[x][z] > 4 then |
| P3ByteArray(p2)[x][z] := P3ByteArray(p2)[x][z] - 4 |
| end |
| else |
| for z := 0 to 2 do |
| P3ByteArray(p2)[x][z] := 0; |
| if x > 0 then |
| if TestQuad(P3ByteArray(p2)[x - 1], 2) then |
| begin |
| for z := 0 to 2 do |
| if P3ByteArray(p2)[x - 1][z] > 2 then |
| P3ByteArray(p2)[x - 1][z] := P3ByteArray(p2)[x - 1][z] - 2 |
| end |
| else |
| for z := 0 to 2 do |
| P3ByteArray(p2)[x - 1][z] := 0; |
| if x < (DIB.Width - 1) then |
| if TestQuad(P3ByteArray(p2)[x + 1], 2) then |
| begin |
| for z := 0 to 2 do |
| if P3ByteArray(p2)[x + 1][z] > 2 then |
| P3ByteArray(p2)[x + 1][z] := P3ByteArray(p2)[x + 1][z] - 2 |
| end |
| else |
| for z := 0 to 2 do |
| P3ByteArray(p2)[x + 1][z] := 0; |
| end; |
| if TestQuad(P3ByteArray(p)[x], 8) then |
| begin |
| for z := 0 to 2 do |
| if P3ByteArray(p)[x][z] > 8 then |
| P3ByteArray(p)[x][z] := P3ByteArray(p)[x][z] - 8 |
| end |
| else |
| for z := 0 to 2 do |
| P3ByteArray(p)[x][z] := 0; |
| if x > 0 then |
| if TestQuad(P3ByteArray(p)[x - 1], 4) then |
| begin |
| for z := 0 to 2 do |
| if P3ByteArray(p)[x - 1][z] > 4 then |
| P3ByteArray(p)[x - 1][z] := P3ByteArray(p)[x - 1][z] - 4 |
| end |
| else |
| for z := 0 to 2 do |
| P3ByteArray(p)[x - 1][z] := 0; |
| if x < (DIB.Width - 1) then |
| if TestQuad(P3ByteArray(p)[x + 1], 4) then |
| begin |
| for z := 0 to 2 do |
| if P3ByteArray(p)[x + 1][z] > 4 then |
| P3ByteArray(p)[x + 1][z] := P3ByteArray(p)[x + 1][z] - 4 |
| end |
| else |
| for z := 0 to 2 do |
| P3ByteArray(p)[x + 1][z] := 0; |
| end; |
| end; |
| 32: |
| begin |
| if plongarray(p)[x] < 16 then |
| begin |
| if plongarray(p)[x] > 0 then Result := False; |
| if y > 0 then |
| begin |
| plongarray(p0) := DIB.ScanLine[y - 1]; |
| if plongarray(p0)[x] > 4 then |
| plongarray(p0)[x] := plongarray(p0)[x] - 4 |
| else |
| plongarray(p0)[x] := 0; |
| if x > 0 then |
| if plongarray(p0)[x - 1] > 2 then |
| plongarray(p0)[x - 1] := plongarray(p0)[x - 1] - 2 |
| else |
| plongarray(p0)[x - 1] := 0; |
| if x < (DIB.Width - 1) then |
| if plongarray(p0)[x + 1] > 2 then |
| plongarray(p0)[x + 1] := plongarray(p0)[x + 1] - 2 |
| else |
| plongarray(p0)[x + 1] := 0; |
| end; |
| if y < (DIB.Height - 1) then |
| begin |
| plongarray(p2) := DIB.ScanLine[y + 1]; |
| if plongarray(p2)[x] > 4 then |
| plongarray(p2)[x] := plongarray(p2)[x] - 4 |
| else |
| plongarray(p2)[x] := 0; |
| if x > 0 then |
| if plongarray(p2)[x - 1] > 2 then |
| plongarray(p2)[x - 1] := plongarray(p2)[x - 1] - 2 |
| else |
| plongarray(p2)[x - 1] := 0; |
| if x < (DIB.Width - 1) then |
| if plongarray(p2)[x + 1] > 2 then |
| plongarray(p2)[x + 1] := plongarray(p2)[x + 1] - 2 |
| else |
| plongarray(p2)[x + 1] := 0; |
| end; |
| if plongarray(p)[x] > 8 then |
| plongarray(p)[x] := plongarray(p)[x] - 8 |
| else |
| plongarray(p)[x] := 0; |
| if x > 0 then |
| if plongarray(p)[x - 1] > 4 then |
| plongarray(p)[x - 1] := plongarray(p)[x - 1] - 4 |
| else |
| plongarray(p)[x - 1] := 0; |
| if x < (DIB.Width - 1) then |
| if plongarray(p)[x + 1] > 4 then |
| plongarray(p)[x + 1] := plongarray(p)[x + 1] - 4 |
| else |
| plongarray(p)[x + 1] := 0; |
| end; |
| end; |
| end {case}; |
| end; |
| end; |
| end; |
| |
| procedure TDIB.Distort(DIB1: TDIB; dt: TDistortType; cX, cY, Angle: Integer; Factor: Real); |
| type |
| T3Byte = array[0..2] of Byte; |
| P3ByteArray = ^T3ByteArray; |
| T3ByteArray = array[0..32767] of T3Byte; |
| PLongArray = ^TLongArray; |
| TLongArray = array[0..32767] of LongInt; |
| var |
| p, p2: PByteArray; |
| x, y, x2, y2, angled, ysqr: Integer; |
| actdist, dist, cosy, siny: real; |
| begin |
| dist := Factor * sqrt(sqr(cX) + sqr(cY)); |
| for y := 0 to DIB1.Height - 1 do |
| begin |
| p := DIB1.ScanLine[y]; |
| ysqr := sqr(y - cY); |
| for x := 0 to (DIB1.Width) - 1 do |
| begin |
| actdist := (sqrt((sqr(x - cX) + ysqr)) / dist); |
| if dt = dtSlow then |
| actdist := dsin((Trunc(actdist * 1024)) and $1FF); |
| angled := 384 + Trunc((actdist) * Angle); |
| |
| cosy := (y - cY) * dcos(angled and $1FF); |
| siny := (y - cY) * dsin(angled and $1FF); |
| |
| x2 := Trunc((x - cX) * dsin(angled and $1FF) + cosy) + cX; |
| y2 := Trunc((x - cX) * dcos(angled and $1FF) - siny) + cY; |
| case bitcount of |
| 8: |
| begin |
| if (y2 >= 0) and (y2 < Height) and (x2 >= 0) and (x2 < Width) then |
| begin |
| p2 := ScanLine[y2]; |
| p[x] := p2[Width - x2]; |
| end |
| else |
| begin |
| if p[x] > 2 then |
| p[x] := p[x] - 2 |
| else |
| p[x] := 0; |
| end; |
| end; |
| 16: |
| begin |
| if (y2 >= 0) and (y2 < Height) and (x2 >= 0) and (x2 < Width) then |
| begin |
| pwordarray(p2) := ScanLine[y2]; |
| pwordarray(p)[x] := pwordarray(p2)[Width - x2]; |
| end |
| else |
| begin |
| if pwordarray(p)[x] > 2 then |
| pwordarray(p)[x] := pwordarray(p)[x] - 2 |
| else |
| pwordarray(p)[x] := 0; |
| end; |
| end; |
| 24: |
| begin |
| if (y2 >= 0) and (y2 < Height) and (x2 >= 0) and (x2 < Width) then |
| begin |
| P3ByteArray(p2) := ScanLine[y2]; |
| P3ByteArray(p)[x] := P3ByteArray(p2)[Width - x2]; |
| end |
| else |
| begin |
| if P3ByteArray(p)[x][0] > 2 then |
| P3ByteArray(p)[x][0] := P3ByteArray(p)[x][0] - 2 |
| else if P3ByteArray(p)[x][1] > 2 then |
| P3ByteArray(p)[x][1] := P3ByteArray(p)[x][1] - 2 |
| else if P3ByteArray(p)[x][2] > 2 then |
| P3ByteArray(p)[x][2] := P3ByteArray(p)[x][2] - 2 |
| else |
| begin |
| P3ByteArray(p)[x][0] := 0; |
| P3ByteArray(p)[x][1] := 0; |
| P3ByteArray(p)[x][2] := 0; |
| end; |
| end; |
| end; |
| 32: |
| begin |
| if (y2 >= 0) and (y2 < Height) and (x2 >= 0) and (x2 < Width) then |
| begin |
| plongarray(p2) := ScanLine[y2]; |
| plongarray(p)[x] := plongarray(p2)[Width - x2]; |
| end |
| else |
| begin |
| if p[x] > 2 then |
| plongarray(p)[x] := plongarray(p)[x] - 2 |
| else |
| plongarray(p)[x] := 0; |
| end; |
| end; |
| end {case} |
| end; |
| end; |
| end; |
| |
| procedure TDIB.AntialiasedLine(x1, y1, x2, y2: Integer; color: TColor); |
| //anti-aliased line using the Wu algorithm by Peter Bone |
| var |
| dX, dY, X, Y, start, finish: Integer; |
| LM, LR: Integer; |
| dxi, dyi, dydxi: Integer; |
| P: PLines; |
| R, G, B: byte; |
| begin |
| R := GetRValue(Color); |
| G := GetGValue(Color); |
| B := GetBValue(Color); |
| dX := abs(x2 - x1); // Calculate deltax and deltay for initialisation |
| dY := abs(y2 - y1); |
| if (dX = 0) or (dY = 0) then |
| begin |
| Canvas.Pen.Color := (B shl 16) + (G shl 8) + R; |
| Canvas.MoveTo(x1, y1); |
| Canvas.LineTo(x2, y2); |
| exit; |
| end; |
| if dX > dY then |
| begin // horizontal or vertical |
| if y2 > y1 then // determine rise and run |
| dydxi := -dY shl 16 div dX |
| else |
| dydxi := dY shl 16 div dX; |
| if x2 < x1 then |
| begin |
| start := x2; // right to left |
| finish := x1; |
| dyi := y2 shl 16; |
| end |
| else |
| begin |
| start := x1; // left to right |
| finish := x2; |
| dyi := y1 shl 16; |
| dydxi := -dydxi; // inverse slope |
| end; |
| if finish >= Width then finish := Width - 1; |
| for X := start to finish do |
| begin |
| Y := dyi shr 16; |
| if (X < 0) or (Y < 0) or (Y > Height - 2) then |
| begin |
| Inc(dyi, dydxi); |
| Continue; |
| end; |
| LM := dyi - Y shl 16; // fractional part of dyi - in fixed-point |
| LR := 65536 - LM; |
| P := Scanline[Y]; |
| P^[X].B := (B * LR + P^[X].B * LM) shr 16; |
| P^[X].G := (G * LR + P^[X].G * LM) shr 16; |
| P^[X].R := (R * LR + P^[X].R * LM) shr 16; |
| //Inc(Y); |
| P^[X].B := (B * LM + P^[X].B * LR) shr 16; |
| P^[X].G := (G * LM + P^[X].G * LR) shr 16; |
| P^[X].R := (R * LM + P^[X].R * LR) shr 16; |
| Inc(dyi, dydxi); // next point |
| end; |
| end |
| else |
| begin |
| if x2 > x1 then // determine rise and run |
| dydxi := -dX shl 16 div dY |
| else |
| dydxi := dX shl 16 div dY; |
| if y2 < y1 then |
| begin |
| start := y2; // right to left |
| finish := y1; |
| dxi := x2 shl 16; |
| end |
| else |
| begin |
| start := y1; // left to right |
| finish := y2; |
| dxi := x1 shl 16; |
| dydxi := -dydxi; // inverse slope |
| end; |
| if finish >= Height then finish := Height - 1; |
| for Y := start to finish do |
| begin |
| X := dxi shr 16; |
| if (Y < 0) or (X < 0) or (X > Width - 2) then |
| begin |
| Inc(dxi, dydxi); |
| Continue; |
| end; |
| LM := dxi - X shl 16; |
| LR := 65536 - LM; |
| P := Scanline[Y]; |
| P^[X].B := (B * LR + P^[X].B * LM) shr 16; |
| P^[X].G := (G * LR + P^[X].G * LM) shr 16; |
| P^[X].R := (R * LR + P^[X].R * LM) shr 16; |
| Inc(X); |
| P^[X].B := (B * LM + P^[X].B * LR) shr 16; |
| P^[X].G := (G * LM + P^[X].G * LR) shr 16; |
| P^[X].R := (R * LM + P^[X].R * LR) shr 16; |
| Inc(dxi, dydxi); // next point |
| end; |
| end; |
| end; |
| |
| function TDIB.GetColorBetween(StartColor, EndColor: TColor; Pointvalue, |
| FromPoint, ToPoint: Extended): TColor; |
| var F: Extended; r1, r2, r3, g1, g2, g3, b1, b2, b3: Byte; |
| function CalcColorBytes(fb1, fb2: Byte): Byte; |
| begin |
| result := fb1; |
| if fb1 < fb2 then Result := FB1 + Trunc(F * (fb2 - fb1)); |
| if fb1 > fb2 then Result := FB1 - Trunc(F * (fb1 - fb2)); |
| end; |
| begin |
| if Pointvalue <= FromPoint then |
| begin |
| result := StartColor; |
| exit; |
| end; |
| if Pointvalue >= ToPoint then |
| begin |
| result := EndColor; |
| exit; |
| end; |
| F := (Pointvalue - FromPoint) / (ToPoint - FromPoint); |
| asm |
| mov EAX, Startcolor |
| cmp EAX, EndColor |
| je @@exit //when equal then exit |
| mov r1, AL |
| shr EAX,8 |
| mov g1, AL |
| shr EAX,8 |
| mov b1, AL |
| mov EAX, Endcolor |
| mov r2, AL |
| shr EAX,8 |
| mov g2, AL |
| shr EAX,8 |
| mov b2, AL |
| push ebp |
| mov AL, r1 |
| mov DL, r2 |
| call CalcColorBytes |
| pop ECX |
| push EBP |
| Mov r3, AL |
| mov DL, g2 |
| mov AL, g1 |
| call CalcColorBytes |
| pop ECX |
| push EBP |
| mov g3, Al |
| mov DL, B2 |
| mov Al, B1 |
| call CalcColorBytes |
| pop ECX |
| mov b3, AL |
| XOR EAX,EAX |
| mov AL, B3 |
| shl EAX,8 |
| mov AL, G3 |
| shl EAX,8 |
| mov AL, R3 |
| @@Exit: |
| mov @result, EAX |
| end; |
| end; |
| |
| procedure TDIB.ColoredLine(const iStart, iEnd: TPoint; iColorStyle: TColorLineStyle; |
| iGradientFrom, iGradientTo: TColor; iPixelGeometry: TColorLinePixelGeometry; iRadius: Word); |
| var |
| tempColor: TColor; |
| const |
| WavelengthMinimum = 380; |
| WavelengthMaximum = 780; |
| |
| procedure SetColor(Color: TColor); |
| begin |
| Canvas.Pen.Color := Color; |
| Canvas.Brush.Color := Color; |
| tempColor := Color |
| end {SetColor}; |
| |
| function WL2RGB(const Wavelength: Double): TColor; {$IFDEF VER9UP}inline;{$ENDIF} |
| const |
| Gamma = 0.80; |
| IntensityMax = 255; |
| var |
| Red, Blue, Green, Factor: Double; |
| |
| function Adjust(const Color, Factor: Double): Integer; {$IFDEF VER9UP}inline;{$ENDIF} |
| begin |
| if Color = 0.0 then Result := 0 |
| else Result := Round(IntensityMax * Power(Color * Factor, Gamma)) |
| end {Adjust}; |
| begin |
| case Trunc(Wavelength) of |
| 380..439: |
| begin |
| Red := -(Wavelength - 440) / (440 - 380); |
| Green := 0.0; |
| Blue := 1.0 |
| end; |
| 440..489: |
| begin |
| Red := 0.0; |
| Green := (Wavelength - 440) / (490 - 440); |
| Blue := 1.0 |
| end; |
| 490..509: |
| begin |
| Red := 0.0; |
| Green := 1.0; |
| Blue := -(Wavelength - 510) / (510 - 490) |
| end; |
| 510..579: |
| begin |
| Red := (Wavelength - 510) / (580 - 510); |
| Green := 1.0; |
| Blue := 0.0 |
| end; |
| 580..644: |
| begin |
| Red := 1.0; |
| Green := -(Wavelength - 645) / (645 - 580); |
| Blue := 0.0 |
| end; |
| 645..780: |
| begin |
| Red := 1.0; |
| Green := 0.0; |
| Blue := 0.0 |
| end; |
| else |
| Red := 0.0; |
| Green := 0.0; |
| Blue := 0.0 |
| end; |
| case Trunc(Wavelength) of |
| 380..419: factor := 0.3 + 0.7 * (Wavelength - 380) / (420 - 380); |
| 420..700: factor := 1.0; |
| 701..780: factor := 0.3 + 0.7 * (780 - Wavelength) / (780 - 700) |
| else |
| factor := 0.0 |
| end; |
| Result := RGB(Adjust(Red, Factor), Adjust(Green, Factor), Adjust(Blue, Factor)); |
| end; |
| |
| function Rainbow(const fraction: Double): TColor; {$IFDEF VER9UP}inline;{$ENDIF} |
| begin |
| if (fraction < 0.0) or (fraction > 1.0) then Result := clBlack |
| else |
| Result := WL2RGB(WavelengthMinimum + Fraction * (WavelengthMaximum - WavelengthMinimum)) |
| end {Raindbow}; |
| |
| function ColorInterpolate(const fraction: Double; const Color1, Color2: TColor): TColor; {$IFDEF VER9UP}inline;{$ENDIF} |
| var |
| complement: Double; |
| R1, R2, G1, G2, B1, B2: BYTE; |
| begin |
| if fraction <= 0 then Result := Color1 |
| else |
| if fraction >= 1.0 then Result := Color2 |
| else |
| begin |
| R1 := GetRValue(Color1); |
| G1 := GetGValue(Color1); |
| B1 := GetBValue(Color1); |
| R2 := GetRValue(Color2); |
| G2 := GetGValue(Color2); |
| B2 := GetBValue(Color2); |
| complement := 1.0 - fraction; |
| Result := RGB(Round(complement * R1 + fraction * R2), |
| Round(complement * G1 + fraction * G2), |
| Round(complement * B1 + fraction * B2)) |
| end |
| end {ColorInterpolate}; |
| |
| // Conversion utility routines |
| function ColorToRGBTriple(const Color: TColor): TRGBTriple; {$IFDEF VER9UP}inline;{$ENDIF} |
| begin |
| with Result do |
| begin |
| rgbtRed := GetRValue(Color); |
| rgbtGreen := GetGValue(Color); |
| rgbtBlue := GetBValue(Color) |
| end |
| end {ColorToRGBTriple}; |
| |
| function RGBTripleToColor(const Triple: TRGBTriple): TColor; {$IFDEF VER9UP}inline;{$ENDIF} |
| begin |
| Result := RGB(Triple.rgbtRed, Triple.rgbtGreen, Triple.rgbtBlue) |
| end {RGBTripleToColor}; |
| // Bresenham's Line Algorithm. Byte, March 1988, pp. 249-253. |
| var |
| a, b, d, diag_inc, dXdg, dXndg, dYdg, dYndg, i, nDginc, nDswap, x, y: Integer; |
| begin {DrawLine} |
| x := iStart.X; |
| y := iStart.Y; |
| a := iEnd.X - iStart.X; |
| b := iEnd.Y - iStart.Y; |
| if a < 0 then |
| begin |
| a := -a; |
| dXdg := -1 |
| end |
| else dXdg := 1; |
| if b < 0 then |
| begin |
| b := -b; |
| dYdg := -1 |
| end |
| else dYdg := 1; |
| if a < b then |
| begin |
| nDswap := a; |
| a := b; |
| b := nDswap; |
| dXndg := 0; |
| dYndg := dYdg |
| end |
| else |
| begin |
| dXndg := dXdg; |
| dYndg := 0 |
| end; |
| d := b + b - a; |
| nDginc := b + b; |
| diag_inc := b + b - a - a; |
| for i := 0 to a do |
| begin |
| case iPixelGeometry of |
| pgPoint: |
| case iColorStyle of |
| csSolid: |
| Canvas.Pixels[x, y] := tempColor; |
| csGradient: |
| Canvas.Pixels[x, y] := ColorInterpolate(i / a, iGradientFrom, iGradientTo); |
| csRainbow: |
| Canvas.Pixels[x, y] := Rainbow(i / a) |
| end; |
| pgCircular: |
| begin |
| case iColorStyle of |
| csSolid: ; |
| csGradient: SetColor(ColorInterpolate(i / a, iGradientFrom, iGradientTo)); |
| csRainbow: SetColor(Rainbow(i / a)) |
| end; |
| Canvas.Ellipse(x - iRadius, y - iRadius, x + iRadius, y + iRadius) |
| end; |
| pgRectangular: |
| begin |
| case iColorStyle of |
| csSolid: ; |
| csGradient: SetColor(ColorInterpolate(i / a, iGradientFrom, iGradientTo)); |
| csRainbow: SetColor(Rainbow(i / a)) |
| end; |
| Canvas.Rectangle(x - iRadius, y - iRadius, x + iRadius, y + iRadius) |
| end |
| end; |
| if d < 0 then |
| begin |
| Inc(x, dXndg); |
| Inc(y, dYndg); |
| Inc(d, nDginc); |
| end |
| else |
| begin |
| Inc(x, dXdg); |
| Inc(y, dYdg); |
| Inc(d, diag_inc); |
| end |
| end |
| end {Line}; |
| |
| procedure TDIB.DoNovaEffect(sr, sg, sb, cx, cy, radius, |
| nspokes, randomhue, randomspok, randgauss: Integer; onProgress: TProgressEvent); |
| // Copyright (c) 2000 by Keith Murray (kmurray@hotfreeware.com) |
| // All rights reserved. |
| // Adapted for DIB by JB. |
| type |
| PByteArray = ^TByteArray; |
| TByteArray = array[0..32767] of Byte; |
| PDoubleArray = ^TDoubleArray; |
| TDoubleArray = array[0..32767] of Double; |
| PIntegerArray = ^TIntegerArray; |
| TIntegerArray = array[0..32767] of Integer; |
| type |
| TProgressEvent = procedure(progress: Integer; message: string; |
| var cancel: Boolean) of object; |
| const |
| M_PI = 3.14159265358979323846; |
| RAND_MAX = 2147483647; |
| |
| function Gauss: double; |
| const magnitude = 6; |
| var |
| sum: double; |
| i: Integer; |
| begin |
| sum := 0; |
| for i := 1 to magnitude do |
| sum := sum + (randgauss / 2147483647); |
| result := sum / magnitude; |
| end; |
| |
| function Clamp(i, l, h: double): double; {$IFDEF VER9UP}inline;{$ENDIF} |
| begin |
| if i < l then |
| result := l |
| else |
| if i > h then |
| result := h |
| else |
| result := i; |
| end; |
| |
| function IClamp(i, l, h: Integer): Integer; {$IFDEF VER9UP}inline;{$ENDIF} |
| begin |
| if i < l then |
| result := l |
| else if i > h then |
| result := h |
| else result := i; |
| end; |
| |
| procedure rgb_to_hsl(r, g, b: Double; var h, s, l: Double); {$IFDEF VER9UP}inline;{$ENDIF} |
| {$IFNDEF VER4UP} |
| function Max(a, b: Double): Double; |
| begin |
| Result := a; if b > a then Result := b; |
| end; |
| function Min(a, b: Double): Double; |
| begin |
| Result := a; if b < a then Result := b; |
| end; |
| {$ENDIF} |
| var |
| v, m, vm: Double; |
| r2, g2, b2: Double; |
| begin |
| h := 0; |
| s := 0; |
| l := 0; |
| v := Max(r, g); |
| v := Max(v, b); |
| m := Min(r, g); |
| m := Min(m, b); |
| l := (m + v) / 2.0; |
| if l <= 0.0 then |
| exit; |
| vm := v - m; |
| s := vm; |
| if s > 0.0 then |
| begin |
| if l <= 0.5 then |
| s := s / (v + m) |
| else s := s / (2.0 - v - m); |
| end |
| else exit; |
| r2 := (v - 4) / vm; |
| g2 := (v - g) / vm; |
| b2 := (v - b) / vm; |
| if r = v then |
| begin |
| if g = m then |
| h := b2 + 5.0 |
| else h := 1.0 - g2; |
| end |
| else if g = v then |
| begin |
| if b = m then |
| h := 1.0 + r2 |
| else h := 3.0 - b2; |
| end |
| else |
| begin |
| if r = m then |
| h := 3.0 + g2 |
| else h := 5.0 - r2; |
| end; |
| h := h / 6; |
| end; |
| |
| procedure hsl_to_rgb(h, sl, l: Double; var r, g, b: Double); {$IFDEF VER9UP}inline;{$ENDIF} |
| var |
| v: Double; |
| m, sv: Double; |
| sextant: Integer; |
| fract, vsf, mid1, mid2: Double; |
| begin |
| if l <= 0.5 then |
| v := l * (1.0 + sl) |
| else v := l + sl - l * sl; |
| if v <= 0 then |
| begin |
| r := 0.0; |
| g := 0.0; |
| b := 0.0; |
| end |
| else |
| begin |
| m := l + l - v; |
| sv := (v - m) / v; |
| h := h * 6.0; |
| sextant := Trunc(h); |
| fract := h - sextant; |
| vsf := v * sv * fract; |
| mid1 := m + vsf; |
| mid2 := v - vsf; |
| case sextant of |
| 0: |
| begin |
| r := v; g := mid1; b := m; |
| end; |
| 1: |
| begin |
| r := mid2; g := v; b := m; |
| end; |
| 2: |
| begin |
| r := m; g := v; b := mid1; |
| end; |
| 3: |
| begin |
| r := m; g := mid2; b := v; |
| end; |
| 4: |
| begin |
| r := mid1; g := m; b := v; |
| end; |
| 5: |
| begin |
| r := v; g := m; b := mid2; |
| end; |
| end; |
| end; |
| end; |
| |
| var |
| src_row, dest_row: PByte; |
| src, dest: PByteArray; |
| color, colors: array[0..3] of Integer; |
| SpokeColor: PIntegerArray; |
| spoke: PDoubleArray; |
| x1, y1, x2, y2, row, col, x, y, alpha, has_alpha, bpp, progress, max_progress, xc, yc, i, j: Integer; |
| u, v, l, l0, w, w1, c, nova_alpha, src_alpha, new_alpha, compl_ratio, ratio, r, g, b, h, s, lu, SpokeCol: Double; |
| dstDIB: TDIB; |
| begin |
| colors[0] := sr; |
| colors[1] := sg; |
| colors[2] := sb; |
| new_alpha := 0; |
| |
| GetMem(spoke, NSpokes * sizeof(Double)); |
| GetMem(spokecolor, NSpokes * sizeof(Integer) * 3); |
| dstDIB := TDIB.Create; |
| dstDIB.Assign(Self); |
| dstDIB.Canvas.Brush.Color := clBlack; |
| dstDIB.Canvas.FillRect(dstDIB.Canvas.ClipRect); |
| try |
| rgb_to_hsl(colors[0] / 255.0, colors[1] / 255.0, colors[2] / 255.0, h, s, lu); |
| |
| for i := 0 to NSpokes - 1 do |
| begin |
| spoke[i] := gauss; |
| h := h + randomhue / 360.0 * ({Random(RAND_MAX)}RandomSpok / RAND_MAX - 0.5); |
| if h < 0 then |
| h := h + 1.0 |
| else if h > 1.0 then |
| h := h - 1.0; |
| hsl_to_rgb(h, s, lu, r, g, b); |
| spokecolor[3 * i + 0] := Trunc(255 * r); |
| spokecolor[3 * i + 1] := Trunc(255 * g); |
| spokecolor[3 * i + 2] := Trunc(255 * b); |
| end; |
| |
| xc := cx; |
| yc := cy; |
| l0 := (x2 - xc) / 4 + 1; |
| bpp := Self.BitCount div 8; |
| has_alpha := 0; |
| alpha := bpp; |
| y := 0; |
| for row := 0 to Self.Height - 1 do begin |
| src_row := Self.ScanLine[row]; |
| dest_row := dstDIB.ScanLine[row]; |
| src := Pointer(src_row); |
| dest := Pointer(dest_row); |
| x := 0; |
| for col := 0 to Self.Width - 1 do begin |
| u := (x - xc) / radius; |
| v := (y - yc) / radius; |
| l := sqrt((u * u) + (v * v)); |
| c := (arctan2(u, v) / (2 * M_PI) + 0.51) * NSpokes; |
| i := floor(c); |
| c := c - i; |
| i := i mod NSpokes; |
| w1 := spoke[i] * (1 - c) + spoke[(i + 1) mod NSpokes] * c; |
| w1 := w1 * w1; |
| w := 1 / (l + 0.001) * 0.9; |
| nova_alpha := Clamp(w, 0.0, 1.0); |
| ratio := nova_alpha; |
| compl_ratio := 1.0 - ratio; |
| for j := 0 to alpha - 1 do |
| begin |
| spokecol := spokecolor[3 * i + j] * (1.0 - c) + spokecolor[3 * ((i + 1) mod nspokes) + j] * c; |
| if w > 1.0 then |
| color[j] := IClamp(Trunc(spokecol * w), 0, 255) |
| else |
| color[j] := Trunc(src[j] * compl_ratio + spokecol * ratio); |
| color[j] := Trunc(color[j] + 255 * Clamp(w1 * w, 0.0, 1.0)); |
| dest[j] := IClamp(color[j], 0, 255); |
| end; |
| inc(Integer(src), bpp); |
| inc(Integer(dest), bpp); |
| inc(x); |
| end; |
| inc(y); |
| end; |
| finally |
| Self.Assign(dstDIB); |
| dstDIB.Free; |
| FreeMem(Spoke); |
| FreeMem(SpokeColor); |
| end; |
| end; |
| |
| procedure TDIB.DrawMandelbrot(ao, au: Integer; bo, bu: Double); |
| var |
| c1, c2, z1, z2, tmp: Double; |
| i, j, Count: Integer; |
| dstDIB: TDIB; |
| X, Y: Double; |
| X2, Y2: Integer; |
| begin |
| dstDIB := TDIB.Create; |
| dstDIB.Assign(Self); |
| X2 := dstDIB.FWidth; |
| Y2 := dstDIB.FHeight; |
| {as Example |
| ao := 1; |
| au := -2; |
| bo := 1.5; |
| bu := -1.5; |
| } |
| X := (ao - au) / dstDIB.FWidth; |
| Y := (bo - bu) / dstDIB.FHeight; |
| try |
| c2 := bu; |
| for i := 10 to X2 do |
| begin |
| c1 := au; |
| for j := 0 to Y2 do |
| begin |
| z1 := 0; |
| z2 := 0; |
| Count := 0; |
| {count is deep of iteration of the mandelbrot set |
| if |z| >=2 then z is not a member of a mandelset} |
| while (((z1 * z1 + z2 * z2 < 4) and (Count <= 90))) do |
| begin |
| tmp := z1; |
| z1 := z1 * z1 - z2 * z2 + c1; |
| z2 := 2 * tmp * z2 + c2; |
| Inc(Count); |
| end; |
| //the color-palette depends on TColor(n*count mod t) |
| dstDIB.Canvas.Pixels[j, i] := (16 * Count mod 255); |
| c1 := c1 + X; |
| end; |
| c2 := c2 + Y; |
| end; |
| finally |
| Self.Assign(dstDIB); |
| dstDIB.Free; |
| end; |
| end; |
| |
| procedure TDIB.SephiaEffect(Depth: Integer{$IFDEF VER4UP} = 20{$ENDIF}); |
| {Note: when depth parameter set to 0 will produce black and white picture only} |
| var |
| color, color2: longint; |
| r, g, b, rr, gg: byte; |
| h, w: Integer; |
| p0: pbytearray; |
| x, y: Integer; |
| begin |
| if Self.BitCount = 24 then |
| begin |
| Self.DoGrayScale; |
| for y := 0 to Self.Height - 1 do |
| begin |
| p0 := Self.ScanLine[y]; |
| for x := 0 to Self.Width - 1 do |
| begin |
| r := p0[x * 3]; |
| g := p0[x * 3 + 1]; |
| b := p0[x * 3 + 2]; |
| rr := r + (depth * 2); |
| gg := g + depth; |
| if rr <= ((depth * 2) - 1) then |
| rr := 255; |
| if gg <= (depth - 1) then |
| gg := 255; |
| p0[x * 3] := rr; |
| p0[x * 3 + 1] := gg; |
| p0[x * 3 + 2] := b; |
| end; |
| end; |
| Exit |
| end; |
| {this alogorithm is slower because does not use scanline property} |
| for h := 0 to Self.Height-1 do |
| begin |
| for w := 0 to Self.Width-1 do |
| begin |
| //first convert the bitmap to greyscale |
| color := ColorToRGB(Self.Canvas.Pixels[w, h]); |
| r := GetRValue(color); |
| g := GetGValue(color); |
| b := GetBValue(color); |
| color2 := (r + g + b) div 3; |
| Self.Canvas.Pixels[w, h] := RGB(color2, color2, color2); |
| //then convert it to sepia |
| color := ColorToRGB(Self.Canvas.Pixels[w, h]); |
| r := GetRValue(color); |
| g := GetGValue(color); |
| b := GetBValue(color); |
| rr := r + (depth * 2); |
| gg := g + depth; |
| if rr <= ((depth * 2) - 1) then |
| rr := 255; |
| if gg <= (depth - 1) then |
| gg := 255; |
| Self.Canvas.Pixels[w, h] := RGB(rr, gg, b); |
| end; |
| end; |
| |
| end; |
| |
| procedure TDIB.EncryptDecrypt(const Key: Integer); |
| {for decript call it again} |
| var |
| BytesPorScan: Integer; |
| w, h: Integer; |
| p: pByteArray; |
| begin |
| try |
| BytesPorScan := Abs(Integer(Self.ScanLine[1]) - |
| Integer(Self.ScanLine[0])); |
| except |
| raise Exception.Create('Error '); |
| end; |
| RandSeed := Key; |
| for h := 0 to Self.Height - 1 do |
| begin |
| P := Self.ScanLine[h]; |
| for w := 0 to BytesPorScan - 1 do |
| P^[w] := P^[w] xor Random(256); |
| end; |
| end; |
| |
| procedure TDIB.LinePolar(x, y: Integer; AngleInDegree, Length: extended; Color: cardinal); |
| var |
| xp, yp: Integer; |
| begin |
| xp := Round(Sin(AngleInDegree * Pi / 180) * Length) + x; |
| yp := Round(Cos(AngleInDegree * Pi / 180) * Length) + y; |
| AntialiasedLine(x, y, xp, yp, Color); |
| end; |
| |
| //y = 0.299*g + 0.587*b + 0.114*r; |
| |
| procedure TDIB.BlendPixel(const X, Y: Integer; aColor: Cardinal; Alpha: byte); |
| var |
| cR, cG, cB: byte; |
| aR, aG, aB: byte; |
| dColor: Cardinal; |
| begin |
| aR := GetRValue(aColor); |
| aG := GetGValue(aColor); |
| aB := GetBValue(aColor); |
| dColor := Self.Canvas.Pixels[x, y]; |
| cR := GetRValue(dColor); |
| cG := GetGValue(dColor); |
| cB := GetBValue(dColor); |
| Canvas.Pixels[x, y] := RGB((Alpha * (aR - cR) shr 8) + cR, // R alpha |
| (Alpha * (aG - cG) shr 8) + cG, // G alpha |
| (Alpha * (aB - cB) shr 8) + cB); // B alpha |
| end; |
| |
| |
| procedure MakeDib(out DIB: TDIB; const iWidth, iHeight, iBitCount: Integer; iFillColor: TColor{$IFDEF VER4UP} = clBlack{$ENDIF}); {$IFDEF VER4UP} overload; {$ENDIF} |
| begin |
| DIB := TDIB.Create; |
| DIB.SetSize(iWidth, iHeight, iBitCount); |
| DIB.Fill(iFillColor); |
| end; |
| |
| procedure{$IFDEF VER4UP}MakeDib{$ELSE}MakeDib2{$ENDIF}(out DIB: TDIB; iBitmap: TBitmap); {$IFDEF VER4UP} overload; {$ENDIF} |
| begin |
| DIB := TDIB.Create; |
| if Assigned(iBitmap) then |
| DIB.CreateDIBFromBitmap(iBitmap) |
| else |
| DIB.Fill(clBlack); |
| end; |
| |
| initialization |
| TPicture.RegisterClipBoardFormat(CF_DIB, TDIB); |
| TPicture.RegisterFileFormat('dib', 'Device Independent Bitmap', TDIB); |