Subversion Repositories spacemission

Rev

Rev 4 | Blame | Compare with Previous | Last modification | View Log | RSS feed

  1. {*******************************************************}
  2. {                                                       }
  3. {       DIB and PAINTBOX componets                      }
  4. {                                                       }
  5. {       Copyright (C) 1997-2000 Hiroyuki Hori           }
  6. {         base components and effects                   }
  7. {       Copyright (C) 2000 Keith Murray                 }
  8. {         supernova effect                              }
  9. {       Copyright (C) 2000 Michel Hibon                 }
  10. {         new special effects added for DIB             }
  11. {       Copyright (C) 2001 Joakim Back                  }
  12. {         conFusion effects (as DxFusion)               }
  13. {       Copyright (C) 2003 Babak Sateli                 }
  14. {         24-bit DIB effect as supplement ones          }
  15. {       Copyright (C) 2004-2012 Jaro Benes              }
  16. {         32-bit DIB effect with alphachannel           }
  17. {         direct works with texture buffer              }
  18. {         modified and adapted all adopted functions    }
  19. {                                                       }
  20. {*******************************************************}
  21.  
  22. unit DIB;
  23.  
  24. interface
  25.  
  26. {$INCLUDE DelphiXcfg.inc}
  27. {$DEFINE USE_SCANLINE}
  28.  
  29. uses
  30.   Windows, SysUtils, Classes, Graphics, Controls,
  31.   {$IFDEF VER7UP} Types, {$ENDIF}
  32.   {$IFDEF VER9UP} GraphUtil, {$ENDIF}
  33.   {$IFDEF VER17UP} UITypes,{$ENDIF}
  34.   Math;
  35.  
  36. type
  37.   TColorLineStyle = (csSolid, csGradient, csRainbow);
  38.   TColorLinePixelGeometry = (pgPoint, pgCircular, pgRectangular);
  39.   PRGBQuads = ^TRGBQuads;
  40.   TRGBQuads = array[0..255] of TRGBQuad;
  41.  
  42.   TPaletteEntries = array[0..255] of TPaletteEntry;
  43.  
  44.   PBGRA = ^TBGRA;
  45.   TBGRA = packed record
  46.     B, G, R, A: Byte;
  47.   end;
  48.   TLinesA = array[0..0] of TBGRA;
  49.   PLinesA = ^TLinesA;
  50.  
  51.   PBGR = ^TBGR;
  52.   TBGR = packed record
  53.     B, G, R: Byte;
  54.   end;
  55.  
  56.   {   Added this type for New SPecial Effect   }
  57.   TFilter = array[0..2, 0..2] of SmallInt;
  58.   TLines = array[0..0] of TBGR;
  59.   PLines = ^TLines;
  60.   TBytes = array[0..0] of Byte;
  61.   PBytes = ^TBytes;
  62.   TPBytes = array[0..0] of PBytes;
  63.   PPBytes = ^TPBytes;
  64.   {   End of type's   }
  65.  
  66.   PArrayBGR = ^TArrayBGR;
  67.   TArrayBGR = array[0..0] of TBGR;
  68.  
  69.   PArrayByte = ^TArrayByte;
  70.   TArrayByte = array[0..0] of Byte;
  71.  
  72.   PArrayWord = ^TArrayWord;
  73.   TArrayWord = array[0..0] of Word;
  74.  
  75.   PArrayDWord = ^TArrayDWord;
  76.   TArrayDWord = array[0..0] of DWord;
  77.  
  78.   {  TDIBPixelFormat  }
  79.  
  80.   TDIBPixelFormat = record
  81.     RBitMask, GBitMask, BBitMask: DWORD;
  82.     RBitCount, GBitCount, BBitCount: DWORD;
  83.     RShift, GShift, BShift: DWORD;
  84.     RBitCount2, GBitCount2, BBitCount2: DWORD;
  85.   end;
  86.  
  87.   {  TDIBSharedImage  }
  88.  
  89.   TDIBSharedImage = class(TSharedImage)
  90.   private
  91.     FBitCount: Integer;
  92.     FBitmapInfo: PBitmapInfo;
  93.     FBitmapInfoSize: Integer;
  94.     FChangePalette: Boolean;
  95.     FColorTable: TRGBQuads;
  96.     FColorTablePos: Integer;
  97.     FCompressed: Boolean;
  98.     FDC: THandle;
  99.     FHandle: THandle;
  100.     FHeight: Integer;
  101.     FMemoryImage: Boolean;
  102.     FNextLine: Integer;
  103.     FOldHandle: THandle;
  104.     FPalette: HPalette;
  105.     FPaletteCount: Integer;
  106.     FPBits: Pointer;
  107.     FPixelFormat: TDIBPixelFormat;
  108.     FSize: Integer;
  109.     FTopPBits: Pointer;
  110.     FWidth: Integer;
  111.     FWidthBytes: Integer;
  112.     constructor Create;
  113.     procedure NewImage(AWidth, AHeight, ABitCount: Integer;
  114.       const PixelFormat: TDIBPixelFormat; const ColorTable: TRGBQuads; MemoryImage, Compressed: Boolean);
  115.     procedure Duplicate(Source: TDIBSharedImage; MemoryImage: Boolean); {$IFDEF VER9UP}inline;{$ENDIF}
  116.     procedure Compress(Source: TDIBSharedImage);
  117.     procedure Decompress(Source: TDIBSharedImage; MemoryImage: Boolean);
  118.     procedure ReadData(Stream: TStream; MemoryImage: Boolean);
  119.     function GetPalette: THandle;
  120.     procedure SetColorTable(const Value: TRGBQuads);
  121.   protected
  122.     procedure FreeHandle; override;
  123.   public
  124.     destructor Destroy; override;
  125.   end;
  126.  
  127.   {  TFilterTypeResample  }
  128.  
  129.   TFilterTypeResample = (ftrBox, ftrTriangle, ftrHermite, ftrBell, ftrBSpline,
  130.     ftrLanczos3, ftrMitchell);
  131.  
  132.   TDistortType = (dtFast, dtSlow);
  133.   {DXFusion effect type}
  134.   TFilterMode = (fmNormal, fmMix50, fmMix25, fmMix75);
  135.  
  136.   {  TLightSource  }
  137.  
  138.   TLightSource = record
  139.     X, Y: Integer;
  140.     Size1, Size2: Integer;
  141.     Color: TColor;
  142.   end;
  143.  
  144.   {  TLightArray  }
  145.  
  146.   TLightArray = array{$IFNDEF VER4UP}[0..0]{$ENDIF} of TLightsource;
  147.  
  148.   {  TMatrixSetting  }
  149.  
  150.   TMatrixSetting = array[0..9] of Integer;
  151.  
  152.   {  TDIB  }
  153.  
  154.   TDIB = class(TGraphic)
  155.   private
  156.     FCanvas: TCanvas;
  157.     FImage: TDIBSharedImage;
  158.  
  159.     FProgressName: string;
  160.     FProgressOldY: DWORD;
  161.     FProgressOldTime: DWORD;
  162.     FProgressOld: DWORD;
  163.     FProgressY: DWORD;
  164.     {  For speed-up  }
  165.     FBitCount: Integer;
  166.     FHeight: Integer;
  167.     FNextLine: Integer;
  168.     FNowPixelFormat: TDIBPixelFormat;
  169.     FPBits: Pointer;
  170.     FSize: Integer;
  171.     FTopPBits: Pointer;
  172.     FWidth: Integer;
  173.     FWidthBytes: Integer;
  174.     FLUTDist: array[0..255, 0..255] of Integer;
  175.     LG_COUNT: Integer;
  176.     LG_DETAIL: Integer;
  177.     FFreeList: TList;
  178.     procedure AllocHandle;
  179.     procedure CanvasChanging(Sender: TObject);
  180.     procedure Changing(MemoryImage: Boolean);
  181.     procedure ConvertBitCount(ABitCount: Integer);
  182.     function GetBitmapInfo: PBitmapInfo;
  183.     function GetBitmapInfoSize: Integer;
  184.     function GetCanvas: TCanvas;
  185.     function GetHandle: THandle;
  186.     function GetPaletteCount: Integer;
  187.     function GetPixel(X, Y: Integer): DWORD;
  188.     function GetPBits: Pointer;
  189.     function GetPBitsReadOnly: Pointer;
  190.     function GetScanLine(Y: Integer): Pointer;
  191.     function GetScanLineReadOnly(Y: Integer): Pointer;
  192.     function GetTopPBits: Pointer;
  193.     function GetTopPBitsReadOnly: Pointer;
  194.     procedure SetBitCount(Value: Integer);
  195.     procedure SetImage(Value: TDIBSharedImage); {$IFDEF VER9UP}inline;{$ENDIF}
  196.     procedure SetNowPixelFormat(const Value: TDIBPixelFormat);
  197.     procedure SetPixel(X, Y: Integer; Value: DWORD);
  198.     procedure StartProgress(const Name: string);
  199.     procedure EndProgress;
  200.     procedure UpdateProgress(PercentY: Integer);
  201.  
  202.     {   Added these 3 functions for New Specials Effects   }
  203.     function Interval(iMin, iMax, iValue: Integer; iMark: Boolean): Integer; {$IFDEF VER9UP}inline;{$ENDIF}
  204.     function IntToByte(i: Integer): Byte; {$IFDEF VER9UP}inline;{$ENDIF}
  205.     function TrimInt(i, Min, Max: Integer): Integer; {$IFDEF VER9UP}inline;{$ENDIF}
  206.     {   End of 3 functions for New Special Effect   }
  207.  
  208.     procedure Darkness(Amount: Integer);
  209.     function GetAlphaChannel: TDIB;
  210.     procedure SetAlphaChannel(const Value: TDIB);
  211.     function GetClientRect: TRect;
  212.     function GetRGBChannel: TDIB;
  213.     procedure SetRGBChannel(const Value: TDIB);
  214.   protected
  215.     procedure DefineProperties(Filer: TFiler); override;
  216.     procedure Draw(ACanvas: TCanvas; const ARect: TRect); override;
  217.     function GetEmpty: Boolean; override;
  218.     function GetHeight: Integer; override;
  219.     function GetPalette: HPalette; override;
  220.     function GetWidth: Integer; override;
  221.     procedure ReadData(Stream: TStream); override;
  222.     procedure SetHeight(Value: Integer); override;
  223.     procedure SetPalette(Value: HPalette); override;
  224.     procedure SetWidth(Value: Integer); override;
  225.     procedure WriteData(Stream: TStream); override;
  226.     {$IFDEF VER16UP}
  227.     function GetSupportsPartialTransparency: Boolean; override;
  228.     {$ENDIF}
  229.     function GetTransparent: Boolean; override;
  230.   public
  231.     ColorTable: TRGBQuads;
  232.     PixelFormat: TDIBPixelFormat;
  233.     constructor Create; override;
  234.     destructor Destroy; override;
  235.     procedure Assign(Source: TPersistent); override;
  236.     procedure Clear;
  237.     procedure Compress;
  238.     procedure Decompress;
  239.     procedure FreeHandle;
  240.     function HasAlphaChannel: Boolean;
  241.     function AssignAlphaChannel(ALPHA: TDIB; ForceResize: Boolean{$IFDEF VER4UP} = False{$ENDIF}): Boolean;
  242.     procedure RetAlphaChannel(out oDIB: TDIB);
  243.     procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle;
  244.       APalette: HPALETTE); override;
  245.     procedure LoadFromStream(Stream: TStream); override;
  246.     procedure SaveToClipboardFormat(var AFormat: Word; var AData: THandle;
  247.       var APalette: HPALETTE); override;
  248.     procedure SaveToStream(Stream: TStream); override;
  249.     procedure SetSize(AWidth, AHeight, ABitCount: Integer); {$IFDEF VER5UP}reintroduce;{$ENDIF} //{$IFDEF VER9UP} overload;{$ENDIF}
  250.     procedure UpdatePalette;
  251.     {  Special effect  }
  252.     procedure Blur(ABitCount: Integer; Radius: Integer);
  253.     procedure Greyscale(ABitCount: Integer);
  254.     procedure Mirror(MirrorX, MirrorY: Boolean);
  255.     procedure Negative; {$IFDEF VER9UP}inline;{$ENDIF}
  256.  
  257.     {   Added New Special Effect   }
  258.     procedure Spray(Amount: Integer);
  259.     procedure Emboss;
  260.     procedure AddMonoNoise(Amount: Integer);
  261.     procedure AddGradiantNoise(Amount: byte);
  262.     function Twist(bmp: TDIB; Amount: byte): Boolean;
  263.     function FishEye(bmp: TDIB): Boolean;
  264.     function SmoothRotateWrap(Bmp: TDIB; cx, cy: Integer; Degree: Extended): Boolean;
  265.     procedure Lightness(Amount: Integer);
  266.     procedure Saturation(Amount: Integer);
  267.     procedure Contrast(Amount: Integer);
  268.     procedure AddRGB(aR, aG, aB: Byte);
  269.     function Filter(Dest: TDIB; Filter: TFilter): Boolean;
  270.     procedure Sharpen(Amount: Integer);
  271.     function IntToColor(i: Integer): TBGR; {$IFDEF VER9UP}inline;{$ENDIF}
  272.     function Rotate(Dst: TDIB; cx, cy: Integer; Angle: Double): Boolean;
  273.     procedure SplitBlur(Amount: Integer);
  274.     procedure GaussianBlur(Bmp: TDIB; Amount: Integer);
  275.     {   End of New Special Effect   }
  276.     {
  277.     New effect for TDIB
  278.     with Some Effects like AntiAlias, Contrast,
  279.     Lightness, Saturation, GaussianBlur, Mosaic,
  280.     Twist, Splitlight, Trace, Emboss, etc.
  281.     Works with 24bit color DIBs.
  282.  
  283.     This component is based on TProEffectImage component version 1.0 by
  284.     Written By Babak Sateli (babak_sateli@yahoo.com, http://raveland.netfirms.com)
  285.  
  286.     and modified by (c) 2004 Jaro Benes
  287.     for DelphiX use.
  288.  
  289.     Demo was modified into DXForm with function like  original
  290.  
  291.     DISCLAIMER
  292.     This component is provided AS-IS without any warranty of any kind, either express or
  293.     implied. This component is freeware and can be used in any software product.
  294.     }
  295.     procedure DoInvert;
  296.     procedure DoAddColorNoise(Amount: Integer);
  297.     procedure DoAddMonoNoise(Amount: Integer);
  298.     procedure DoAntiAlias;
  299.     procedure DoContrast(Amount: Integer);
  300.     procedure DoFishEye(Amount: Integer);
  301.     procedure DoGrayScale;
  302.     procedure DoLightness(Amount: Integer);
  303.     procedure DoDarkness(Amount: Integer);
  304.     procedure DoSaturation(Amount: Integer);
  305.     procedure DoSplitBlur(Amount: Integer);
  306.     procedure DoGaussianBlur(Amount: Integer);
  307.     procedure DoMosaic(Size: Integer);
  308.     procedure DoTwist(Amount: Integer);
  309.     procedure DoSplitlight(Amount: Integer);
  310.     procedure DoTile(Amount: Integer);
  311.     procedure DoSpotLight(Amount: Integer; Spot: TRect);
  312.     procedure DoTrace(Amount: Integer);
  313.     procedure DoEmboss;
  314.     procedure DoSolorize(Amount: Integer);
  315.     procedure DoPosterize(Amount: Integer);
  316.     procedure DoBrightness(Amount: Integer);
  317.     procedure DoResample(AmountX, AmountY: Integer; TypeResample: TFilterTypeResample);
  318.     {rotate}
  319.     procedure DoSmoothRotate(Src: TDIB; cx, cy: Integer; Angle: Extended);
  320.     procedure DoColorize(ForeColor, BackColor: TColor);
  321.     {Simple explosion spoke effect}
  322.     procedure DoNovaEffect(const sr, sg, sb, cx, cy, radius,
  323.       nspokes, randomhue, randomspok, randgauss: Integer; onProgress: TProgressEvent);
  324.  
  325.     {Simple Mandelbrot-set drawing}
  326.     procedure DrawMandelbrot(ao, au: Integer; bo, bu: Double);
  327.  
  328.     {Sephia effect}
  329.     procedure SephiaEffect(Depth: Integer{$IFDEF VER4UP} = 20{$ENDIF});
  330.  
  331.     {Simple blend pixel}
  332.     procedure BlendPixel(const X, Y: Integer; aColor: Cardinal; Alpha: Byte); {$IFDEF VER9UP}inline;{$ENDIF}
  333.     {Line in polar system}
  334.     procedure LinePolar(x, y: Integer; AngleInDegree, Length: extended;
  335.       Color: cardinal);
  336.  
  337.     {special version Dark/Light procedure in percent}
  338.     procedure Darker(Percent: Integer);
  339.     procedure Lighter(Percent: Integer);
  340.  
  341.     {Simple graphical crypt}
  342.     procedure EncryptDecrypt(const Key: Integer);
  343.  
  344.     { Standalone DXFusion }
  345.     {--- c o n F u s i o n ---}
  346.     {By Joakim Back, www.back.mine.nu}
  347.     {Huge thanks to Ilkka Tuomioja for helping out with the project.}
  348.  
  349.     {
  350.     modified by (c) 2005 Jaro Benes for DelphiX use.
  351.     }
  352.  
  353.     procedure CreateDIBFromBitmap(const Bitmap: TBitmap);
  354.     {Drawing Methods.}
  355.     procedure DrawOn(Dest: TRect; DestCanvas: TCanvas;
  356.       Xsrc, Ysrc: Integer);
  357.     procedure DrawTo(SrcDIB: TDIB; X, Y, Width, Height, SourceX,
  358.       SourceY: Integer);
  359.     procedure DrawTransparent(SrcDIB: TDIB; const X, Y, Width, Height,
  360.       SourceX, SourceY: Integer; const Color: TColor); {$IFDEF VER5UP} reintroduce;{$ENDIF} //{$IFDEF VER9UP} overload;{$ENDIF}
  361.     procedure DrawShadow(SrcDIB: TDIB; X, Y, Width, Height, Frame: Integer;
  362.       FilterMode: TFilterMode);
  363.     procedure DrawShadows(SrcDIB: TDIB; X, Y, Width, Height, Frame: Integer;
  364.       Alpha: Byte);
  365.     procedure DrawDarken(SrcDIB: TDIB; X, Y, Width, Height,
  366.       Frame: Integer);
  367.     procedure DrawAdditive(SrcDIB: TDIB; X, Y, Width, Height: Integer; Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF};
  368.       Frame: Integer{$IFDEF VER4UP} = 0{$ENDIF});
  369.     procedure DrawQuickAlpha(SrcDIB: TDIB; const X, Y, Width, Height,
  370.       SourceX, SourceY: Integer; const Color: TColor;
  371.       FilterMode: TFilterMode);
  372.     procedure DrawTranslucent(SrcDIB: TDIB; const X, Y, Width, Height,
  373.       SourceX, SourceY: Integer; const Color: TColor);
  374.     procedure DrawMorphed(SrcDIB: TDIB; const X, Y, Width, Height, SourceX,
  375.       SourceY: Integer; const Color: TColor);
  376.     procedure DrawAlpha(SrcDIB: TDIB; const X, Y, Width, Height, SourceX,
  377.       SourceY, Alpha: Integer; const Color: TColor);
  378.     procedure DrawAlphaMask(SrcDIB, MaskDIB: TDIB; const X, Y, Width,
  379.       Height, SourceX, SourceY: Integer);
  380.     procedure DrawAntialias(SrcDIB: TDIB);
  381.     procedure Draw3x3Matrix(SrcDIB: TDIB; Setting: TMatrixSetting);
  382.     procedure DrawMono(SrcDIB: TDIB; const X, Y, Width, Height, SourceX,
  383.       SourceY: Integer; const TransColor, ForeColor, BackColor: TColor);
  384.     {One-color Filters.}
  385.     procedure FilterLine(X1, Y1, X2, Y2: Integer; Color: TColor;
  386.       FilterMode: TFilterMode); {$IFDEF VER9UP}inline;{$ENDIF}
  387.     procedure FilterRect(X, Y, Width, Height: Integer; Color: TColor;
  388.       FilterMode: TFilterMode); {$IFDEF VER9UP}inline;{$ENDIF}
  389.     { Lightsource. }
  390.     procedure InitLight(Count, Detail: Integer);
  391.     procedure DrawLights(FLight: TLightArray; AmbientLight: TColor);
  392.     //
  393.     // effect for special purpose
  394.     //
  395.     procedure FadeOut(DIB2: TDIB; Step: Byte); {$IFDEF VER9UP} inline; {$ENDIF}
  396.     procedure DoZoom(DIB2: TDIB; ZoomRatio: Real);
  397.     procedure DoBlur(DIB2: TDIB);
  398.     procedure FadeIn(DIB2: TDIB; Step: Byte); {$IFDEF VER9UP} inline; {$ENDIF}
  399.     procedure FillDIB8(Color: Byte);  {$IFDEF VER9UP} inline; {$ENDIF}
  400.     procedure DoRotate(DIB1: TDIB; cX, cY, Angle: Integer);
  401.     procedure Distort(DIB1: TDIB; dt: TDistortType; cX, cY, Angle: Integer; Factor: Real);
  402.     function Ink(DIB: TDIB; const SprayInit: Boolean; const AmountSpray: Integer): Boolean;
  403.     // lines
  404.     procedure AntialiasedLine(x1, y1, x2, y2: Integer; color: TColor); {$IFDEF VER9UP} inline; {$ENDIF}
  405.     function GetColorBetween(StartColor, EndColor: TColor; Pointvalue,
  406.       FromPoint, ToPoint: Extended): TColor;
  407.     procedure ColoredLine(const iStart, iEnd: TPoint; iColorStyle: TColorLineStyle;
  408.       iGradientFrom, iGradientTo: TColor; iPixelGeometry: TColorLinePixelGeometry;
  409.       iRadius: WORD);
  410.     // standard property
  411.     property BitCount: Integer read FBitCount write SetBitCount;
  412.     property BitmapInfo: PBitmapInfo read GetBitmapInfo;
  413.     property BitmapInfoSize: Integer read GetBitmapInfoSize;
  414.     property Canvas: TCanvas read GetCanvas;
  415.     property Handle: THandle read GetHandle;
  416.     property Height: Integer read FHeight write SetHeight;
  417.     property NextLine: Integer read FNextLine;
  418.     property NowPixelFormat: TDIBPixelFormat read FNowPixelFormat write SetNowPixelFormat;
  419.     property PaletteCount: Integer read GetPaletteCount;
  420.     property PBits: Pointer read GetPBits;
  421.     property PBitsReadOnly: Pointer read GetPBitsReadOnly;
  422.     property Pixels[X, Y: Integer]: DWORD read GetPixel write SetPixel;
  423.     property ScanLine[Y: Integer]: Pointer read GetScanLine;
  424.     property ScanLineReadOnly[Y: Integer]: Pointer read GetScanLineReadOnly;
  425.     property Size: Integer read FSize;
  426.     property TopPBits: Pointer read GetTopPBits;
  427.     property TopPBitsReadOnly: Pointer read GetTopPBitsReadOnly;
  428.     property Width: Integer read FWidth write SetWidth;
  429.     property WidthBytes: Integer read FWidthBytes;
  430.     property AlphaChannel: TDIB read GetAlphaChannel write SetAlphaChannel;
  431.     property RGBChannel: TDIB read GetRGBChannel write SetRGBChannel;
  432.     function CreateBitmapFromDIB: TBitmap;
  433.     procedure Fill(aColor: TColor);
  434.     property ClientRect: TRect read GetClientRect;
  435.   end;
  436.  
  437.   {  TDIBitmap  }
  438.  
  439.   TDIBitmap = class(TDIB) end;
  440.  
  441.   {  TCustomDXDIB  }
  442.  
  443.   TCustomDXDIB = class(TComponent)
  444.   private
  445.     FDIB: TDIB;
  446.     procedure SetDIB(Value: TDIB);
  447.   public
  448.     constructor Create(AOnwer: TComponent); override;
  449.     destructor Destroy; override;
  450.     property DIB: TDIB read FDIB write SetDIB;
  451.   end;
  452.  
  453.   {  TDXDIB  }
  454.  
  455.   TDXDIB = class(TCustomDXDIB)
  456.   published
  457.     property DIB;
  458.   end;
  459.  
  460.   {  TCustomDXPaintBox  }
  461.  
  462.   TCustomDXPaintBox = class(TGraphicControl)
  463.   private
  464.     FAutoStretch: Boolean;
  465.     FCenter: Boolean;
  466.     FDIB: TDIB;
  467.     FKeepAspect: Boolean;
  468.     FStretch: Boolean;
  469.     FViewWidth: Integer;
  470.     FViewHeight: Integer;
  471.     procedure SetAutoStretch(Value: Boolean);
  472.     procedure SetCenter(Value: Boolean);
  473.     procedure SetDIB(Value: TDIB);
  474.     procedure SetKeepAspect(Value: Boolean);
  475.     procedure SetStretch(Value: Boolean);
  476.     procedure SetViewWidth(Value: Integer);
  477.     procedure SetViewHeight(Value: Integer);
  478.   protected
  479.     function GetPalette: HPALETTE; override;
  480.   public
  481.     constructor Create(AOwner: TComponent); override;
  482.     destructor Destroy; override;
  483.     procedure Paint; override;
  484.     property AutoStretch: Boolean read FAutoStretch write SetAutoStretch;
  485.     property Canvas;
  486.     property Center: Boolean read FCenter write SetCenter;
  487.     property DIB: TDIB read FDIB write SetDIB;
  488.     property KeepAspect: Boolean read FKeepAspect write SetKeepAspect;
  489.     property Stretch: Boolean read FStretch write SetStretch;
  490.     property ViewWidth: Integer read FViewWidth write SetViewWidth;
  491.     property ViewHeight: Integer read FViewHeight write SetViewHeight;
  492.   end;
  493.  
  494.   {  TDXPaintBox  }
  495.  
  496.   TDXPaintBox = class(TCustomDXPaintBox)
  497.   published
  498. {$IFDEF VER4UP}property Anchors; {$ENDIF}
  499.     property AutoStretch;
  500.     property Center;
  501. {$IFDEF VER4UP}property Constraints; {$ENDIF}
  502.     property DIB;
  503.     property KeepAspect;
  504.     property Stretch;
  505.     property ViewWidth;
  506.     property ViewHeight;
  507.  
  508.     property Align;
  509.     property DragCursor;
  510.     property DragMode;
  511.     property Enabled;
  512.     property ParentShowHint;
  513.     property PopupMenu;
  514.     property ShowHint;
  515.     property Visible;
  516.     property OnClick;
  517.     property OnDblClick;
  518.     property OnDragDrop;
  519.     property OnDragOver;
  520.     property OnEndDrag;
  521.     property OnMouseDown;
  522.     property OnMouseMove;
  523.     property OnMouseUp;
  524. {$IFDEF VER9UP}property OnMouseWheel; {$ENDIF}
  525. {$IFDEF VER9UP}property OnResize; {$ENDIF}
  526. {$IFDEF VER9UP}property OnCanResize; {$ENDIF}
  527. {$IFDEF VER9UP}property OnContextPopup; {$ENDIF}
  528.     property OnStartDrag;
  529.   end;
  530.  
  531. const
  532.   DefaultFilterRadius: array[TFilterTypeResample] of Single = (0.5, 1, 1, 1.5, 2, 3, 2);
  533.  
  534. function MakeDIBPixelFormat(RBitCount, GBitCount, BBitCount: Integer): TDIBPixelFormat; {$IFDEF VER9UP}inline;{$ENDIF}
  535. function MakeDIBPixelFormatMask(RBitMask, GBitMask, BBitMask: Integer): TDIBPixelFormat; {$IFDEF VER9UP}inline;{$ENDIF}
  536. function pfRGB(const PixelFormat: TDIBPixelFormat; R, G, B: Byte): DWORD; {$IFDEF VER9UP}inline;{$ENDIF}
  537. procedure pfGetRGB(const PixelFormat: TDIBPixelFormat; Color: DWORD; var R, G, B: Byte); {$IFDEF VER9UP}inline;{$ENDIF}
  538. function pfGetRValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte; {$IFDEF VER9UP}inline;{$ENDIF}
  539. function pfGetGValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte; {$IFDEF VER9UP}inline;{$ENDIF}
  540. function pfGetBValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte; {$IFDEF VER9UP}inline;{$ENDIF}
  541.  
  542. function GreyscaleColorTable: TRGBQuads;
  543.  
  544. function RGBQuad(R, G, B: Byte): TRGBQuad; {$IFDEF VER9UP}inline;{$ENDIF}
  545. function PaletteEntryToRGBQuad(const Entry: TPaletteEntry): TRGBQuad; {$IFDEF VER9UP}inline;{$ENDIF}
  546. function PaletteEntriesToRGBQuads(const Entries: TPaletteEntries): TRGBQuads; {$IFDEF VER9UP}inline;{$ENDIF}
  547. function RGBQuadToPaletteEntry(const RGBQuad: TRGBQuad): TPaletteEntry; {$IFDEF VER9UP}inline;{$ENDIF}
  548. function RGBQuadsToPaletteEntries(const RGBQuads: TRGBQuads): TPaletteEntries; {$IFDEF VER9UP}inline;{$ENDIF}
  549.  
  550. function PosValue(Value: Integer): Integer;
  551.  
  552. type
  553.   TOC = 0..511;
  554. function DSin(const C: TOC): Single; {$IFDEF VER9UP}inline; {$ENDIF}
  555. function DCos(const C: TOC): Single; {$IFDEF VER9UP}inline; {$ENDIF}
  556.  
  557. {   Added Constants for TFilter Type   }
  558. const
  559.   EdgeFilter: TFilter = ((-1, -1, -1), (-1, 8, -1), (-1, -1, -1));
  560.   StrongOutlineFilter: TFilter = ((-100, 0, 0), (0, 0, 0), (0, 0, 100));
  561.   Enhance3DFilter: TFilter = ((-100, 5, 5), (5, 5, 5), (5, 5, 100));
  562.   LinearFilter: TFilter = ((-40, -40, -40), (-40, 255, -40), (-40, -40, -40));
  563.   GranularFilter: TFilter = ((-20, 5, 20), (5, -10, 5), (100, 5, -100));
  564.   SharpFilter: TFilter = ((-2, -2, -2), (-2, 20, -2), (-2, -2, -2));
  565. {   End of constants   }
  566.  
  567. {   Added Constants for DXFusion Type   }
  568. const
  569.   { 3x3 Matrix Presets. }
  570.   msEmboss: TMatrixSetting = (-1, -1, 0, -1, 6, 1, 0, 1, 1, 6);
  571.   msHardEmboss: TMatrixSetting = (-4, -2, -1, -2, 10, 2, -1, 2, 4, 8);
  572.   msBlur: TMatrixSetting = (1, 2, 1, 2, 4, 2, 1, 2, 1, 16);
  573.   msSharpen: TMatrixSetting = (-1, -1, -1, -1, 15, -1, -1, -1, -1, 7);
  574.   msEdgeDetect: TMatrixSetting = (-1, -1, -1, -1, 8, -1, -1, -1, -1, 1);
  575.  
  576. {Proportionaly scale of size, for recountin image sizes}
  577. function GetScale(SourceWidth, SourceHeight, TargetWidth, TargetHeight: Integer): Single; {$IFDEF VER9UP}inline;{$ENDIF}
  578.  
  579. procedure MakeDib(out DIB: TDIB; const iWidth, iHeight, iBitCount: Integer; iFillColor: TColor{$IFDEF VER4UP} = clBlack{$ENDIF}); {$IFDEF VER4UP}overload; {$ENDIF}
  580. procedure{$IFDEF VER4UP}MakeDib{$ELSE}MakeDIB2{$ENDIF}(out DIB: TDIB; iBitmap: TBitmap); {$IFDEF VER4UP}overload; {$ENDIF}
  581. procedure MakeDIB32MaskByColor(var D: TDIB; const MaskColor: TColor{$IFDEF VER4UP} = clWhite{$ENDIF});
  582.  
  583. function BGR(B, G, R: Byte): Integer; {$IFDEF VER9UP}inline;{$ENDIF}
  584.  
  585. implementation
  586.  
  587. uses DXConsts, {$IFDEF PNG_GRAPHICS}pngimage,{$ENDIF} jpeg;
  588.  
  589. function BGR(B, G, R: Byte): Integer; {$IFDEF VER9UP}inline;{$ENDIF}
  590. begin
  591.   Result := (B shl 16) or (G shl 8) or R;
  592. end;
  593.  
  594. procedure MakeDIB32MaskByColor(var D: TDIB; const MaskColor: TColor{$IFDEF VER4UP} = clWhite{$ENDIF});
  595. type
  596.   PRGBA = ^TRGBA;
  597.   TRGBA = array[0..0] of Windows.TRGBQuad;
  598. var
  599.   p: PRGBA;
  600.   y: Integer;
  601.   x: Integer;
  602.   B: TDIB;
  603. begin
  604.   MakeDib(B, D.Width, D.Height, 32, $FFFFFF);
  605.   B.RGBChannel := D.RGBChannel;
  606.   if B.BitCount = 32 then
  607.     for Y := 0 to B.Height - 1 do
  608.     begin
  609.       p := B.ScanLine[Y];
  610.       for X := 0 to B.Width - 1 do
  611.       begin
  612.         if (p[X].rgbBlue = GetBValue(MaskColor)) and (p[X].rgbGreen = GetGValue(MaskColor)) and (p[X].rgbRed = GetRValue(MaskColor)) then
  613.           p[X].rgbReserved := 0
  614.         else
  615.           p[X].rgbReserved := $FF
  616.       end
  617.     end;
  618.   d.Assign(B);
  619. end;
  620.  
  621. function GetScale(SourceWidth, SourceHeight, TargetWidth, TargetHeight: Integer): Single;
  622. var
  623.   XScale, YScale: Single;
  624. begin
  625.   XScale := 1;
  626.   YScale := 1;
  627.   if TargetWidth < SourceWidth then
  628.     XScale := TargetWidth / SourceWidth;
  629.   if TargetHeight < SourceHeight then
  630.     YScale := TargetHeight / SourceHeight;
  631.   Result := XScale;
  632.   if YScale < Result then
  633.     Result := YScale;
  634. end;
  635.  
  636. {$IFNDEF VER4UP}
  637. function Max(B1, B2: Integer): Integer;
  638. begin
  639.   if B1 >= B2 then Result := B1 else Result := B2;
  640. end;
  641.  
  642. function Min(B1, B2: Integer): Integer;
  643. begin
  644.   if B1 <= B2 then Result := B1 else Result := B2;
  645. end;
  646. {$ENDIF}
  647.  
  648. function DSin(const C: TOC): Single; {$IFDEF VER9UP}inline; {$ENDIF}
  649. begin
  650.   Result := sin(((c * 360) / 511) * Pi / 180);
  651. end;
  652.  
  653. function DCos(const C: TOC): Single; {$IFDEF VER9UP}inline; {$ENDIF}
  654. begin
  655.   Result := cos(((c * 360) / 511) * Pi / 180);
  656. end;
  657.  
  658. function MakeDIBPixelFormat(RBitCount, GBitCount, BBitCount: Integer): TDIBPixelFormat;
  659. begin
  660.   Result.RBitMask := ((1 shl RBitCount) - 1) shl (GBitCount + BBitCount);
  661.   Result.GBitMask := ((1 shl GBitCount) - 1) shl (BBitCount);
  662.   Result.BBitMask := (1 shl BBitCount) - 1;
  663.   Result.RBitCount := RBitCount;
  664.   Result.GBitCount := GBitCount;
  665.   Result.BBitCount := BBitCount;
  666.   Result.RBitCount2 := 8 - RBitCount;
  667.   Result.GBitCount2 := 8 - GBitCount;
  668.   Result.BBitCount2 := 8 - BBitCount;
  669.   Result.RShift := (GBitCount + BBitCount) - (8 - RBitCount);
  670.   Result.GShift := BBitCount - (8 - GBitCount);
  671.   Result.BShift := 8 - BBitCount;
  672. end;
  673.  
  674. function GetBitCount(b: Integer): Integer; {$IFDEF VER9UP}inline;{$ENDIF}
  675. var
  676.   i: Integer;
  677. begin
  678.   i := 0;
  679.   while (i < 31) and (((1 shl i) and b) = 0) do Inc(i);
  680.  
  681.   Result := 0;
  682.   while ((1 shl i) and b) <> 0 do
  683.   begin
  684.     Inc(i);
  685.     Inc(Result);
  686.   end;
  687. end;
  688.  
  689. function MakeDIBPixelFormatMask(RBitMask, GBitMask, BBitMask: Integer): TDIBPixelFormat;
  690. begin
  691.   Result := MakeDIBPixelFormat(GetBitCount(RBitMask), GetBitCount(GBitMask),
  692.     GetBitCount(BBitMask));
  693. end;
  694.  
  695. function pfRGB(const PixelFormat: TDIBPixelFormat; R, G, B: Byte): DWORD;
  696. begin
  697.   with PixelFormat do
  698.     Result := ((R shl RShift) and RBitMask) or ((G shl GShift) and GBitMask) or
  699.       ((B shr BShift) and BBitMask);
  700. end;
  701.  
  702. procedure pfGetRGB(const PixelFormat: TDIBPixelFormat; Color: DWORD; var R, G, B: Byte);
  703. begin
  704.   with PixelFormat do
  705.   begin
  706.     R := (Color and RBitMask) shr RShift;
  707.     R := R or (R shr RBitCount2);
  708.     G := (Color and GBitMask) shr GShift;
  709.     G := G or (G shr GBitCount2);
  710.     B := (Color and BBitMask) shl BShift;
  711.     B := B or (B shr BBitCount2);
  712.   end;
  713. end;
  714.  
  715. function pfGetRValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte;
  716. begin
  717.   with PixelFormat do
  718.   begin
  719.     Result := (Color and RBitMask) shr RShift;
  720.     Result := Result or (Result shr RBitCount2);
  721.   end;
  722. end;
  723.  
  724. function pfGetGValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte;
  725. begin
  726.   with PixelFormat do
  727.   begin
  728.     Result := (Color and GBitMask) shr GShift;
  729.     Result := Result or (Result shr GBitCount2);
  730.   end;
  731. end;
  732.  
  733. function pfGetBValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte;
  734. begin
  735.   with PixelFormat do
  736.   begin
  737.     Result := (Color and BBitMask) shl BShift;
  738.     Result := Result or (Result shr BBitCount2);
  739.   end;
  740. end;
  741.  
  742. function GreyscaleColorTable: TRGBQuads;
  743. var
  744.   i: Integer;
  745. begin
  746.   for i := 0 to 255 do
  747.     with Result[i] do
  748.     begin
  749.       rgbRed := i;
  750.       rgbGreen := i;
  751.       rgbBlue := i;
  752.       rgbReserved := 0;
  753.     end;
  754. end;
  755.  
  756. function RGBQuad(R, G, B: Byte): TRGBQuad;
  757. begin
  758.   with Result do
  759.   begin
  760.     rgbRed := R;
  761.     rgbGreen := G;
  762.     rgbBlue := B;
  763.     rgbReserved := 0;
  764.   end;
  765. end;
  766.  
  767. function PaletteEntryToRGBQuad(const Entry: TPaletteEntry): TRGBQuad;
  768. begin
  769.   with Result do
  770.     with Entry do
  771.     begin
  772.       rgbRed := peRed;
  773.       rgbGreen := peGreen;
  774.       rgbBlue := peBlue;
  775.       rgbReserved := 0;
  776.     end;
  777. end;
  778.  
  779. function PaletteEntriesToRGBQuads(const Entries: TPaletteEntries): TRGBQuads;
  780. var
  781.   i: Integer;
  782. begin
  783.   for i := 0 to 255 do
  784.     Result[i] := PaletteEntryToRGBQuad(Entries[i]);
  785. end;
  786.  
  787. function RGBQuadToPaletteEntry(const RGBQuad: TRGBQuad): TPaletteEntry;
  788. begin
  789.   with Result do
  790.     with RGBQuad do
  791.     begin
  792.       peRed := rgbRed;
  793.       peGreen := rgbGreen;
  794.       peBlue := rgbBlue;
  795.       peFlags := 0;
  796.     end;
  797. end;
  798.  
  799. function RGBQuadsToPaletteEntries(const RGBQuads: TRGBQuads): TPaletteEntries;
  800. var
  801.   i: Integer;
  802. begin
  803.   for i := 0 to 255 do
  804.     Result[i] := RGBQuadToPaletteEntry(RGBQuads[i]);
  805. end;
  806.  
  807. {  TDIBSharedImage  }
  808.  
  809. type
  810.   PLocalDIBPixelFormat = ^TLocalDIBPixelFormat;
  811.   TLocalDIBPixelFormat = packed record
  812.     RBitMask, GBitMask, BBitMask: DWORD;
  813.   end;
  814.  
  815.   {  TPaletteItem  }
  816.  
  817.   TPaletteItem = class(TCollectionItem)
  818.   private
  819.     ID: Integer;
  820.     Palette: HPalette;
  821.     RefCount: Integer;
  822.     ColorTable: TRGBQuads;
  823.     ColorTableCount: Integer;
  824.     destructor Destroy; override;
  825.     procedure AddRef;
  826.     procedure Release; {$IFDEF VER17UP}reintroduce;{$ENDIF}
  827.   end;
  828.  
  829.   {  TPaletteManager  }
  830.  
  831.   TPaletteManager = class
  832.   private
  833.     FList: TCollection;
  834.     constructor Create;
  835.     destructor Destroy; override;
  836.     function CreatePalette(const ColorTable: TRGBQuads; ColorTableCount: Integer): HPalette;
  837.     procedure DeletePalette(var Palette: HPalette);
  838.   end;
  839.  
  840. {  TPaletteItem  }
  841.  
  842. destructor TPaletteItem.Destroy;
  843. begin
  844.   DeleteObject(Palette);
  845.   inherited Destroy;
  846. end;
  847.  
  848. procedure TPaletteItem.AddRef;
  849. begin
  850.   Inc(RefCount);
  851. end;
  852.  
  853. procedure TPaletteItem.Release;
  854. begin
  855.   Dec(RefCount);
  856.   if RefCount <= 0 then Free;
  857. end;
  858.  
  859. {  TPaletteManager  }
  860.  
  861. constructor TPaletteManager.Create;
  862. begin
  863.   inherited Create;
  864.   FList := TCollection.Create(TPaletteItem);
  865. end;
  866.  
  867. destructor TPaletteManager.Destroy;
  868. begin
  869.   FList.Free;
  870.   inherited Destroy;
  871. end;
  872.  
  873. function TPaletteManager.CreatePalette(const ColorTable: TRGBQuads; ColorTableCount: Integer): HPalette;
  874. type
  875.   TMyLogPalette = record
  876.     palVersion: Word;
  877.     palNumEntries: Word;
  878.     palPalEntry: TPaletteEntries;
  879.   end;
  880. var
  881.   i, ID: Integer;
  882.   Item: TPaletteItem;
  883.   LogPalette: TMyLogPalette;
  884. begin
  885.   {  Hash key making  }
  886.   ID := ColorTableCount;
  887.   for i := 0 to ColorTableCount - 1 do
  888.     with ColorTable[i] do
  889.     begin
  890.       Inc(ID, rgbRed);
  891.       Inc(ID, rgbGreen);
  892.       Inc(ID, rgbBlue);
  893.     end;
  894.  
  895.   {  Does the same palette already exist?  }
  896.   for i := 0 to FList.Count - 1 do
  897.   begin
  898.     Item := TPaletteItem(FList.Items[i]);
  899.     if (Item.ID = ID) and (Item.ColorTableCount = ColorTableCount) and
  900.       CompareMem(@Item.ColorTable, @ColorTable, ColorTableCount * SizeOf(TRGBQuad)) then
  901.     begin
  902.       Item.AddRef; Result := Item.Palette;
  903.       Exit;
  904.     end;
  905.   end;
  906.  
  907.   {  New palette making  }
  908.   Item := TPaletteItem.Create(FList);
  909.   Item.ID := ID;
  910.   Move(ColorTable, Item.ColorTable, ColorTableCount * SizeOf(TRGBQuad));
  911.   Item.ColorTableCount := ColorTableCount;
  912.  
  913.   with LogPalette do
  914.   begin
  915.     palVersion := $300;
  916.     palNumEntries := ColorTableCount;
  917.     palPalEntry := RGBQuadsToPaletteEntries(ColorTable);
  918.   end;
  919.  
  920.   Item.Palette := Windows.CreatePalette(PLogPalette(@LogPalette)^);
  921.   Item.AddRef; Result := Item.Palette;
  922. end;
  923.  
  924. procedure TPaletteManager.DeletePalette(var Palette: HPalette);
  925. var
  926.   i: Integer;
  927.   Item: TPaletteItem;
  928. begin
  929.   if Palette = 0 then Exit;
  930.  
  931.   for i := 0 to FList.Count - 1 do
  932.   begin
  933.     Item := TPaletteItem(FList.Items[i]);
  934.     if (Item.Palette = Palette) then
  935.     begin
  936.       Palette := 0;
  937.       Item.Release;
  938.       Exit;
  939.     end;
  940.   end;
  941. end;
  942.  
  943. var
  944.   FPaletteManager: TPaletteManager;
  945.  
  946. function PaletteManager: TPaletteManager;
  947. begin
  948.   if FPaletteManager = nil then
  949.     FPaletteManager := TPaletteManager.Create;
  950.   Result := FPaletteManager;
  951. end;
  952.  
  953. {  TDIBSharedImage  }
  954.  
  955. constructor TDIBSharedImage.Create;
  956. begin
  957.   inherited Create;
  958.   FMemoryImage := True;
  959.   SetColorTable(GreyscaleColorTable);
  960.   FColorTable := GreyscaleColorTable;
  961.   FPixelFormat := MakeDIBPixelFormat(8, 8, 8);
  962. end;
  963.  
  964. procedure TDIBSharedImage.NewImage(AWidth, AHeight, ABitCount: Integer;
  965.   const PixelFormat: TDIBPixelFormat; const ColorTable: TRGBQuads; MemoryImage, Compressed: Boolean);
  966. var
  967.   InfoOfs: Integer;
  968.   UsePixelFormat: Boolean;
  969. begin
  970.   {$IFNDEF D17UP}
  971.   {self recreation is not allowed here}
  972.   Create;
  973.   {$ENDIF}
  974.   {  Pixel format check  }
  975.   case ABitCount of
  976.     1: if not ((PixelFormat.RBitMask = $FF0000) and (PixelFormat.GBitMask = $00FF00) and (PixelFormat.BBitMask = $0000FF)) then
  977.         raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat);
  978.     4: if not ((PixelFormat.RBitMask = $FF0000) and (PixelFormat.GBitMask = $00FF00) and (PixelFormat.BBitMask = $0000FF)) then
  979.         raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat);
  980.     8: if not ((PixelFormat.RBitMask = $FF0000) and (PixelFormat.GBitMask = $00FF00) and (PixelFormat.BBitMask = $0000FF)) then
  981.         raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat);
  982.     16:
  983.       begin
  984.         if not (((PixelFormat.RBitMask = $7C00) and (PixelFormat.GBitMask = $03E0) and (PixelFormat.BBitMask = $001F)) or
  985.           ((PixelFormat.RBitMask = $F800) and (PixelFormat.GBitMask = $07E0) and (PixelFormat.BBitMask = $001F))) then
  986.           raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat);
  987.       end;
  988.     24:
  989.       begin
  990.         if not ((PixelFormat.RBitMask = $FF0000) and (PixelFormat.GBitMask = $00FF00) and (PixelFormat.BBitMask = $0000FF)) then
  991.           raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat);
  992.       end;
  993.     32:
  994.       begin
  995.         if not ((PixelFormat.RBitMask = $FF0000) and (PixelFormat.GBitMask = $00FF00) and (PixelFormat.BBitMask = $0000FF)) then
  996.           raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat);
  997.       end;
  998.   else
  999.     raise EInvalidGraphicOperation.CreateFmt(SInvalidDIBBitCount, [ABitCount]);
  1000.   end;
  1001.  
  1002.   FBitCount := ABitCount;
  1003.   FHeight := AHeight;
  1004.   FWidth := AWidth;
  1005.   FWidthBytes := (((AWidth * ABitCount) + 31) shr 5) * 4;
  1006.   FNextLine := -FWidthBytes;
  1007.   FSize := FWidthBytes * FHeight;
  1008.   UsePixelFormat := ABitCount in [16, 32];
  1009.  
  1010.   FPixelFormat := PixelFormat;
  1011.  
  1012.   FPaletteCount := 0;
  1013.   if FBitCount <= 8 then
  1014.     FPaletteCount := 1 shl FBitCount;
  1015.  
  1016.   FBitmapInfoSize := SizeOf(TBitmapInfoHeader);
  1017.   if UsePixelFormat then
  1018.     Inc(FBitmapInfoSize, SizeOf(TLocalDIBPixelFormat));
  1019.   Inc(FBitmapInfoSize, SizeOf(TRGBQuad) * FPaletteCount);
  1020.  
  1021.   GetMem(FBitmapInfo, FBitmapInfoSize);
  1022.   FillChar(FBitmapInfo^, FBitmapInfoSize, 0);
  1023.  
  1024.   {  BitmapInfo setting.  }
  1025.   with FBitmapInfo^.bmiHeader do
  1026.   begin
  1027.     biSize := SizeOf(TBitmapInfoHeader);
  1028.     biWidth := FWidth;
  1029.     biHeight := FHeight;
  1030.     biPlanes := 1;
  1031.     biBitCount := FBitCount;
  1032.     if UsePixelFormat then
  1033.       biCompression := BI_BITFIELDS
  1034.     else
  1035.     begin
  1036.       biCompression := 0; //none
  1037.       if (FBitCount = 4) and (Compressed) then
  1038.         biCompression := BI_RLE4
  1039.       else if (FBitCount = 8) and (Compressed) then
  1040.         biCompression := BI_RLE8
  1041.       else
  1042.         if FBitCount = 24 then
  1043.           biCompression := BI_RGB;
  1044.     end;
  1045.     biSizeImage := FSize;
  1046.     biXPelsPerMeter := 0;
  1047.     biYPelsPerMeter := 0;
  1048.     biClrUsed := 0;
  1049.     biClrImportant := 0;
  1050.   end;
  1051.   InfoOfs := SizeOf(TBitmapInfoHeader);
  1052.  
  1053.   if UsePixelFormat then
  1054.   begin
  1055.     with PLocalDIBPixelFormat(Integer(FBitmapInfo) + InfoOfs)^ do
  1056.     begin
  1057.       RBitMask := PixelFormat.RBitMask;
  1058.       GBitMask := PixelFormat.GBitMask;
  1059.       BBitMask := PixelFormat.BBitMask;
  1060.     end;
  1061.  
  1062.     Inc(InfoOfs, SizeOf(TLocalDIBPixelFormat));
  1063.   end;
  1064.  
  1065.   FColorTablePos := InfoOfs;
  1066.  
  1067.   FColorTable := ColorTable;
  1068.   Move(FColorTable, Pointer(Integer(FBitmapInfo) + FColorTablePos)^, SizeOf(TRGBQuad) * FPaletteCount);
  1069.  
  1070.   FCompressed := FBitmapInfo^.bmiHeader.biCompression in [BI_RLE4, BI_RLE8];
  1071.   FMemoryImage := MemoryImage or FCompressed;
  1072.  
  1073.   {  DIB making.  }
  1074.   if not Compressed then
  1075.   begin
  1076.     if MemoryImage then
  1077.     begin
  1078.       FPBits := Pointer(GlobalAlloc(GMEM_FIXED, FSize));
  1079.       if FPBits = nil then
  1080.         OutOfMemoryError;
  1081.     end
  1082.     else
  1083.     begin
  1084.       FDC := CreateCompatibleDC(0);
  1085.  
  1086.       FHandle := CreateDIBSection(FDC, FBitmapInfo^, DIB_RGB_COLORS, FPBits, 0, 0);
  1087.       if FHandle = 0 then
  1088.         raise EOutOfResources.CreateFmt(SCannotMade, ['DIB']);
  1089.  
  1090.       FOldHandle := SelectObject(FDC, FHandle);
  1091.     end;
  1092.   end;
  1093.  
  1094.   FTopPBits := Pointer(Integer(FPBits) + (FHeight - 1) * FWidthBytes);
  1095. end;
  1096.  
  1097. procedure TDIBSharedImage.Duplicate(Source: TDIBSharedImage; MemoryImage: Boolean);
  1098. begin
  1099.   if Source = nil then Exit; //no source
  1100.  
  1101.   if Source.FSize = 0 then
  1102.   begin
  1103.     {$IFNDEF D17UP}
  1104.     {self recreation is not allowed here}
  1105.     Create;
  1106.     {$ENDIF}
  1107.     FMemoryImage := MemoryImage;
  1108.   end
  1109.   else
  1110.   begin
  1111.     NewImage(Source.FWidth, Source.FHeight, Source.FBitCount,
  1112.       Source.FPixelFormat, Source.FColorTable, MemoryImage, Source.FCompressed);
  1113.     if FCompressed then
  1114.     begin
  1115.       FBitmapInfo.bmiHeader.biSizeImage := Source.FBitmapInfo.bmiHeader.biSizeImage;
  1116.       GetMem(FPBits, FBitmapInfo.bmiHeader.biSizeImage);
  1117.       Move(Source.FPBits^, FPBits^, FBitmapInfo.bmiHeader.biSizeImage);
  1118.     end
  1119.     else
  1120.     begin
  1121.       Move(Source.FPBits^, FPBits^, FBitmapInfo.bmiHeader.biSizeImage);
  1122.     end;
  1123.   end;
  1124. end;
  1125.  
  1126. procedure TDIBSharedImage.Compress(Source: TDIBSharedImage);
  1127.  
  1128.   procedure EncodeRLE4;
  1129.   var
  1130.     Size: Integer;
  1131.  
  1132.     function AllocByte: PByte;
  1133.     begin
  1134.       if Size mod 4096 = 0 then
  1135.         ReAllocMem(FPBits, Size + 4095);
  1136.       Result := Pointer(Integer(FPBits) + Size);
  1137.       Inc(Size);
  1138.     end;
  1139.  
  1140.   var
  1141.     B1, B2, C: Byte;
  1142.     PB1, PB2: Integer;
  1143.     Src: PByte;
  1144.     X, Y: Integer;
  1145.  
  1146.     function GetPixel(x: Integer): Integer;
  1147.     begin
  1148.       if X and 1 = 0 then
  1149.         Result := PArrayByte(Src)[X shr 1] shr 4
  1150.       else
  1151.         Result := PArrayByte(Src)[X shr 1] and $0F;
  1152.     end;
  1153.  
  1154.   begin
  1155.     Size := 0;
  1156.  
  1157.     for y := 0 to Source.FHeight - 1 do
  1158.     begin
  1159.       x := 0;
  1160.       Src := Pointer(Integer(Source.FPBits) + y * FWidthBytes);
  1161.       while x < Source.FWidth do
  1162.       begin
  1163.         if (Source.FWidth - x > 3) and (GetPixel(x) = GetPixel(x + 2)) then
  1164.         begin
  1165.           {  Encoding mode  }
  1166.           B1 := 2;
  1167.           B2 := (GetPixel(x) shl 4) or GetPixel(x + 1);
  1168.  
  1169.           Inc(x, 2);
  1170.  
  1171.           C := B2;
  1172.  
  1173.           while (x < Source.FWidth) and (C and $F = GetPixel(x)) and (B1 < 255) do
  1174.           begin
  1175.             Inc(B1);
  1176.             Inc(x);
  1177.             C := (C shr 4) or (C shl 4);
  1178.           end;
  1179.  
  1180.           AllocByte^ := B1;
  1181.           AllocByte^ := B2;
  1182.         end
  1183.         else
  1184.           if (Source.FWidth - x > 5) and ((GetPixel(x) <> GetPixel(x + 2)) or (GetPixel(x + 1) <> GetPixel(x + 3))) and
  1185.             ((GetPixel(x + 2) = GetPixel(x + 4)) and (GetPixel(x + 3) = GetPixel(x + 5))) then
  1186.           begin
  1187.           {  Encoding mode }
  1188.             AllocByte^ := 2;
  1189.             AllocByte^ := (GetPixel(x) shl 4) or GetPixel(x + 1);
  1190.             Inc(x, 2);
  1191.           end
  1192.           else
  1193.           begin
  1194.             if (Source.FWidth - x < 4) then
  1195.             begin
  1196.             {  Encoding mode }
  1197.               while Source.FWidth - x >= 2 do
  1198.               begin
  1199.                 AllocByte^ := 2;
  1200.                 AllocByte^ := (GetPixel(x) shl 4) or GetPixel(x + 1);
  1201.                 Inc(x, 2);
  1202.               end;
  1203.  
  1204.               if Source.FWidth - x = 1 then
  1205.               begin
  1206.                 AllocByte^ := 1;
  1207.                 AllocByte^ := GetPixel(x) shl 4;
  1208.                 Inc(x);
  1209.               end;
  1210.             end
  1211.             else
  1212.             begin
  1213.             {  Absolute mode  }
  1214.               PB1 := Size; AllocByte;
  1215.               PB2 := Size; AllocByte;
  1216.  
  1217.               B1 := 0;
  1218.               B2 := 4;
  1219.  
  1220.               AllocByte^ := (GetPixel(x) shl 4) or GetPixel(x + 1);
  1221.               AllocByte^ := (GetPixel(x + 2) shl 4) or GetPixel(x + 3);
  1222.  
  1223.               Inc(x, 4);
  1224.  
  1225.               while (x + 1 < Source.FWidth) and (B2 < 254) do
  1226.               begin
  1227.                 if (Source.FWidth - x > 3) and (GetPixel(x) = GetPixel(x + 2)) and (GetPixel(x + 1) = GetPixel(x + 3)) then
  1228.                   Break;
  1229.  
  1230.                 AllocByte^ := (GetPixel(x) shl 4) or GetPixel(x + 1);
  1231.                 Inc(B2, 2);
  1232.                 Inc(x, 2);
  1233.               end;
  1234.  
  1235.               PByte(Integer(FPBits) + PB1)^ := B1;
  1236.               PByte(Integer(FPBits) + PB2)^ := B2;
  1237.             end;
  1238.           end;
  1239.  
  1240.         if Size and 1 = 1 then AllocByte;
  1241.       end;
  1242.  
  1243.       {  End of line  }
  1244.       AllocByte^ := 0;
  1245.       AllocByte^ := 0;
  1246.     end;
  1247.  
  1248.     {  End of bitmap  }
  1249.     AllocByte^ := 0;
  1250.     AllocByte^ := 1;
  1251.  
  1252.     FBitmapInfo.bmiHeader.biSizeImage := Size;
  1253.     FSize := Size;
  1254.   end;
  1255.  
  1256.   procedure EncodeRLE8;
  1257.   var
  1258.     Size: Integer;
  1259.  
  1260.     function AllocByte: PByte;
  1261.     begin
  1262.       if Size mod 4096 = 0 then
  1263.         ReAllocMem(FPBits, Size + 4095);
  1264.       Result := Pointer(Integer(FPBits) + Size);
  1265.       Inc(Size);
  1266.     end;
  1267.  
  1268.   var
  1269.     B1, B2: Byte;
  1270.     PB1, PB2: Integer;
  1271.     Src: PByte;
  1272.     X, Y: Integer;
  1273.   begin
  1274.     Size := 0;
  1275.  
  1276.     for y := 0 to Source.FHeight - 1 do
  1277.     begin
  1278.       x := 0;
  1279.       Src := Pointer(Integer(Source.FPBits) + y * FWidthBytes);
  1280.       while x < Source.FWidth do
  1281.       begin
  1282.         if (Source.FWidth - x > 2) and (Src^ = PByte(Integer(Src) + 1)^) then
  1283.         begin
  1284.           {  Encoding mode  }
  1285.           B1 := 2;
  1286.           B2 := Src^;
  1287.  
  1288.           Inc(x, 2);
  1289.           Inc(Src, 2);
  1290.  
  1291.           while (x < Source.FWidth) and (Src^ = B2) and (B1 < 255) do
  1292.           begin
  1293.             Inc(B1);
  1294.             Inc(x);
  1295.             Inc(Src);
  1296.           end;
  1297.  
  1298.           AllocByte^ := B1;
  1299.           AllocByte^ := B2;
  1300.         end
  1301.         else
  1302.           if (Source.FWidth - x > 2) and (Src^ <> PByte(Integer(Src) + 1)^) and (PByte(Integer(Src) + 1)^ = PByte(Integer(Src) + 2)^) then
  1303.           begin
  1304.           {  Encoding mode }
  1305.             AllocByte^ := 1;
  1306.             AllocByte^ := Src^; Inc(Src);
  1307.             Inc(x);
  1308.           end
  1309.           else
  1310.           begin
  1311.             if (Source.FWidth - x < 4) then
  1312.             begin
  1313.             {  Encoding mode }
  1314.               if Source.FWidth - x = 2 then
  1315.               begin
  1316.                 AllocByte^ := 1;
  1317.                 AllocByte^ := Src^; Inc(Src);
  1318.  
  1319.                 AllocByte^ := 1;
  1320.                 AllocByte^ := Src^; Inc(Src);
  1321.                 Inc(x, 2);
  1322.               end
  1323.               else
  1324.               begin
  1325.                 AllocByte^ := 1;
  1326.                 AllocByte^ := Src^; Inc(Src);
  1327.                 Inc(x);
  1328.               end;
  1329.             end
  1330.             else
  1331.             begin
  1332.             {  Absolute mode  }
  1333.               PB1 := Size; AllocByte;
  1334.               PB2 := Size; AllocByte;
  1335.  
  1336.               B1 := 0;
  1337.               B2 := 3;
  1338.  
  1339.               Inc(x, 3);
  1340.  
  1341.               AllocByte^ := Src^; Inc(Src);
  1342.               AllocByte^ := Src^; Inc(Src);
  1343.               AllocByte^ := Src^; Inc(Src);
  1344.  
  1345.               while (x < Source.FWidth) and (B2 < 255) do
  1346.               begin
  1347.                 if (Source.FWidth - x > 3) and (Src^ = PByte(Integer(Src) + 1)^) and (Src^ = PByte(Integer(Src) + 2)^) and (Src^ = PByte(Integer(Src) + 3)^) then
  1348.                   Break;
  1349.  
  1350.                 AllocByte^ := Src^; Inc(Src);
  1351.                 Inc(B2);
  1352.                 Inc(x);
  1353.               end;
  1354.  
  1355.               PByte(Integer(FPBits) + PB1)^ := B1;
  1356.               PByte(Integer(FPBits) + PB2)^ := B2;
  1357.             end;
  1358.           end;
  1359.  
  1360.         if Size and 1 = 1 then AllocByte;
  1361.       end;
  1362.  
  1363.       {  End of line  }
  1364.       AllocByte^ := 0;
  1365.       AllocByte^ := 0;
  1366.     end;
  1367.  
  1368.     {  End of bitmap  }
  1369.     AllocByte^ := 0;
  1370.     AllocByte^ := 1;
  1371.  
  1372.     FBitmapInfo.bmiHeader.biSizeImage := Size;
  1373.     FSize := Size;
  1374.   end;
  1375.  
  1376. begin
  1377.   if Source.FCompressed then
  1378.     Duplicate(Source, Source.FMemoryImage)
  1379.   else
  1380.   begin
  1381.     NewImage(Source.FWidth, Source.FHeight, Source.FBitCount,
  1382.       Source.FPixelFormat, Source.FColorTable, True, True);
  1383.     case FBitmapInfo.bmiHeader.biCompression of
  1384.       BI_RLE4: EncodeRLE4;
  1385.       BI_RLE8: EncodeRLE8;
  1386.     else
  1387.       Duplicate(Source, Source.FMemoryImage);
  1388.     end;
  1389.   end;
  1390. end;
  1391.  
  1392. procedure TDIBSharedImage.Decompress(Source: TDIBSharedImage; MemoryImage: Boolean);
  1393.  
  1394.   procedure DecodeRLE4;
  1395.   var
  1396.     B1, B2, C: Byte;
  1397.     Dest, Src, P: PByte;
  1398.     X, Y, i: Integer;
  1399.   begin
  1400.     Src := Source.FPBits;
  1401.     X := 0;
  1402.     Y := 0;
  1403.  
  1404.     while True do
  1405.     begin
  1406.       B1 := Src^; Inc(Src);
  1407.       B2 := Src^; Inc(Src);
  1408.  
  1409.       if B1 = 0 then
  1410.       begin
  1411.         case B2 of
  1412.           0: begin {  End of line  }
  1413.               X := 0;
  1414.               Inc(Y);
  1415.             end;
  1416.           1: Break; {  End of bitmap  }
  1417.           2: begin {  Difference of coordinates  }
  1418.               Inc(X, B1);
  1419.               Inc(Y, B2); Inc(Src, 2);
  1420.             end;
  1421.         else
  1422.           {  Absolute mode  }
  1423.           Dest := Pointer(Longint(FPBits) + Y * FWidthBytes);
  1424.  
  1425.           C := 0;
  1426.           for i := 0 to B2 - 1 do
  1427.           begin
  1428.             if i and 1 = 0 then
  1429.             begin
  1430.               C := Src^; Inc(Src);
  1431.             end
  1432.             else
  1433.             begin
  1434.               C := C shl 4;
  1435.             end;
  1436.  
  1437.             P := Pointer(Integer(Dest) + X shr 1);
  1438.             if X and 1 = 0 then
  1439.               P^ := (P^ and $0F) or (C and $F0)
  1440.             else
  1441.               P^ := (P^ and $F0) or ((C and $F0) shr 4);
  1442.  
  1443.             Inc(X);
  1444.           end;
  1445.         end;
  1446.       end
  1447.       else
  1448.       begin
  1449.         {  Encoding mode  }
  1450.         Dest := Pointer(Longint(FPBits) + Y * FWidthBytes);
  1451.  
  1452.         for i := 0 to B1 - 1 do
  1453.         begin
  1454.           P := Pointer(Integer(Dest) + X shr 1);
  1455.           if X and 1 = 0 then
  1456.             P^ := (P^ and $0F) or (B2 and $F0)
  1457.           else
  1458.             P^ := (P^ and $F0) or ((B2 and $F0) shr 4);
  1459.  
  1460.           Inc(X);
  1461.  
  1462.           // Swap nibble
  1463.           B2 := (B2 shr 4) or (B2 shl 4);
  1464.         end;
  1465.       end;
  1466.  
  1467.       {  Word arrangement  }
  1468.       Inc(Src, Longint(Src) and 1);
  1469.     end;
  1470.   end;
  1471.  
  1472.   procedure DecodeRLE8;
  1473.   var
  1474.     B1, B2: Byte;
  1475.     Dest, Src: PByte;
  1476.     X, Y: Integer;
  1477.   begin
  1478.     Dest := FPBits;
  1479.     Src := Source.FPBits;
  1480.     X := 0;
  1481.     Y := 0;
  1482.  
  1483.     while True do
  1484.     begin
  1485.       B1 := Src^; Inc(Src);
  1486.       B2 := Src^; Inc(Src);
  1487.  
  1488.       if B1 = 0 then
  1489.       begin
  1490.         case B2 of
  1491.           0: begin {  End of line  }
  1492.               X := 0; Inc(Y);
  1493.               Dest := Pointer(Longint(FPBits) + Y * FWidthBytes + X);
  1494.             end;
  1495.           1: Break; {  End of bitmap  }
  1496.           2: begin {  Difference of coordinates  }
  1497.               Inc(X, B1); Inc(Y, B2); Inc(Src, 2);
  1498.               Dest := Pointer(Longint(FPBits) + Y * FWidthBytes + X);
  1499.             end;
  1500.         else
  1501.           {  Absolute mode  }
  1502.           Move(Src^, Dest^, B2); Inc(Dest, B2); Inc(Src, B2);
  1503.         end;
  1504.       end
  1505.       else
  1506.       begin
  1507.         {  Encoding mode  }
  1508.         FillChar(Dest^, B1, B2); Inc(Dest, B1);
  1509.       end;
  1510.  
  1511.       {  Word arrangement  }
  1512.       Inc(Src, Longint(Src) and 1);
  1513.     end;
  1514.   end;
  1515.  
  1516. begin
  1517.   if not Source.FCompressed then
  1518.     Duplicate(Source, MemoryImage)
  1519.   else
  1520.   begin
  1521.     NewImage(Source.FWidth, Source.FHeight, Source.FBitCount,
  1522.       Source.FPixelFormat, Source.FColorTable, MemoryImage, False);
  1523.     case Source.FBitmapInfo.bmiHeader.biCompression of
  1524.       BI_RLE4: DecodeRLE4;
  1525.       BI_RLE8: DecodeRLE8;
  1526.     else
  1527.       Duplicate(Source, MemoryImage);
  1528.     end;
  1529.   end;
  1530. end;
  1531.  
  1532. procedure TDIBSharedImage.ReadData(Stream: TStream; MemoryImage: Boolean);
  1533. var
  1534.   BI: TBitmapInfoHeader;
  1535.   BC: TBitmapCoreHeader;
  1536.   BCRGB: array[0..255] of TRGBTriple;
  1537.  
  1538.   procedure LoadRLE4;
  1539.   begin
  1540.     FSize := BI.biSizeImage;
  1541.     //GetMem(FPBits, FSize);
  1542.     FPBits := GlobalAllocPtr(GMEM_FIXED, FSize);
  1543.     FBitmapInfo.bmiHeader.biSizeImage := FSize;
  1544.     Stream.ReadBuffer(FPBits^, FSize);
  1545.   end;
  1546.  
  1547.   procedure LoadRLE8;
  1548.   begin
  1549.     FSize := BI.biSizeImage;
  1550.     //GetMem(FPBits, FSize);
  1551.     FPBits := GlobalAllocPtr(GMEM_FIXED, FSize);
  1552.     FBitmapInfo.bmiHeader.biSizeImage := FSize;
  1553.     Stream.ReadBuffer(FPBits^, FSize);
  1554.   end;
  1555.  
  1556.   procedure LoadRGB;
  1557.   var
  1558.     y: Integer;
  1559.   begin
  1560.     if BI.biHeight < 0 then
  1561.     begin
  1562.       for y := 0 to Abs(BI.biHeight) - 1 do
  1563.         Stream.ReadBuffer(Pointer(Integer(FTopPBits) + y * FNextLine)^, FWidthBytes);
  1564.     end
  1565.     else
  1566.     begin
  1567.       Stream.ReadBuffer(FPBits^, FSize);
  1568.     end;
  1569.   end;
  1570.  
  1571. var
  1572.   i, PalCount: Integer;
  1573.   OS2: Boolean;
  1574.   Localpf: TLocalDIBPixelFormat;
  1575.   AColorTable: TRGBQuads;
  1576.   APixelFormat: TDIBPixelFormat;
  1577. begin
  1578.   if not Assigned(Stream) then Exit;
  1579.  
  1580.   {  Header size reading  }
  1581.   i := Stream.Read(BI.biSize, 4);
  1582.  
  1583.   if i = 0 then
  1584.   begin
  1585.     {$IFNDEF D17UP}
  1586.     {self recreation is not allowed here}
  1587.     Create;
  1588.     {$ENDIF}
  1589.     Exit;
  1590.   end;
  1591.   if i <> 4 then
  1592.     raise EInvalidGraphic.Create(SInvalidDIB);
  1593.  
  1594.   {  Kind check of DIB  }
  1595.   OS2 := False;
  1596.  
  1597.   case BI.biSize of
  1598.     SizeOf(TBitmapCoreHeader):
  1599.       begin
  1600.         {  OS/2 type  }
  1601.         Stream.ReadBuffer(Pointer(Integer(@BC) + 4)^, SizeOf(TBitmapCoreHeader) - 4);
  1602.  
  1603.         with BI do
  1604.         begin
  1605.           biClrUsed := 0;
  1606.           biCompression := BI_RGB;
  1607.           biBitCount := BC.bcBitCount;
  1608.           biHeight := BC.bcHeight;
  1609.           biWidth := BC.bcWidth;
  1610.         end;
  1611.  
  1612.         OS2 := True;
  1613.       end;
  1614.     SizeOf(TBitmapInfoHeader):
  1615.       begin
  1616.         {  Windows type  }
  1617.         Stream.ReadBuffer(Pointer(Integer(@BI) + 4)^, SizeOf(TBitmapInfoHeader) - 4);
  1618.       end;
  1619.   else
  1620.     raise EInvalidGraphic.Create(SInvalidDIB);
  1621.   end;
  1622.  
  1623.   {  Bit mask reading.  }
  1624.   if BI.biCompression = BI_BITFIELDS then
  1625.   begin
  1626.     Stream.ReadBuffer(Localpf, SizeOf(Localpf));
  1627.     with Localpf do
  1628.       APixelFormat := MakeDIBPixelFormatMask(RBitMask, GBitMask, BBitMask);
  1629.   end
  1630.   else
  1631.   begin
  1632.     if BI.biBitCount = 16 then
  1633.       APixelFormat := MakeDIBPixelFormat(5, 5, 5)
  1634.     else if BI.biBitCount = 32 then
  1635.       APixelFormat := MakeDIBPixelFormat(8, 8, 8)
  1636.     else
  1637.       APixelFormat := MakeDIBPixelFormat(8, 8, 8);
  1638.   end;
  1639.  
  1640.     {  Palette reading  }
  1641.   PalCount := BI.biClrUsed;
  1642.   if (PalCount = 0) and (BI.biBitCount <= 8) then
  1643.     PalCount := 1 shl BI.biBitCount;
  1644.   if PalCount > 256 then PalCount := 256;
  1645.  
  1646.   FillChar(AColorTable, SizeOf(AColorTable), 0);
  1647.  
  1648.   if OS2 then
  1649.   begin
  1650.     {  OS/2 type  }
  1651.     Stream.ReadBuffer(BCRGB, SizeOf(TRGBTriple) * PalCount);
  1652.     for i := 0 to PalCount - 1 do
  1653.     begin
  1654.       with BCRGB[i] do
  1655.         AColorTable[i] := RGBQuad(rgbtRed, rgbtGreen, rgbtBlue);
  1656.     end;
  1657.   end
  1658.   else
  1659.   begin
  1660.     {  Windows type  }
  1661.     Stream.ReadBuffer(AColorTable, SizeOf(TRGBQuad) * PalCount);
  1662.   end;
  1663.  
  1664.   {  DIB compilation  }
  1665.   NewImage(BI.biWidth, Abs(BI.biHeight), BI.biBitCount, APixelFormat, AColorTable,
  1666.     MemoryImage, BI.biCompression in [BI_RLE4, BI_RLE8]);
  1667.  
  1668.   {  Pixel data reading  }
  1669.   case BI.biCompression of
  1670.     BI_RGB: LoadRGB;
  1671.     BI_RLE4: LoadRLE4;
  1672.     BI_RLE8: LoadRLE8;
  1673.     BI_BITFIELDS: LoadRGB;
  1674.   else
  1675.     raise EInvalidGraphic.Create(SInvalidDIB);
  1676.   end;
  1677. end;
  1678.  
  1679. destructor TDIBSharedImage.Destroy;
  1680. begin
  1681.   if FHandle <> 0 then
  1682.   begin
  1683.     if FOldHandle <> 0 then SelectObject(FDC, FOldHandle);
  1684.     DeleteObject(FHandle);
  1685.   end
  1686.   else
  1687. //    GlobalFree(THandle(FPBits));
  1688.   begin
  1689.     if FPBits <> nil then
  1690.       GlobalFreePtr(FPBits);
  1691.   end;
  1692.  
  1693.   PaletteManager.DeletePalette(FPalette);
  1694.   if FDC <> 0 then DeleteDC(FDC);
  1695.  
  1696.   FreeMem(FBitmapInfo);
  1697.   inherited Destroy;
  1698. end;
  1699.  
  1700. procedure TDIBSharedImage.FreeHandle;
  1701. begin
  1702. end;
  1703.  
  1704. function TDIBSharedImage.GetPalette: THandle;
  1705. begin
  1706.   if FPaletteCount > 0 then
  1707.   begin
  1708.     if FChangePalette then
  1709.     begin
  1710.       FChangePalette := False;
  1711.       PaletteManager.DeletePalette(FPalette);
  1712.       FPalette := PaletteManager.CreatePalette(FColorTable, FPaletteCount);
  1713.     end;
  1714.     Result := FPalette;
  1715.   end else
  1716.     Result := 0;
  1717. end;
  1718.  
  1719. procedure TDIBSharedImage.SetColorTable(const Value: TRGBQuads);
  1720. begin
  1721.   FColorTable := Value;
  1722.   FChangePalette := True;
  1723.  
  1724.   if (FSize > 0) and (FPaletteCount > 0) then
  1725.   begin
  1726.     SetDIBColorTable(FDC, 0, 256, FColorTable);
  1727.     Move(FColorTable, Pointer(Integer(FBitmapInfo) + FColorTablePos)^, SizeOf(TRGBQuad) * FPaletteCount);
  1728.   end;
  1729. end;
  1730.  
  1731. { TDIB }
  1732.  
  1733. var
  1734.   FEmptyDIBImage: TDIBSharedImage;
  1735.  
  1736. function EmptyDIBImage: TDIBSharedImage;
  1737. begin
  1738.   if FEmptyDIBImage = nil then
  1739.   begin
  1740.     FEmptyDIBImage := TDIBSharedImage.Create;
  1741.     FEmptyDIBImage.Reference;
  1742.   end;
  1743.   Result := FEmptyDIBImage;
  1744. end;
  1745.  
  1746. constructor TDIB.Create;
  1747. begin
  1748.   inherited Create;
  1749.   SetImage(EmptyDIBImage);
  1750.  
  1751.   FFreeList := TList.Create;
  1752. end;
  1753.  
  1754. destructor TDIB.Destroy;
  1755. var
  1756.   D: TDIB;
  1757. begin
  1758.   SetImage(EmptyDIBImage);
  1759.   FCanvas.Free;
  1760.  
  1761.   while FFreeList.Count > 0 do
  1762.   try
  1763.     D := TDIB(FFreeList[0]);
  1764.     FFreeList.Remove(D);
  1765.     if (D <> nil) and (D.Height > 0) and (D.Width > 0) then //is really pointed to image?
  1766.       D.Free;
  1767.   except
  1768.     // it is silent exception, but it can through outer (abstract) exception
  1769.   end;
  1770.   FFreeList.Free;
  1771.  
  1772.   inherited Destroy;
  1773. end;
  1774.  
  1775. procedure TDIB.Assign(Source: TPersistent);
  1776.  
  1777.   procedure AssignBitmap(Source: TBitmap);
  1778.   var
  1779.     Data: array[0..1023] of Byte;
  1780.     BitmapRec: Windows.PBitmap;
  1781.     DIBSectionRec: PDIBSection;
  1782.     PaletteEntries: TPaletteEntries;
  1783.   begin
  1784.     GetPaletteEntries(Source.Palette, 0, 256, PaletteEntries);
  1785.     ColorTable := PaletteEntriesToRGBQuads(PaletteEntries);
  1786.     UpdatePalette;
  1787.  
  1788.     case GetObject(Source.Handle, SizeOf(Data), @Data) of
  1789.       SizeOf(Windows.TBitmap):
  1790.         begin
  1791.           BitmapRec := @Data;
  1792.           case BitmapRec^.bmBitsPixel of
  1793.             16: PixelFormat := MakeDIBPixelFormat(5, 5, 5);
  1794.           else
  1795.             PixelFormat := MakeDIBPixelFormat(8, 8, 8);
  1796.           end;
  1797.           SetSize(BitmapRec^.bmWidth, BitmapRec^.bmHeight, BitmapRec^.bmBitsPixel);
  1798.         end;
  1799.       SizeOf(TDIBSection):
  1800.         begin
  1801.           DIBSectionRec := @Data;
  1802.           if DIBSectionRec^.dsBm.bmBitsPixel >= 24 then
  1803.           begin
  1804.             PixelFormat := MakeDIBPixelFormat(8, 8, 8);
  1805.           end
  1806.           else
  1807.             if DIBSectionRec^.dsBm.bmBitsPixel > 8 then
  1808.             begin
  1809.               PixelFormat := MakeDIBPixelFormatMask(DIBSectionRec^.dsBitfields[0], //correct I.Ceneff, thanks
  1810.                 DIBSectionRec^.dsBitfields[1], DIBSectionRec^.dsBitfields[2]);
  1811.             end
  1812.             else
  1813.             begin
  1814.               PixelFormat := MakeDIBPixelFormat(8, 8, 8);
  1815.             end;
  1816.           SetSize(DIBSectionRec^.dsBm.bmWidth, DIBSectionRec^.dsBm.bmHeight,
  1817.             DIBSectionRec^.dsBm.bmBitsPixel);
  1818.         end;
  1819.     else
  1820.       Exit;
  1821.     end;
  1822.  
  1823.     FillChar(PBits^, Size, 0);
  1824.     Canvas.Draw(0, 0, Source);
  1825.   end;
  1826.  
  1827.   procedure AssignGraphic(Source: TGraphic);
  1828.   {$IFDEF PNG_GRAPHICS}
  1829.   var
  1830.     alpha: TDIB;
  1831.     png: {$IFDEF VER12UP}TPngImage{$ELSE}TPNGObject{$ENDIF};
  1832.     i, j: Integer;
  1833.     q: pByteArray;
  1834.   {$ENDIF}
  1835.   begin
  1836.     {$IFDEF PNG_GRAPHICS}
  1837.     if Source is {$IFDEF VER12UP}TPngImage{$ELSE}TPNGObject{$ENDIF} then
  1838.     begin
  1839.       alpha := TDIB.Create;
  1840.       try
  1841.         {png image}
  1842.         png := {$IFDEF VER12UP}TPngImage{$ELSE}TPNGObject{$ENDIF}.Create;
  1843.         try
  1844.           png.Assign(Source);
  1845.           if png.TransparencyMode = ptmPartial then
  1846.           begin
  1847.             Alpha.SetSize(png.Width, png.Height, 8);
  1848.             {separate alpha}
  1849.             for i := 0 to png.Height - 1 do
  1850.             begin
  1851.               q := png.AlphaScanline[i];
  1852.               for j := 0 to png.Width - 1 do
  1853.                 alpha.Pixels[j,i] := q[j];
  1854.             end;
  1855.           end;
  1856.           SetSize(png.Width, png.Height, 32);
  1857.           FillChar(PBits^, Size, 0);
  1858.           Canvas.Draw(0, 0, png);
  1859.           Transparent := png.Transparent;
  1860.         finally
  1861.           png.Free;
  1862.         end;
  1863.         if not alpha.Empty then
  1864.           AssignAlphaChannel(alpha);
  1865.       finally
  1866.         alpha.Free;
  1867.       end;
  1868.     end
  1869.     else
  1870.     {$ENDIF}
  1871.     if Source is TBitmap then
  1872.       AssignBitmap(TBitmap(Source))
  1873.     else
  1874.     begin
  1875.       SetSize(Source.Width, Source.Height, 32);
  1876.       FillChar(PBits^, Size, 0);
  1877.       Canvas.Draw(0, 0, Source);
  1878.       Transparent := Source.Transparent;
  1879.       if not HasAlphaChannel then
  1880.       begin
  1881.         SetSize(Source.Width, Source.Height, 24);
  1882.         FillChar(PBits^, Size, 0);
  1883.         Canvas.Draw(0, 0, Source);
  1884.         Transparent := Source.Transparent;
  1885.       end
  1886.     end;
  1887.   end;
  1888.  
  1889. begin
  1890.   if Source = nil then
  1891.   begin
  1892.     Clear;
  1893.   end else if Source is TDIB then
  1894.   begin
  1895.     if Source <> Self then
  1896.       SetImage(TDIB(Source).FImage);
  1897.   end else if Source is TGraphic then
  1898.   begin
  1899.     AssignGraphic(TGraphic(Source));
  1900.   end else if Source is TPicture then
  1901.   begin
  1902.     if TPicture(Source).Graphic <> nil then
  1903.       AssignGraphic(TPicture(Source).Graphic)
  1904.     else
  1905.       Clear;
  1906.   end else
  1907.     inherited Assign(Source);
  1908. end;
  1909.  
  1910. procedure TDIB.Draw(ACanvas: TCanvas; const ARect: TRect);
  1911. var
  1912.   OldPalette: HPalette;
  1913.   OldMode: Integer;
  1914. begin
  1915.   if Size > 0 then
  1916.   begin
  1917.     if PaletteCount > 0 then
  1918.     begin
  1919.       OldPalette := SelectPalette(ACanvas.Handle, Palette, False);
  1920.       RealizePalette(ACanvas.Handle);
  1921.     end
  1922.     else
  1923.       OldPalette := 0;
  1924.     try
  1925.       OldMode := SetStretchBltMode(ACanvas.Handle, COLORONCOLOR);
  1926.       try
  1927.         GdiFlush;
  1928.         if FImage.FMemoryImage then
  1929.         begin
  1930.           with ARect do
  1931.           begin
  1932.             if StretchDIBits(ACanvas.Handle, Left, Top, Right - Left, Bottom - Top,
  1933.               0, 0, Self.Width, Self.Height, FImage.FPBits, FImage.FBitmapInfo^, DIB_RGB_COLORS, ACanvas.CopyMode) = 0 then
  1934.                MessageBeep(1);
  1935.           end;
  1936.         end
  1937.         else
  1938.         begin
  1939.           with ARect do
  1940.             StretchBlt(ACanvas.Handle, Left, Top, Right - Left, Bottom - Top,
  1941.               FImage.FDC, 0, 0, Self.Width, Self.Height, ACanvas.CopyMode);
  1942.         end;
  1943.       finally
  1944.         SetStretchBltMode(ACanvas.Handle, OldMode);
  1945.       end;
  1946.     finally
  1947.       SelectPalette(ACanvas.Handle, OldPalette, False);
  1948.     end;
  1949.   end;
  1950. end;
  1951.  
  1952. procedure TDIB.Clear;
  1953. begin
  1954.   SetImage(EmptyDIBImage);
  1955. end;
  1956.  
  1957. procedure TDIB.CanvasChanging(Sender: TObject);
  1958. begin
  1959.   Changing(False);
  1960. end;
  1961.  
  1962. procedure TDIB.Changing(MemoryImage: Boolean);
  1963. var
  1964.   TempImage: TDIBSharedImage;
  1965. begin
  1966.   if (FImage.RefCount > 1) or (FImage.FCompressed) or ((not MemoryImage) and (FImage.FMemoryImage)) then
  1967.   begin
  1968.     TempImage := TDIBSharedImage.Create;
  1969.     try
  1970.       TempImage.Decompress(FImage, FImage.FMemoryImage and MemoryImage);
  1971.     except
  1972.       TempImage.Free;
  1973.       raise;
  1974.     end;
  1975.     SetImage(TempImage);
  1976.   end;
  1977. end;
  1978.  
  1979. procedure TDIB.AllocHandle;
  1980. var
  1981.   TempImage: TDIBSharedImage;
  1982. begin
  1983.   if FImage.FMemoryImage then
  1984.   begin
  1985.     TempImage := TDIBSharedImage.Create;
  1986.     try
  1987.       TempImage.Decompress(FImage, False);
  1988.     except
  1989.       TempImage.Free;
  1990.       raise;
  1991.     end;
  1992.     SetImage(TempImage);
  1993.   end;
  1994. end;
  1995.  
  1996. procedure TDIB.Compress;
  1997. var
  1998.   TempImage: TDIBSharedImage;
  1999. begin
  2000.   if (not FImage.FCompressed) and (BitCount in [4, 8]) then
  2001.   begin
  2002.     TempImage := TDIBSharedImage.Create;
  2003.     try
  2004.       TempImage.Compress(FImage);
  2005.     except
  2006.       TempImage.Free;
  2007.       raise;
  2008.     end;
  2009.     SetImage(TempImage);
  2010.   end;
  2011. end;
  2012.  
  2013. procedure TDIB.Decompress;
  2014. var
  2015.   TempImage: TDIBSharedImage;
  2016. begin
  2017.   if FImage.FCompressed then
  2018.   begin
  2019.     TempImage := TDIBSharedImage.Create;
  2020.     try
  2021.       TempImage.Decompress(FImage, FImage.FMemoryImage);
  2022.     except
  2023.       TempImage.Free;
  2024.       raise;
  2025.     end;
  2026.     SetImage(TempImage);
  2027.   end;
  2028. end;
  2029.  
  2030. procedure TDIB.FreeHandle;
  2031. var
  2032.   TempImage: TDIBSharedImage;
  2033. begin
  2034.   if not FImage.FMemoryImage then
  2035.   begin
  2036.     TempImage := TDIBSharedImage.Create;
  2037.     try
  2038.       TempImage.Duplicate(FImage, True);
  2039.     except
  2040.       TempImage.Free;
  2041.       raise;
  2042.     end;
  2043.     SetImage(TempImage);
  2044.   end;
  2045. end;
  2046.  
  2047. type
  2048.   PRGBA = ^TRGBA;
  2049.   TRGBA = array[0..0] of Windows.TRGBQuad;
  2050.  
  2051. function TDIB.HasAlphaChannel: Boolean;
  2052.   {give that DIB contain the alphachannel}
  2053. var
  2054.   p: PRGBA;
  2055.   X, Y: Integer;
  2056. begin
  2057.   Result := True;
  2058.   if BitCount = 32 then
  2059.     for Y := 0 to Height - 1 do
  2060.     begin
  2061.       p := ScanLine[Y];
  2062.       for X := 0 to Width - 1 do
  2063.       begin
  2064.         if p[X].rgbReserved <> $0 then Exit;
  2065.       end
  2066.     end;
  2067.   Result := False;
  2068. end;
  2069.  
  2070. function TDIB.AssignAlphaChannel(ALPHA: TDIB; ForceResize: Boolean{$IFDEF VER4UP} = False{$ENDIF}): Boolean;
  2071.   {copy alphachannel from other DIB or add from DIB8}
  2072. var
  2073.   p32_0, p32_1: PRGBA;
  2074.   p24: Pointer;
  2075.   pB: PArrayByte;
  2076.   X, Y: Integer;
  2077.   tmpDIB, qAlpha: TDIB;
  2078. begin
  2079.   Result := False;
  2080.   if GetEmpty then Exit;
  2081.   {Alphachannel can be copy into 32bit DIB only!}
  2082.   if BitCount <> 32 then
  2083.   begin
  2084.     tmpDIB := TDIB.Create;
  2085.     try
  2086.       tmpDIB.Assign(Self);
  2087.       Clear;
  2088.       SetSize(tmpDIB.Width, tmpDIB.Height, 32);
  2089.       Canvas.Draw(0, 0, tmpDIB);
  2090.     finally
  2091.       tmpDIB.Free;
  2092.     end;
  2093.   end;
  2094.   qAlpha := TDIB.Create;
  2095.   try
  2096.     if not Assigned(Alpha) then Exit;
  2097.     if ForceResize then
  2098.     begin
  2099.       {create temp}
  2100.       tmpDIB := TDIB.Create;
  2101.       try
  2102.         {picture}
  2103.         tmpDIB.Assign(ALPHA);
  2104.         {resample size}
  2105.         tmpDIB.DoResample(Width, Height, ftrBSpline);
  2106.         {convert to greyscale}
  2107.         tmpDIB.Greyscale(8);
  2108.         {return picture to qAlpha}
  2109.         qAlpha.Assign(tmpDIB);
  2110.       finally
  2111.         tmpDIB.Free;
  2112.       end;
  2113.     end
  2114.     else
  2115.       {Must be the same size!}
  2116.       if not ((Width = ALPHA.Width) and (Height = ALPHA.Height)) then Exit
  2117.       else qAlpha.Assign(ALPHA);
  2118.     {It works now with qAlpha only}
  2119.     case qAlpha.BitCount of
  2120.       24:
  2121.         begin
  2122.           for Y := 0 to Height - 1 do
  2123.           begin
  2124.             p32_0 := ScanLine[Y];
  2125.             p24 := qAlpha.ScanLine[Y];
  2126.             for X := 0 to Width - 1 do with PBGR(p24)^ do
  2127.             begin
  2128.                 p32_0[X].rgbReserved := Round(0.30 * R + 0.59 * G + 0.11 * B);
  2129.               end
  2130.           end;
  2131.         end;
  2132.       32:
  2133.         begin
  2134.           for Y := 0 to Height - 1 do
  2135.           begin
  2136.             p32_0 := ScanLine[Y];
  2137.             p32_1 := qAlpha.ScanLine[Y];
  2138.             for X := 0 to Width - 1 do
  2139.             begin
  2140.               p32_0[X].rgbReserved := p32_1[X].rgbReserved;
  2141.             end
  2142.           end;
  2143.         end;
  2144.       8:
  2145.         begin
  2146.           for Y := 0 to Height - 1 do
  2147.           begin
  2148.             p32_0 := ScanLine[Y];
  2149.             pB := qAlpha.ScanLine[Y];
  2150.             for X := 0 to Width - 1 do
  2151.             begin
  2152.               p32_0[X].rgbReserved := pB[X];
  2153.             end
  2154.           end;
  2155.         end;
  2156.       1:
  2157.         begin
  2158.           for Y := 0 to Height - 1 do
  2159.           begin
  2160.             p32_0 := ScanLine[Y];
  2161.             pB := qAlpha.ScanLine[Y];
  2162.             for X := 0 to Width - 1 do
  2163.             begin
  2164.               if pB[X] = 0 then
  2165.                 p32_0[X].rgbReserved := $FF
  2166.               else
  2167.                 p32_0[X].rgbReserved := 0
  2168.             end
  2169.           end;
  2170.         end;
  2171.     else
  2172.       Exit;
  2173.     end;
  2174.     Result := True;
  2175.   finally
  2176.     qAlpha.Free;
  2177.   end;
  2178. end;
  2179.  
  2180. procedure TDIB.RetAlphaChannel(out oDIB: TDIB);
  2181.   {Store alphachannel information into DIB8}
  2182. var
  2183.   p0: PRGBA;
  2184.   pB: PArrayByte;
  2185.   X, Y: Integer;
  2186. begin
  2187.   oDIB := nil;
  2188.   if not HasAlphaChannel then Exit;
  2189.   oDIB := TDIB.Create;
  2190.   oDIB.SetSize(Width, Height, 8);
  2191.   for Y := 0 to Height - 1 do
  2192.   begin
  2193.     p0 := ScanLine[Y];
  2194.     pB := oDIB.ScanLine[Y];
  2195.     for X := 0 to Width - 1 do
  2196.     begin
  2197.       pB[X] := p0[X].rgbReserved;
  2198.     end
  2199.   end;
  2200. end;
  2201.  
  2202. function TDIB.GetBitmapInfo: PBitmapInfo;
  2203. begin
  2204.   Result := FImage.FBitmapInfo;
  2205. end;
  2206.  
  2207. function TDIB.GetBitmapInfoSize: Integer;
  2208. begin
  2209.   Result := FImage.FBitmapInfoSize;
  2210. end;
  2211.  
  2212. function TDIB.GetCanvas: TCanvas;
  2213. begin
  2214.   if (FCanvas = nil) or (FCanvas.Handle = 0) then
  2215.   begin
  2216.     AllocHandle;
  2217.  
  2218.     FCanvas := TCanvas.Create;
  2219.     FCanvas.Handle := FImage.FDC;
  2220.     FCanvas.OnChanging := CanvasChanging;
  2221.   end;
  2222.   Result := FCanvas;
  2223. end;
  2224.  
  2225. function TDIB.GetEmpty: Boolean;
  2226. begin
  2227.   Result := Size = 0;
  2228. end;
  2229.  
  2230. function TDIB.GetHandle: THandle;
  2231. begin
  2232.   Changing(True);
  2233.   Result := FImage.FHandle;
  2234. end;
  2235.  
  2236. function TDIB.GetHeight: Integer;
  2237. begin
  2238.   Result := FHeight;
  2239. end;
  2240.  
  2241. function TDIB.GetPalette: HPalette;
  2242. begin
  2243.   Result := FImage.GetPalette;
  2244. end;
  2245.  
  2246. function TDIB.GetPaletteCount: Integer;
  2247. begin
  2248.   Result := FImage.FPaletteCount;
  2249. end;
  2250.  
  2251. function TDIB.GetPBits: Pointer;
  2252. begin
  2253.   Changing(True);
  2254.  
  2255.   if not FImage.FMemoryImage then
  2256.     GDIFlush;
  2257.   Result := FPBits;
  2258. end;
  2259.  
  2260. function TDIB.GetPBitsReadOnly: Pointer;
  2261. begin
  2262.   if not FImage.FMemoryImage then
  2263.     GDIFlush;
  2264.   Result := FPBits;
  2265. end;
  2266.  
  2267. function TDIB.GetScanLine(Y: Integer): Pointer;
  2268. begin
  2269.   Changing(True);
  2270.   if (Y < 0) or (Y >= FHeight) then
  2271.     raise EInvalidGraphicOperation.CreateFmt(SScanline, [Y]);
  2272.  
  2273.   if not FImage.FMemoryImage then
  2274.     GDIFlush;
  2275.   Result := Pointer(Integer(FTopPBits) + Y * FNextLine);
  2276. end;
  2277.  
  2278. function TDIB.GetScanLineReadOnly(Y: Integer): Pointer;
  2279. begin
  2280.   if (Y < 0) or (Y >= FHeight) then
  2281.     raise EInvalidGraphicOperation.CreateFmt(SScanline, [Y]);
  2282.  
  2283.   if not FImage.FMemoryImage then
  2284.     GDIFlush;
  2285.   Result := Pointer(Integer(FTopPBits) + Y * FNextLine);
  2286. end;
  2287.  
  2288. {$IFDEF VER16UP}
  2289. function TDIB.GetSupportsPartialTransparency: Boolean;
  2290. begin
  2291.   Result := (FBitCount = 32) and HasAlphaChannel;
  2292. end;
  2293. {$ENDIF}
  2294.  
  2295. function TDIB.GetTopPBits: Pointer;
  2296. begin
  2297.   Changing(True);
  2298.  
  2299.   if not FImage.FMemoryImage then
  2300.     GDIFlush;
  2301.   Result := FTopPBits;
  2302. end;
  2303.  
  2304. function TDIB.GetTopPBitsReadOnly: Pointer;
  2305. begin
  2306.   if not FImage.FMemoryImage then
  2307.     GDIFlush;
  2308.   Result := FTopPBits;
  2309. end;
  2310.  
  2311. function TDIB.GetTransparent: Boolean;
  2312. begin
  2313.   Result := (FBitCount = 32) and HasAlphaChannel;
  2314. end;
  2315.  
  2316. function TDIB.GetWidth: Integer;
  2317. begin
  2318.   Result := FWidth;
  2319. end;
  2320.  
  2321. const
  2322.   Mask1: array[0..7] of DWORD = ($80, $40, $20, $10, $08, $04, $02, $01);
  2323.   Mask1n: array[0..7] of DWORD = ($FFFFFF7F, $FFFFFFBF, $FFFFFFDF, $FFFFFFEF,
  2324.     $FFFFFFF7, $FFFFFFFB, $FFFFFFFD, $FFFFFFFE);
  2325.   Mask4: array[0..1] of DWORD = ($F0, $0F);
  2326.   Mask4n: array[0..1] of DWORD = ($FFFFFF0F, $FFFFFFF0);
  2327.  
  2328.   Shift1: array[0..7] of DWORD = (7, 6, 5, 4, 3, 2, 1, 0);
  2329.   Shift4: array[0..1] of DWORD = (4, 0);
  2330.  
  2331. function TDIB.GetPixel(X, Y: Integer): DWORD;
  2332. begin
  2333.   Decompress;
  2334.  
  2335.   Result := 0;
  2336.   if (X >= 0) and (X < FWidth) and (Y >= 0) and (Y < FHeight) then
  2337.   begin
  2338.     case FBitCount of
  2339.       1: Result := (PArrayByte(Integer(FTopPBits) + Y * FNextLine)[X shr 3] and Mask1[X and 7]) shr Shift1[X and 7];
  2340.       4: Result := ((PArrayByte(Integer(FTopPBits) + Y * FNextLine)[X shr 1] and Mask4[X and 1]) shr Shift4[X and 1]);
  2341.       8: Result := PArrayByte(Integer(FTopPBits) + Y * FNextLine)[X];
  2342.       16: Result := PArrayWord(Integer(FTopPBits) + Y * FNextLine)[X];
  2343.       24: with PArrayBGR(Integer(FTopPBits) + Y * FNextLine)[X] do
  2344.           Result := R or (G shl 8) or (B shl 16);
  2345.       32: Result := PArrayDWord(Integer(FTopPBits) + Y * FNextLine)[X];
  2346.     end;
  2347.   end;
  2348. end;
  2349.  
  2350. function TDIB.GetRGBChannel: TDIB;
  2351.   {Store RGB channel information into DIB24}
  2352. begin
  2353.   Result := nil;
  2354.   if Self.Empty then Exit;
  2355.   Result := TDIB.Create;
  2356.   Result.SetSize(Width, Height, 24);
  2357.   Self.DrawOn(Bounds(0,0, Self.Width, Self.Height), Result.Canvas, 0, 0);
  2358.   FFreeList.Add(Result);
  2359. end;
  2360.  
  2361. procedure TDIB.SetPixel(X, Y: Integer; Value: DWORD);
  2362. var
  2363.   P: PByte;
  2364. begin
  2365.   Changing(True);
  2366.  
  2367.   if (X >= 0) and (X < FWidth) and (Y >= 0) and (Y < FHeight) then
  2368.   begin
  2369.     case FBitCount of
  2370.       1: begin
  2371.           P := @PArrayByte(Integer(FTopPBits) + Y * FNextLine)[X shr 3];
  2372.           P^ := (P^ and Mask1n[X and 7]) or ((Value and 1) shl Shift1[X and 7]);
  2373.         end;
  2374.       4: begin
  2375.           P := (@PArrayByte(Integer(FTopPBits) + Y * FNextLine)[X shr 3]);
  2376.           P^ := ((P^ and Mask4n[X and 1]) or ((Value and 15) shl Shift4[X and 1]));
  2377.         end;
  2378.       8: PArrayByte(Integer(FTopPBits) + Y * FNextLine)[X] := Value;
  2379.       16: PArrayWord(Integer(FTopPBits) + Y * FNextLine)[X] := Value;
  2380.       24: with PArrayBGR(Integer(FTopPBits) + Y * FNextLine)[X] do
  2381.         begin
  2382.           B := Byte(Value shr 16);
  2383.           G := Byte(Value shr 8);
  2384.           R := Byte(Value);
  2385.         end;
  2386.       32: PArrayDWord(Integer(FTopPBits) + Y * FNextLine)[X] := Value;
  2387.     end;
  2388.   end;
  2389. end;
  2390.  
  2391. procedure TDIB.SetRGBChannel(const Value: TDIB);
  2392. var
  2393.   alpha: TDIB;
  2394. begin
  2395.   if Self.HasAlphaChannel then
  2396.   try
  2397.     RetAlphaChannel(alpha);
  2398.     Self.SetSize(Value.Width, Value.Height, 32);
  2399.     Value.DrawOn(Bounds(0,0,Value.Width, Value.Height), Self.Canvas, 0, 0);
  2400.     Self.AssignAlphaChannel(alpha, True);
  2401.   finally
  2402.     alpha.Free;
  2403.   end
  2404.   else
  2405.     Self.Assign(Value);
  2406. end;
  2407.  
  2408. procedure TDIB.DefineProperties(Filer: TFiler);
  2409. begin
  2410.   inherited DefineProperties(Filer);
  2411.   {  For interchangeability with an old version.  }
  2412.   Filer.DefineBinaryProperty('DIB', LoadFromStream, nil, False);
  2413. end;
  2414.  
  2415. type
  2416.   {  TGlobalMemoryStream  }
  2417.  
  2418.   TGlobalMemoryStream = class(TMemoryStream)
  2419.   private
  2420.     FHandle: THandle;
  2421.   public
  2422.     constructor Create(AHandle: THandle);
  2423.     destructor Destroy; override;
  2424.   end;
  2425.  
  2426. constructor TGlobalMemoryStream.Create(AHandle: THandle);
  2427. begin
  2428.   inherited Create;
  2429.   FHandle := AHandle;
  2430.   SetPointer(GlobalLock(AHandle), GlobalSize(AHandle));
  2431. end;
  2432.  
  2433. destructor TGlobalMemoryStream.Destroy;
  2434. begin
  2435.   GlobalUnLock(FHandle);
  2436.   SetPointer(nil, 0);
  2437.   inherited Destroy;
  2438. end;
  2439.  
  2440. procedure TDIB.LoadFromClipboardFormat(AFormat: Word; AData: THandle;
  2441.   APalette: HPALETTE);
  2442. var
  2443.   Stream: TGlobalMemoryStream;
  2444. begin
  2445.   Stream := TGlobalMemoryStream.Create(AData);
  2446.   try
  2447.     ReadData(Stream);
  2448.   finally
  2449.     Stream.Free;
  2450.   end;
  2451. end;
  2452.  
  2453. const
  2454.   BitmapFileType = Ord('B') + Ord('M') * $100;
  2455.  
  2456. procedure TDIB.LoadFromStream(Stream: TStream);
  2457. var
  2458.   BF: TBitmapFileHeader;
  2459.   i: Integer;
  2460.   ImageJPEG: TJPEGImage;
  2461. begin
  2462.   {  File header reading  }
  2463.   i := Stream.Read(BF, SizeOf(TBitmapFileHeader));
  2464.   if i = 0 then Exit;
  2465.   if i <> SizeOf(TBitmapFileHeader) then
  2466.     raise EInvalidGraphic.Create(SInvalidDIB);
  2467.  
  2468.   {  Is the head jpeg ?}
  2469.  
  2470.   if BF.bfType = $D8FF then
  2471.   begin
  2472.     ImageJPEG := TJPEGImage.Create;
  2473.     try
  2474.       try
  2475.         Stream.Position := 0;
  2476.         ImageJPEG.LoadFromStream(Stream);
  2477.       except
  2478.         on EInvalidGraphic do ImageJPEG := nil;
  2479.       end;
  2480.       if ImageJPEG <> nil then
  2481.       begin
  2482.         {set size and bitcount in natural units of jpeg}
  2483.         SetSize(ImageJPEG.Width, ImageJPEG.Height, 24);
  2484.         Canvas.Draw(0, 0, ImageJPEG);
  2485.         Exit
  2486.       end;
  2487.     finally
  2488.       ImageJPEG.Free;
  2489.     end;
  2490.   end
  2491.   else
  2492.   {  Is the head 'BM'?  }
  2493.     if BF.bfType <> BitmapFileType then
  2494.       raise EInvalidGraphic.Create(SInvalidDIB);
  2495.  
  2496.   ReadData(Stream);
  2497. end;
  2498.  
  2499. procedure TDIB.ReadData(Stream: TStream);
  2500. var
  2501.   TempImage: TDIBSharedImage;
  2502. begin
  2503.   TempImage := TDIBSharedImage.Create;
  2504.   try
  2505.     TempImage.ReadData(Stream, FImage.FMemoryImage);
  2506.   except
  2507.     TempImage.Free;
  2508.     raise;
  2509.   end;
  2510.   SetImage(TempImage);
  2511. end;
  2512.  
  2513. procedure TDIB.SaveToClipboardFormat(var AFormat: Word; var AData: THandle;
  2514.   var APalette: HPALETTE);
  2515. var
  2516.   P: Pointer;
  2517.   Stream: TMemoryStream;
  2518. begin
  2519.   AFormat := CF_DIB;
  2520.   APalette := 0;
  2521.  
  2522.   Stream := TMemoryStream.Create;
  2523.   try
  2524.     WriteData(Stream);
  2525.  
  2526.     AData := GlobalAlloc(GHND, Stream.Size);
  2527.     if AData = 0 then OutOfMemoryError;
  2528.  
  2529.     P := GlobalLock(AData);
  2530.     Move(Stream.Memory^, P^, Stream.Size);
  2531.     GlobalUnLock(AData);
  2532.   finally
  2533.     Stream.Free;
  2534.   end;
  2535. end;
  2536.  
  2537. procedure TDIB.SaveToStream(Stream: TStream);
  2538. var
  2539.   BF: TBitmapFileHeader;
  2540. begin
  2541.   if Empty then Exit;
  2542.  
  2543.   with BF do
  2544.   begin
  2545.     bfType := BitmapFileType;
  2546.     bfOffBits := SizeOf(TBitmapFileHeader) + BitmapInfoSize;
  2547.     bfSize := bfOffBits + FImage.FBitmapInfo^.bmiHeader.biSizeImage;
  2548.     bfReserved1 := 0;
  2549.     bfReserved2 := 0;
  2550.     if (FBitCount = 32) and (FImage.FBitmapInfo^.bmiHeader.biCompression <> 0) then FImage.FBitmapInfo^.bmiHeader.biCompression := 0; //corrext RGB error to RGBA
  2551.   end;
  2552.  
  2553.   Stream.WriteBuffer(BF, SizeOf(TBitmapFileHeader));
  2554.  
  2555.   WriteData(Stream);
  2556. end;
  2557.  
  2558. procedure TDIB.WriteData(Stream: TStream);
  2559. begin
  2560.   if Empty then Exit;
  2561.  
  2562.   if not FImage.FMemoryImage then
  2563.     GDIFlush;
  2564.  
  2565.   Stream.WriteBuffer(FImage.FBitmapInfo^, FImage.FBitmapInfoSize);
  2566.   Stream.WriteBuffer(FImage.FPBits^, FImage.FBitmapInfo.bmiHeader.biSizeImage);
  2567. end;
  2568.  
  2569. procedure TDIB.SetBitCount(Value: Integer);
  2570. begin
  2571.   if Value <= 0 then
  2572.     Clear
  2573.   else
  2574.   begin
  2575.     if Empty then
  2576.     begin
  2577.       SetSize(Max(Width, 1), Max(Height, 1), Value)
  2578.     end
  2579.     else
  2580.     begin
  2581.       ConvertBitCount(Value);
  2582.     end;
  2583.   end;
  2584. end;
  2585.  
  2586. procedure TDIB.SetHeight(Value: Integer);
  2587. begin
  2588.   if Value <= 0 then
  2589.     Clear
  2590.   else
  2591.   begin
  2592.     if Empty then
  2593.       SetSize(Max(Width, 1), Value, 8)
  2594.     else
  2595.       SetSize(Width, Value, BitCount);
  2596.   end;
  2597. end;
  2598.  
  2599. procedure TDIB.SetWidth(Value: Integer);
  2600. begin
  2601.   if Value <= 0 then
  2602.     Clear
  2603.   else
  2604.   begin
  2605.     if Empty then
  2606.       SetSize(Value, Max(Height, 1), 8)
  2607.     else
  2608.       SetSize(Value, Height, BitCount);
  2609.   end;
  2610. end;
  2611.  
  2612. procedure TDIB.SetImage(Value: TDIBSharedImage);
  2613. begin
  2614.   if FImage <> Value then
  2615.   begin
  2616.     if FCanvas <> nil then
  2617.       FCanvas.Handle := 0;
  2618.  
  2619.     FImage.Release;
  2620.     FImage := Value;
  2621.     FImage.Reference;
  2622.  
  2623.     if FCanvas <> nil then
  2624.       FCanvas.Handle := FImage.FDC;
  2625.  
  2626.     ColorTable := FImage.FColorTable;
  2627.     PixelFormat := FImage.FPixelFormat;
  2628.  
  2629.     FBitCount := FImage.FBitCount;
  2630.     FHeight := FImage.FHeight;
  2631.     FNextLine := FImage.FNextLine;
  2632.     FNowPixelFormat := FImage.FPixelFormat;
  2633.     FPBits := FImage.FPBits;
  2634.     FSize := FImage.FSize;
  2635.     FTopPBits := FImage.FTopPBits;
  2636.     FWidth := FImage.FWidth;
  2637.     FWidthBytes := FImage.FWidthBytes;
  2638.   end;
  2639. end;
  2640.  
  2641. procedure TDIB.SetNowPixelFormat(const Value: TDIBPixelFormat);
  2642. var
  2643.   Temp: TDIB;
  2644. begin
  2645.   if CompareMem(@Value, @FImage.FPixelFormat, SizeOf(TDIBPixelFormat)) then exit;
  2646.  
  2647.   PixelFormat := Value;
  2648.  
  2649.   Temp := TDIB.Create;
  2650.   try
  2651.     Temp.Assign(Self);
  2652.     SetSize(Width, Height, BitCount);
  2653.     Canvas.Draw(0, 0, Temp);
  2654.   finally
  2655.     Temp.Free;
  2656.   end;
  2657. end;
  2658.  
  2659. procedure TDIB.SetPalette(Value: HPalette);
  2660. var
  2661.   PaletteEntries: TPaletteEntries;
  2662. begin
  2663.   GetPaletteEntries(Value, 0, 256, PaletteEntries);
  2664.   DeleteObject(Value);
  2665.  
  2666.   ColorTable := PaletteEntriesToRGBQuads(PaletteEntries);
  2667.   UpdatePalette;
  2668. end;
  2669.  
  2670. procedure TDIB.SetSize(AWidth, AHeight, ABitCount: Integer);
  2671. var
  2672.   TempImage: TDIBSharedImage;
  2673. begin
  2674.   if (AWidth = Width) and (AHeight = Height) and (ABitCount = BitCount) and
  2675.     (NowPixelFormat.RBitMask = PixelFormat.RBitMask) and
  2676.     (NowPixelFormat.GBitMask = PixelFormat.GBitMask) and
  2677.     (NowPixelFormat.BBitMask = PixelFormat.BBitMask) then Exit;
  2678.  
  2679.   if (AWidth <= 0) or (AHeight <= 0) then
  2680.   begin
  2681.     Clear;
  2682.     Exit;
  2683.   end;
  2684.  
  2685.   TempImage := TDIBSharedImage.Create;
  2686.   try
  2687.     TempImage.NewImage(AWidth, AHeight, ABitCount,
  2688.       PixelFormat, ColorTable, FImage.FMemoryImage, False);
  2689.   except
  2690.     TempImage.Free;
  2691.     raise;
  2692.   end;
  2693.   SetImage(TempImage);
  2694.  
  2695.   PaletteModified := True;
  2696. end;
  2697.  
  2698. procedure TDIB.UpdatePalette;
  2699. var
  2700.   Col: TRGBQuads;
  2701. begin
  2702.   if CompareMem(@ColorTable, @FImage.FColorTable, SizeOf(ColorTable)) then Exit;
  2703.  
  2704.   Col := ColorTable;
  2705.   Changing(True);
  2706.   ColorTable := Col;
  2707.   FImage.SetColorTable(ColorTable);
  2708.  
  2709.   PaletteModified := True;
  2710. end;
  2711.  
  2712. procedure TDIB.ConvertBitCount(ABitCount: Integer);
  2713. var
  2714.   Temp: TDIB;
  2715.  
  2716.   procedure CreateHalftonePalette(R, G, B: Integer);
  2717.   var
  2718.     i: Integer;
  2719.   begin
  2720.     for i := 0 to 255 do
  2721.       with ColorTable[i] do
  2722.       begin
  2723.         rgbRed := ((i shr (G + B - 1)) and (1 shl R - 1)) * 255 div (1 shl R - 1);
  2724.         rgbGreen := ((i shr (B - 1)) and (1 shl G - 1)) * 255 div (1 shl G - 1);
  2725.         rgbBlue := ((i shr 0) and (1 shl B - 1)) * 255 div (1 shl B - 1);
  2726.       end;
  2727.   end;
  2728.  
  2729.   procedure PaletteToPalette_Inc;
  2730.   var
  2731.     x, y: Integer;
  2732.     i: DWORD;
  2733.     SrcP, DestP: Pointer;
  2734.     P: PByte;
  2735.   begin
  2736.     i := 0;
  2737.  
  2738.     for y := 0 to Height - 1 do
  2739.     begin
  2740.       SrcP := Temp.ScanLine[y];
  2741.       DestP := ScanLine[y];
  2742.  
  2743.       for x := 0 to Width - 1 do
  2744.       begin
  2745.         case Temp.BitCount of
  2746.           1:
  2747.             begin
  2748.               i := (PArrayByte(SrcP)[X shr 3] and Mask1[X and 7]) shr Shift1[X and 7];
  2749.             end;
  2750.           4:
  2751.             begin
  2752.               i := (PArrayByte(SrcP)[X and 1] and Mask4[X and 1]) shr Shift4[X and 1];
  2753.             end;
  2754.           8:
  2755.             begin
  2756.               i := PByte(SrcP)^;
  2757.               Inc(PByte(SrcP));
  2758.             end;
  2759.         end;
  2760.  
  2761.         case BitCount of
  2762.           1:
  2763.             begin
  2764.               P := @PArrayByte(DestP)[X shr 3];
  2765.               P^ := (P^ and Mask1n[X and 7]) or (i shl Shift1[X shr 3]);
  2766.             end;
  2767.           4:
  2768.             begin
  2769.               P := @PArrayByte(DestP)[X shr 1];
  2770.               P^ := (P^ and Mask4n[X and 1]) or (i shl Shift4[X and 1]);
  2771.             end;
  2772.           8:
  2773.             begin
  2774.               PByte(DestP)^ := i;
  2775.               Inc(PByte(DestP));
  2776.             end;
  2777.         end;
  2778.       end;
  2779.     end;
  2780.   end;
  2781.  
  2782.   procedure PaletteToRGB_or_RGBToRGB;
  2783.   var
  2784.     x, y: Integer;
  2785.     SrcP, DestP: Pointer;
  2786.     cR, cG, cB: Byte;
  2787.   begin
  2788.     cR := 0;
  2789.     cG := 0;
  2790.     cB := 0;
  2791.  
  2792.     for y := 0 to Height - 1 do
  2793.     begin
  2794.       SrcP := Temp.ScanLine[y];
  2795.       DestP := ScanLine[y];
  2796.  
  2797.       for x := 0 to Width - 1 do
  2798.       begin
  2799.         case Temp.BitCount of
  2800.           1:
  2801.             begin
  2802.               with Temp.ColorTable[(PArrayByte(SrcP)[X shr 3] and Mask1[X and 7]) shr Shift1[X and 7]] do
  2803.               begin
  2804.                 cR := rgbRed;
  2805.                 cG := rgbGreen;
  2806.                 cB := rgbBlue;
  2807.               end;
  2808.             end;
  2809.           4:
  2810.             begin
  2811.               with Temp.ColorTable[(PArrayByte(SrcP)[X shr 1] and Mask4[X and 1]) shr Shift4[X and 1]] do
  2812.               begin
  2813.                 cR := rgbRed;
  2814.                 cG := rgbGreen;
  2815.                 cB := rgbBlue;
  2816.               end;
  2817.             end;
  2818.           8:
  2819.             begin
  2820.               with Temp.ColorTable[PByte(SrcP)^] do
  2821.               begin
  2822.                 cR := rgbRed;
  2823.                 cG := rgbGreen;
  2824.                 cB := rgbBlue;
  2825.               end;
  2826.               Inc(PByte(SrcP));
  2827.             end;
  2828.           16:
  2829.             begin
  2830.               pfGetRGB(Temp.NowPixelFormat, PWord(SrcP)^, cR, cG, cB);
  2831.               Inc(PWord(SrcP));
  2832.             end;
  2833.           24:
  2834.             begin
  2835.               with PBGR(SrcP)^ do
  2836.               begin
  2837.                 cR := R;
  2838.                 cG := G;
  2839.                 cB := B;
  2840.               end;
  2841.  
  2842.               Inc(PBGR(SrcP));
  2843.             end;
  2844.           32:
  2845.             begin
  2846.               pfGetRGB(Temp.NowPixelFormat, PDWORD(SrcP)^, cR, cG, cB);
  2847.               Inc(PDWORD(SrcP));
  2848.             end;
  2849.         end;
  2850.  
  2851.         case BitCount of
  2852.           16:
  2853.             begin
  2854.               PWord(DestP)^ := pfRGB(NowPixelFormat, cR, cG, cB);
  2855.               Inc(PWord(DestP));
  2856.             end;
  2857.           24:
  2858.             begin
  2859.               with PBGR(DestP)^ do
  2860.               begin
  2861.                 R := cR;
  2862.                 G := cG;
  2863.                 B := cB;
  2864.               end;
  2865.               Inc(PBGR(DestP));
  2866.             end;
  2867.           32:
  2868.             begin
  2869.               PDWORD(DestP)^ := pfRGB(NowPixelFormat, cR, cG, cB);
  2870.               Inc(PDWORD(DestP));
  2871.             end;
  2872.         end;
  2873.       end;
  2874.     end;
  2875.   end;
  2876.  
  2877. begin
  2878.   if Size = 0 then exit;
  2879.  
  2880.   Temp := TDIB.Create;
  2881.   try
  2882.     Temp.Assign(Self);
  2883.     SetSize(Temp.Width, Temp.Height, ABitCount);
  2884.  
  2885.     if FImage = Temp.FImage then Exit;
  2886.  
  2887.     if (Temp.BitCount <= 8) and (BitCount <= 8) then
  2888.     begin
  2889.       {  The image is converted from the palette color image into the palette color image.  }
  2890.       if Temp.BitCount <= BitCount then
  2891.       begin
  2892.         PaletteToPalette_Inc;
  2893.       end
  2894.       else
  2895.       begin
  2896.         case BitCount of
  2897.           1: begin
  2898.               ColorTable[0] := RGBQuad(0, 0, 0);
  2899.               ColorTable[1] := RGBQuad(255, 255, 255);
  2900.             end;
  2901.           4: CreateHalftonePalette(1, 2, 1);
  2902.           8: CreateHalftonePalette(3, 3, 2);
  2903.         end;
  2904.         UpdatePalette;
  2905.  
  2906.         Canvas.Draw(0, 0, Temp);
  2907.       end;
  2908.     end
  2909.     else
  2910.       if (Temp.BitCount <= 8) and (BitCount > 8) then
  2911.       begin
  2912. {  The image is converted from the palette color image into the rgb color image.  }
  2913.         PaletteToRGB_or_RGBToRGB;
  2914.       end
  2915.       else
  2916.         if (Temp.BitCount > 8) and (BitCount <= 8) then
  2917.         begin
  2918. { The image is converted from the rgb color image into the palette color image.  }
  2919.           case BitCount of
  2920.             1: begin
  2921.                 ColorTable[0] := RGBQuad(0, 0, 0);
  2922.                 ColorTable[1] := RGBQuad(255, 255, 255);
  2923.               end;
  2924.             4: CreateHalftonePalette(1, 2, 1);
  2925.             8: CreateHalftonePalette(3, 3, 2);
  2926.           end;
  2927.           UpdatePalette;
  2928.  
  2929.           Canvas.Draw(0, 0, Temp);
  2930.         end
  2931.         else
  2932.           if (Temp.BitCount > 8) and (BitCount > 8) then
  2933.           begin
  2934.  {  The image is converted from the rgb color image into the rgb color image.  }
  2935.             PaletteToRGB_or_RGBToRGB;
  2936.           end;
  2937.   finally
  2938.     Temp.Free;
  2939.   end;
  2940. end;
  2941.  
  2942. {  Special effect  }
  2943.  
  2944. procedure TDIB.StartProgress(const Name: string);
  2945. begin
  2946.   FProgressName := Name;
  2947.   FProgressOld := 0;
  2948.   FProgressOldTime := GetTickCount;
  2949.   FProgressY := 0;
  2950.   FProgressOldY := 0;
  2951.   Progress(Self, psStarting, 0, False, Rect(0, 0, Width, Height), FProgressName);
  2952. end;
  2953.  
  2954. procedure TDIB.EndProgress;
  2955. begin
  2956.   Progress(Self, psEnding, 100, True, Rect(0, FProgressOldY, Width, Height), FProgressName);
  2957. end;
  2958.  
  2959. procedure TDIB.UpdateProgress(PercentY: Integer);
  2960. var
  2961.   Redraw: Boolean;
  2962.   Percent: DWORD;
  2963. begin
  2964.   Redraw := (GetTickCount - FProgressOldTime > 200) and (FProgressY - FProgressOldY > 32) and
  2965.     (((Height div 3 > Integer(FProgressY)) and (FProgressOldY = 0)) or (FProgressOldY <> 0));
  2966.  
  2967.   Percent := PercentY * 100 div Height;
  2968.  
  2969.   if (Percent <> FProgressOld) or (Redraw) then
  2970.   begin
  2971.     Progress(Self, psRunning, Percent, Redraw,
  2972.       Rect(0, FProgressOldY, Width, FProgressY), FProgressName);
  2973.     if Redraw then
  2974.     begin
  2975.       FProgressOldY := FProgressY;
  2976.       FProgressOldTime := GetTickCount;
  2977.     end;
  2978.  
  2979.     FProgressOld := Percent;
  2980.   end;
  2981.  
  2982.   Inc(FProgressY);
  2983. end;
  2984.  
  2985. procedure TDIB.Mirror(MirrorX, MirrorY: Boolean);
  2986. var
  2987.   x, y, Width2, c: Integer;
  2988.   P1, P2, TempBuf: Pointer;
  2989. begin
  2990.   if Empty then Exit;
  2991.   if (not MirrorX) and (not MirrorY) then Exit;
  2992.  
  2993.   if (not MirrorX) and (MirrorY) then
  2994.   begin
  2995.     GetMem(TempBuf, WidthBytes);
  2996.     try
  2997.       StartProgress('Mirror');
  2998.       try
  2999.         for y := 0 to Height shr 1 - 1 do
  3000.         begin
  3001.           P1 := ScanLine[y];
  3002.           P2 := ScanLine[Height - y - 1];
  3003.  
  3004.           Move(P1^, TempBuf^, WidthBytes);
  3005.           Move(P2^, P1^, WidthBytes);
  3006.           Move(TempBuf^, P2^, WidthBytes);
  3007.  
  3008.           UpdateProgress(y * 2);
  3009.         end;
  3010.       finally
  3011.         EndProgress;
  3012.       end;
  3013.     finally
  3014.       FreeMem(TempBuf, WidthBytes);
  3015.     end;
  3016.   end
  3017.   else
  3018.   if (MirrorX) and (not MirrorY) then
  3019.   begin
  3020.     Width2 := Width shr 1;
  3021.  
  3022.     StartProgress('Mirror');
  3023.     try
  3024.       for y := 0 to Height - 1 do
  3025.       begin
  3026.         P1 := ScanLine[y];
  3027.  
  3028.         case BitCount of
  3029.           1:
  3030.             begin
  3031.               for x := 0 to Width2 - 1 do
  3032.               begin
  3033.                 c := Pixels[x, y];
  3034.                 Pixels[x, y] := Pixels[Width - x - 1, y];
  3035.                 Pixels[Width - x - 1, y] := c;
  3036.               end;
  3037.             end;
  3038.           4:
  3039.             begin
  3040.               for x := 0 to Width2 - 1 do
  3041.               begin
  3042.                 c := Pixels[x, y];
  3043.                 Pixels[x, y] := Pixels[Width - x - 1, y];
  3044.                 Pixels[Width - x - 1, y] := c;
  3045.               end;
  3046.             end;
  3047.           8:
  3048.             begin
  3049.               P2 := Pointer(Integer(P1) + Width - 1);
  3050.               for x := 0 to Width2 - 1 do
  3051.               begin
  3052.                 PByte(@c)^ := PByte(P1)^;
  3053.                 PByte(P1)^ := PByte(P2)^;
  3054.                 PByte(P2)^ := PByte(@c)^;
  3055.                 Inc(PByte(P1));
  3056.                 Dec(PByte(P2));
  3057.               end;
  3058.             end;
  3059.           16:
  3060.             begin
  3061.               P2 := Pointer(Integer(P1) + (Width - 1) * 2);
  3062.               for x := 0 to Width2 - 1 do
  3063.               begin
  3064.                 PWord(@c)^ := PWord(P1)^;
  3065.                 PWord(P1)^ := PWord(P2)^;
  3066.                 PWord(P2)^ := PWord(@c)^;
  3067.                 Inc(PWord(P1));
  3068.                 Dec(PWord(P2));
  3069.               end;
  3070.             end;
  3071.           24:
  3072.             begin
  3073.               P2 := Pointer(Integer(P1) + (Width - 1) * 3);
  3074.               for x := 0 to Width2 - 1 do
  3075.               begin
  3076.                 PBGR(@c)^ := PBGR(P1)^;
  3077.                 PBGR(P1)^ := PBGR(P2)^;
  3078.                 PBGR(P2)^ := PBGR(@c)^;
  3079.                 Inc(PBGR(P1));
  3080.                 Dec(PBGR(P2));
  3081.               end;
  3082.             end;
  3083.           32:
  3084.             begin
  3085.               P2 := Pointer(Integer(P1) + (Width - 1) * 4);
  3086.               for x := 0 to Width2 - 1 do
  3087.               begin
  3088.                 PDWORD(@c)^ := PDWORD(P1)^;
  3089.                 PDWORD(P1)^ := PDWORD(P2)^;
  3090.                 PDWORD(P2)^ := PDWORD(@c)^;
  3091.                 Inc(PDWORD(P1));
  3092.                 Dec(PDWORD(P2));
  3093.               end;
  3094.             end;
  3095.         end;
  3096.  
  3097.         UpdateProgress(y);
  3098.       end;
  3099.     finally
  3100.       EndProgress;
  3101.     end;
  3102.   end
  3103.   else
  3104.   if (MirrorX) and (MirrorY) then
  3105.   begin
  3106.     StartProgress('Mirror');
  3107.     try
  3108.       for y := 0 to Height shr 1 - 1 do
  3109.       begin
  3110.         P1 := ScanLine[y];
  3111.         P2 := ScanLine[Height - y - 1];
  3112.  
  3113.         case BitCount of
  3114.           1:
  3115.             begin
  3116.               for x := 0 to Width - 1 do
  3117.               begin
  3118.                 c := Pixels[x, y];
  3119.                 Pixels[x, y] := Pixels[Width - x - 1, Height - y - 1];
  3120.                 Pixels[Width - x - 1, Height - y - 1] := c;
  3121.               end;
  3122.             end;
  3123.           4:
  3124.             begin
  3125.               for x := 0 to Width - 1 do
  3126.               begin
  3127.                 c := Pixels[x, y];
  3128.                 Pixels[x, y] := Pixels[Width - x - 1, Height - y - 1];
  3129.                 Pixels[Width - x - 1, Height - y - 1] := c;
  3130.               end;
  3131.             end;
  3132.           8:
  3133.             begin
  3134.               P2 := Pointer(Integer(P2) + Width - 1);
  3135.               for x := 0 to Width - 1 do
  3136.               begin
  3137.                 PByte(@c)^ := PByte(P1)^;
  3138.                 PByte(P1)^ := PByte(P2)^;
  3139.                 PByte(P2)^ := PByte(@c)^;
  3140.                 Inc(PByte(P1));
  3141.                 Dec(PByte(P2));
  3142.               end;
  3143.             end;
  3144.           16:
  3145.             begin
  3146.               P2 := Pointer(Integer(P2) + (Width - 1) * 2);
  3147.               for x := 0 to Width - 1 do
  3148.               begin
  3149.                 PWord(@c)^ := PWord(P1)^;
  3150.                 PWord(P1)^ := PWord(P2)^;
  3151.                 PWord(P2)^ := PWord(@c)^;
  3152.                 Inc(PWord(P1));
  3153.                 Dec(PWord(P2));
  3154.               end;
  3155.             end;
  3156.           24:
  3157.             begin
  3158.               P2 := Pointer(Integer(P2) + (Width - 1) * 3);
  3159.               for x := 0 to Width - 1 do
  3160.               begin
  3161.                 PBGR(@c)^ := PBGR(P1)^;
  3162.                 PBGR(P1)^ := PBGR(P2)^;
  3163.                 PBGR(P2)^ := PBGR(@c)^;
  3164.                 Inc(PBGR(P1));
  3165.                 Dec(PBGR(P2));
  3166.               end;
  3167.             end;
  3168.           32:
  3169.             begin
  3170.               P2 := Pointer(Integer(P2) + (Width - 1) * 4);
  3171.               for x := 0 to Width - 1 do
  3172.               begin
  3173.                 PDWORD(@c)^ := PDWORD(P1)^;
  3174.                 PDWORD(P1)^ := PDWORD(P2)^;
  3175.                 PDWORD(P2)^ := PDWORD(@c)^;
  3176.                 Inc(PDWORD(P1));
  3177.                 Dec(PDWORD(P2));
  3178.               end;
  3179.             end;
  3180.         end;
  3181.  
  3182.         UpdateProgress(y * 2);
  3183.       end;
  3184.     finally
  3185.       EndProgress;
  3186.     end;
  3187.   end;
  3188. end;
  3189.  
  3190. procedure TDIB.Blur(ABitCount: Integer; Radius: Integer);
  3191. type
  3192.   TAve = record
  3193.     cR, cG, cB: DWORD;
  3194.     c: DWORD;
  3195.   end;
  3196.   TArrayAve = array[0..0] of TAve;
  3197.  
  3198. var
  3199.   Temp: TDIB;
  3200.  
  3201.   procedure AddAverage(Y, XCount: Integer; var Ave: TArrayAve);
  3202.   var
  3203.     X: Integer;
  3204.     SrcP: Pointer;
  3205.     AveP: ^TAve;
  3206.     R, G, B: Byte;
  3207.   begin
  3208.     case Temp.BitCount of
  3209.       1:
  3210.         begin
  3211.           SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine);
  3212.           AveP := @Ave;
  3213.           for x := 0 to XCount - 1 do
  3214.           begin
  3215.             with Temp.ColorTable[(PByte(Integer(SrcP) + X shr 3)^ and Mask1[x and 7]) shr Shift1[x and 7]], AveP^ do
  3216.             begin
  3217.               Inc(cR, rgbRed);
  3218.               Inc(cG, rgbGreen);
  3219.               Inc(cB, rgbBlue);
  3220.               Inc(c);
  3221.             end;
  3222.             Inc(AveP);
  3223.           end;
  3224.         end;
  3225.       4:
  3226.         begin
  3227.           SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine);
  3228.           AveP := @Ave;
  3229.           for x := 0 to XCount - 1 do
  3230.           begin
  3231.             with Temp.ColorTable[(PByte(Integer(SrcP) + X shr 1)^ and Mask4[x and 1]) shr Shift4[x and 1]], AveP^ do
  3232.             begin
  3233.               Inc(cR, rgbRed);
  3234.               Inc(cG, rgbGreen);
  3235.               Inc(cB, rgbBlue);
  3236.               Inc(c);
  3237.             end;
  3238.             Inc(AveP);
  3239.           end;
  3240.         end;
  3241.       8:
  3242.         begin
  3243.           SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine);
  3244.           AveP := @Ave;
  3245.           for x := 0 to XCount - 1 do
  3246.           begin
  3247.             with Temp.ColorTable[PByte(SrcP)^], AveP^ do
  3248.             begin
  3249.               Inc(cR, rgbRed);
  3250.               Inc(cG, rgbGreen);
  3251.               Inc(cB, rgbBlue);
  3252.               Inc(c);
  3253.             end;
  3254.             Inc(PByte(SrcP));
  3255.             Inc(AveP);
  3256.           end;
  3257.         end;
  3258.       16:
  3259.         begin
  3260.           SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine);
  3261.           AveP := @Ave;
  3262.           for x := 0 to XCount - 1 do
  3263.           begin
  3264.             pfGetRGB(Temp.NowPixelFormat, PWord(SrcP)^, R, G, B);
  3265.             with AveP^ do
  3266.             begin
  3267.               Inc(cR, R);
  3268.               Inc(cG, G);
  3269.               Inc(cB, B);
  3270.               Inc(c);
  3271.             end;
  3272.             Inc(PWord(SrcP));
  3273.             Inc(AveP);
  3274.           end;
  3275.         end;
  3276.       24:
  3277.         begin
  3278.           SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine);
  3279.           AveP := @Ave;
  3280.           for x := 0 to XCount - 1 do
  3281.           begin
  3282.             with PBGR(SrcP)^, AveP^ do
  3283.             begin
  3284.               Inc(cR, R);
  3285.               Inc(cG, G);
  3286.               Inc(cB, B);
  3287.               Inc(c);
  3288.             end;
  3289.             Inc(PBGR(SrcP));
  3290.             Inc(AveP);
  3291.           end;
  3292.         end;
  3293.       32:
  3294.         begin
  3295.           SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine);
  3296.           AveP := @Ave;
  3297.           for x := 0 to XCount - 1 do
  3298.           begin
  3299.             pfGetRGB(Temp.NowPixelFormat, PDWORD(SrcP)^, R, G, B);
  3300.             with AveP^ do
  3301.             begin
  3302.               Inc(cR, R);
  3303.               Inc(cG, G);
  3304.               Inc(cB, B);
  3305.               Inc(c);
  3306.             end;
  3307.             Inc(PDWORD(SrcP));
  3308.             Inc(AveP);
  3309.           end;
  3310.         end;
  3311.     end;
  3312.   end;
  3313.  
  3314.   procedure DeleteAverage(Y, XCount: Integer; var Ave: TArrayAve);
  3315.   var
  3316.     X: Integer;
  3317.     SrcP: Pointer;
  3318.     AveP: ^TAve;
  3319.     R, G, B: Byte;
  3320.   begin
  3321.     case Temp.BitCount of
  3322.       1:
  3323.         begin
  3324.           SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine);
  3325.           AveP := @Ave;
  3326.           for x := 0 to XCount - 1 do
  3327.           begin
  3328.             with Temp.ColorTable[(PByte(Integer(SrcP) + X shr 3)^ and Mask1[x and 7]) shr Shift1[x and 7]], AveP^ do
  3329.             begin
  3330.               Dec(cR, rgbRed);
  3331.               Dec(cG, rgbGreen);
  3332.               Dec(cB, rgbBlue);
  3333.               Dec(c);
  3334.             end;
  3335.             Inc(AveP);
  3336.           end;
  3337.         end;
  3338.       4:
  3339.         begin
  3340.           SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine);
  3341.           AveP := @Ave;
  3342.           for x := 0 to XCount - 1 do
  3343.           begin
  3344.             with Temp.ColorTable[(PByte(Integer(SrcP) + X shr 1)^ and Mask4[x and 1]) shr Shift4[x and 1]], AveP^ do
  3345.             begin
  3346.               Dec(cR, rgbRed);
  3347.               Dec(cG, rgbGreen);
  3348.               Dec(cB, rgbBlue);
  3349.               Dec(c);
  3350.             end;
  3351.             Inc(AveP);
  3352.           end;
  3353.         end;
  3354.       8:
  3355.         begin
  3356.           SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine);
  3357.           AveP := @Ave;
  3358.           for x := 0 to XCount - 1 do
  3359.           begin
  3360.             with Temp.ColorTable[PByte(SrcP)^], AveP^ do
  3361.             begin
  3362.               Dec(cR, rgbRed);
  3363.               Dec(cG, rgbGreen);
  3364.               Dec(cB, rgbBlue);
  3365.               Dec(c);
  3366.             end;
  3367.             Inc(PByte(SrcP));
  3368.             Inc(AveP);
  3369.           end;
  3370.         end;
  3371.       16:
  3372.         begin
  3373.           SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine);
  3374.           AveP := @Ave;
  3375.           for x := 0 to XCount - 1 do
  3376.           begin
  3377.             pfGetRGB(Temp.NowPixelFormat, PWord(SrcP)^, R, G, B);
  3378.             with AveP^ do
  3379.             begin
  3380.               Dec(cR, R);
  3381.               Dec(cG, G);
  3382.               Dec(cB, B);
  3383.               Dec(c);
  3384.             end;
  3385.             Inc(PWord(SrcP));
  3386.             Inc(AveP);
  3387.           end;
  3388.         end;
  3389.       24:
  3390.         begin
  3391.           SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine);
  3392.           AveP := @Ave;
  3393.           for x := 0 to XCount - 1 do
  3394.           begin
  3395.             with PBGR(SrcP)^, AveP^ do
  3396.             begin
  3397.               Dec(cR, R);
  3398.               Dec(cG, G);
  3399.               Dec(cB, B);
  3400.               Dec(c);
  3401.             end;
  3402.             Inc(PBGR(SrcP));
  3403.             Inc(AveP);
  3404.           end;
  3405.         end;
  3406.       32:
  3407.         begin
  3408.           SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine);
  3409.           AveP := @Ave;
  3410.           for x := 0 to XCount - 1 do
  3411.           begin
  3412.             pfGetRGB(Temp.NowPixelFormat, PDWORD(SrcP)^, R, G, B);
  3413.             with AveP^ do
  3414.             begin
  3415.               Dec(cR, R);
  3416.               Dec(cG, G);
  3417.               Dec(cB, B);
  3418.               Dec(c);
  3419.             end;
  3420.             Inc(PDWORD(SrcP));
  3421.             Inc(AveP);
  3422.           end;
  3423.         end;
  3424.     end;
  3425.   end;
  3426.  
  3427.   procedure Blur_Radius_Other;
  3428.   var
  3429.     FirstX, LastX, FirstX2, LastX2, FirstY, LastY: Integer;
  3430.     x, y, x2, y2, jx, jy: Integer;
  3431.     Ave: TAve;
  3432.     AveX: ^TArrayAve;
  3433.     DestP: Pointer;
  3434.     P: PByte;
  3435.   begin
  3436.     GetMem(AveX, Width * SizeOf(TAve));
  3437.     try
  3438.       FillChar(AveX^, Width * SizeOf(TAve), 0);
  3439.  
  3440.       FirstX2 := -1;
  3441.       LastX2 := -1;
  3442.       FirstY := -1;
  3443.       LastY := -1;
  3444.  
  3445.       x := 0;
  3446.       for x2 := -Radius to Radius do
  3447.       begin
  3448.         jx := x + x2;
  3449.         if (jx >= 0) and (jx < Width) then
  3450.         begin
  3451.           if FirstX2 = -1 then FirstX2 := jx;
  3452.           if LastX2 < jx then LastX2 := jx;
  3453.         end;
  3454.       end;
  3455.  
  3456.       y := 0;
  3457.       for y2 := -Radius to Radius do
  3458.       begin
  3459.         jy := y + y2;
  3460.         if (jy >= 0) and (jy < Height) then
  3461.         begin
  3462.           if FirstY = -1 then FirstY := jy;
  3463.           if LastY < jy then LastY := jy;
  3464.         end;
  3465.       end;
  3466.  
  3467.       for y := FirstY to LastY do
  3468.         AddAverage(y, Temp.Width, AveX^);
  3469.  
  3470.       for y := 0 to Height - 1 do
  3471.       begin
  3472.         DestP := ScanLine[y];
  3473.  
  3474.         {  The average is updated.  }
  3475.         if y - FirstY = Radius + 1 then
  3476.         begin
  3477.           DeleteAverage(FirstY, Temp.Width, AveX^);
  3478.           Inc(FirstY);
  3479.         end;
  3480.  
  3481.         if LastY - y = Radius - 1 then
  3482.         begin
  3483.           Inc(LastY); if LastY >= Height then LastY := Height - 1;
  3484.           AddAverage(LastY, Temp.Width, AveX^);
  3485.         end;
  3486.  
  3487.         {  The average is calculated again.  }
  3488.         FirstX := FirstX2;
  3489.         LastX := LastX2;
  3490.  
  3491.         FillChar(Ave, SizeOf(Ave), 0);
  3492.         for x := FirstX to LastX do
  3493.           with AveX[x] do
  3494.           begin
  3495.             Inc(Ave.cR, cR);
  3496.             Inc(Ave.cG, cG);
  3497.             Inc(Ave.cB, cB);
  3498.             Inc(Ave.c, c);
  3499.           end;
  3500.  
  3501.         for x := 0 to Width - 1 do
  3502.         begin
  3503.           {  The average is updated.  }
  3504.           if x - FirstX = Radius + 1 then
  3505.           begin
  3506.             with AveX[FirstX] do
  3507.             begin
  3508.               Dec(Ave.cR, cR);
  3509.               Dec(Ave.cG, cG);
  3510.               Dec(Ave.cB, cB);
  3511.               Dec(Ave.c, c);
  3512.             end;
  3513.             Inc(FirstX);
  3514.           end;
  3515.  
  3516.           if LastX - x = Radius - 1 then
  3517.           begin
  3518.             Inc(LastX); if LastX >= Width then LastX := Width - 1;
  3519.             with AveX[LastX] do
  3520.             begin
  3521.               Inc(Ave.cR, cR);
  3522.               Inc(Ave.cG, cG);
  3523.               Inc(Ave.cB, cB);
  3524.               Inc(Ave.c, c);
  3525.             end;
  3526.           end;
  3527.  
  3528.           {  The average is written.  }
  3529.           case BitCount of
  3530.             1:
  3531.               begin
  3532.                 P := @PArrayByte(DestP)[X shr 3];
  3533.                 with Ave do
  3534.                   P^ := (P^ and Mask1n[X and 7]) or (DWORD(Ord(((cR + cG + cB) div c) div 3 > 127)) shl Shift1[X and 7]);
  3535.               end;
  3536.             4:
  3537.               begin
  3538.                 P := @PArrayByte(DestP)[X shr 1];
  3539.                 with Ave do
  3540.                   P^ := (P^ and Mask4n[X and 1]) or (((((cR + cG + cB) div c) div 3) shr 4) shl Shift4[X and 1]);
  3541.               end;
  3542.             8:
  3543.               begin
  3544.                 with Ave do
  3545.                   PByte(DestP)^ := ((cR + cG + cB) div c) div 3;
  3546.                 Inc(PByte(DestP));
  3547.               end;
  3548.             16:
  3549.               begin
  3550.                 with Ave do
  3551.                   PWORD(DestP)^ := pfRGB(NowPixelFormat, cR div c, cG div c, cB div c);
  3552.                 Inc(PWORD(DestP));
  3553.               end;
  3554.             24:
  3555.               begin
  3556.                 with PBGR(DestP)^, Ave do
  3557.                 begin
  3558.                   R := cR div c;
  3559.                   G := cG div c;
  3560.                   B := cB div c;
  3561.                 end;
  3562.                 Inc(PBGR(DestP));
  3563.               end;
  3564.             32:
  3565.               begin
  3566.                 with Ave do
  3567.                   PDWORD(DestP)^ := pfRGB(NowPixelFormat, cR div c, cG div c, cB div c);
  3568.                 Inc(PDWORD(DestP));
  3569.               end;
  3570.           end;
  3571.         end;
  3572.  
  3573.         UpdateProgress(y);
  3574.       end;
  3575.     finally
  3576.       FreeMem(AveX);
  3577.     end;
  3578.   end;
  3579.  
  3580. var
  3581.   i, j: Integer;
  3582. begin
  3583.   if Empty or (Radius = 0) then Exit;
  3584.  
  3585.   Radius := Abs(Radius);
  3586.  
  3587.   StartProgress('Blur');
  3588.   try
  3589.     Temp := TDIB.Create;
  3590.     try
  3591.       Temp.Assign(Self);
  3592.       SetSize(Width, Height, ABitCount);
  3593.  
  3594.       if ABitCount <= 8 then
  3595.       begin
  3596.         FillChar(ColorTable, SizeOf(ColorTable), 0);
  3597.         for i := 0 to (1 shl ABitCount) - 1 do
  3598.         begin
  3599.           j := i * (1 shl (8 - ABitCount));
  3600.           j := j or (j shr ABitCount);
  3601.           ColorTable[i] := RGBQuad(j, j, j);
  3602.         end;
  3603.         UpdatePalette;
  3604.       end;
  3605.  
  3606.       Blur_Radius_Other;
  3607.     finally
  3608.       Temp.Free;
  3609.     end;
  3610.   finally
  3611.     EndProgress;
  3612.   end;
  3613. end;
  3614. (*
  3615. procedure TDIB.Negative;
  3616. var
  3617.   i, i2: Integer;
  3618.   P: Pointer;
  3619. begin
  3620.   if Empty then exit;
  3621.  
  3622.   if BitCount <= 8 then
  3623.   begin
  3624.     for i := 0 to 255 do
  3625.       with ColorTable[i] do
  3626.       begin
  3627.         rgbRed := 255 - rgbRed;
  3628.         rgbGreen := 255 - rgbGreen;
  3629.         rgbBlue := 255 - rgbBlue;
  3630.       end;
  3631.     UpdatePalette;
  3632.   end else
  3633.   begin
  3634.     P := PBits;
  3635.     i2 := Size;
  3636.     asm
  3637.       mov ecx,i2
  3638.       mov eax,P
  3639.       mov edx,ecx
  3640.  
  3641.     {  Unit of DWORD.  }
  3642.     @@qword_skip:
  3643.       shr ecx,2
  3644.       jz @@dword_skip
  3645.  
  3646.       dec ecx
  3647.     @@dword_loop:
  3648.       not dword ptr [eax+ecx*4]
  3649.       dec ecx
  3650.       jnl @@dword_loop
  3651.  
  3652.       mov ecx,edx
  3653.       shr ecx,2
  3654.       add eax,ecx*4
  3655.  
  3656.     {  Unit of Byte.  }
  3657.     @@dword_skip:
  3658.       mov ecx,edx
  3659.       and ecx,3
  3660.       jz @@byte_skip
  3661.  
  3662.       dec ecx
  3663.     @@loop_byte:
  3664.       not byte ptr [eax+ecx]
  3665.       dec ecx
  3666.       jnl @@loop_byte
  3667.  
  3668.     @@byte_skip:
  3669.     end;
  3670.   end;
  3671. end;
  3672. *)
  3673. procedure TDIB.Negative;
  3674. var
  3675.   i: Integer;
  3676.   P: Pointer;
  3677.   i2: Integer;
  3678. begin
  3679.   if Empty then Exit;
  3680.  
  3681.   if BitCount <= 8 then
  3682.   begin
  3683.     for i := 0 to 255 do
  3684.       with ColorTable[i] do
  3685.       begin
  3686.         rgbRed := 255 - rgbRed;
  3687.         rgbGreen := 255 - rgbGreen;
  3688.         rgbBlue := 255 - rgbBlue;
  3689.       end;
  3690.     UpdatePalette;
  3691.   end
  3692.   else
  3693.   begin
  3694.     P := PBits;
  3695.     i2 := Size;
  3696.     for i := 0 to i2-1 do
  3697.     begin
  3698.       PByteArray(P)^[i] := not PByteArray(P)^[i];
  3699.     end;
  3700.   end;
  3701. end;
  3702.  
  3703. procedure TDIB.Greyscale(ABitCount: Integer);
  3704. var
  3705.   YTblR, YTblG, YTblB: array[0..255] of Byte;
  3706.   i, j, x, y: Integer;
  3707.   c: DWORD;
  3708.   R, G, B: Byte;
  3709.   Temp: TDIB;
  3710.   DestP, SrcP: Pointer;
  3711.   P: PByte;
  3712. begin
  3713.   if Empty then Exit;
  3714.  
  3715.   Temp := TDIB.Create;
  3716.   try
  3717.     Temp.Assign(Self);
  3718.     SetSize(Width, Height, ABitCount);
  3719.  
  3720.     if ABitCount <= 8 then
  3721.     begin
  3722.       FillChar(ColorTable, SizeOf(ColorTable), 0);
  3723.       for i := 0 to (1 shl ABitCount) - 1 do
  3724.       begin
  3725.         j := i * (1 shl (8 - ABitCount));
  3726.         j := j or (j shr ABitCount);
  3727.         ColorTable[i] := RGBQuad(j, j, j);
  3728.       end;
  3729.       UpdatePalette;
  3730.     end;
  3731.  
  3732.     for i := 0 to 255 do
  3733.     begin
  3734.       YTblR[i] := Trunc(0.3588 * i);
  3735.       YTblG[i] := Trunc(0.4020 * i);
  3736.       YTblB[i] := Trunc(0.2392 * i);
  3737.     end;
  3738.  
  3739.     c := 0;
  3740.  
  3741.     StartProgress('Greyscale');
  3742.     try
  3743.       for y := 0 to Height - 1 do
  3744.       begin
  3745.         DestP := ScanLine[y];
  3746.         SrcP := Temp.ScanLine[y];
  3747.  
  3748.         for x := 0 to Width - 1 do
  3749.         begin
  3750.           case Temp.BitCount of
  3751.             1:
  3752.               begin
  3753.                 with Temp.ColorTable[(PArrayByte(SrcP)[X shr 3] and Mask1[X and 7]) shr Shift1[X and 7]] do
  3754.                   c := YTblR[rgbRed] + YTblG[rgbGreen] + YTblB[rgbBlue];
  3755.               end;
  3756.             4:
  3757.               begin
  3758.                 with Temp.ColorTable[(PArrayByte(SrcP)[X shr 1] and Mask4[X and 1]) shr Shift4[X and 1]] do
  3759.                   c := YTblR[rgbRed] + YTblG[rgbGreen] + YTblB[rgbBlue];
  3760.               end;
  3761.             8:
  3762.               begin
  3763.                 with Temp.ColorTable[PByte(SrcP)^] do
  3764.                   c := YTblR[rgbRed] + YTblG[rgbGreen] + YTblB[rgbBlue];
  3765.                 Inc(PByte(SrcP));
  3766.               end;
  3767.             16:
  3768.               begin
  3769.                 pfGetRGB(Temp.NowPixelFormat, PWord(SrcP)^, R, G, B);
  3770.                 c := YTblR[R] + YTblR[G] + YTblR[B];
  3771.                 Inc(PWord(SrcP));
  3772.               end;
  3773.             24:
  3774.               begin
  3775.                 with PBGR(SrcP)^ do
  3776.                   c := YTblR[R] + YTblG[G] + YTblB[B];
  3777.                 Inc(PBGR(SrcP));
  3778.               end;
  3779.             32:
  3780.               begin
  3781.                 pfGetRGB(Temp.NowPixelFormat, PDWORD(SrcP)^, R, G, B);
  3782.                 c := YTblR[R] + YTblR[G] + YTblR[B];
  3783.                 Inc(PDWORD(SrcP));
  3784.               end;
  3785.           end;
  3786.  
  3787.           case BitCount of
  3788.             1:
  3789.               begin
  3790.                 P := @PArrayByte(DestP)[X shr 3];
  3791.                 P^ := (P^ and Mask1n[X and 7]) or (DWORD(Ord(c > 127)) shl Shift1[X and 7]);
  3792.               end;
  3793.             4:
  3794.               begin
  3795.                 P := @PArrayByte(DestP)[X shr 1];
  3796.                 P^ := (P^ and Mask4n[X and 1]) or ((c shr 4) shl Shift4[X and 1]);
  3797.               end;
  3798.             8:
  3799.               begin
  3800.                 PByte(DestP)^ := c;
  3801.                 Inc(PByte(DestP));
  3802.               end;
  3803.             16:
  3804.               begin
  3805.                 PWord(DestP)^ := pfRGB(NowPixelFormat, c, c, c);
  3806.                 Inc(PWord(DestP));
  3807.               end;
  3808.             24:
  3809.               begin
  3810.                 with PBGR(DestP)^ do
  3811.                 begin
  3812.                   R := c;
  3813.                   G := c;
  3814.                   B := c;
  3815.                 end;
  3816.                 Inc(PBGR(DestP));
  3817.               end;
  3818.             32:
  3819.               begin
  3820.                 PDWORD(DestP)^ := pfRGB(NowPixelFormat, c, c, c);
  3821.                 Inc(PDWORD(DestP));
  3822.               end;
  3823.           end;
  3824.         end;
  3825.  
  3826.         UpdateProgress(y);
  3827.       end;
  3828.     finally
  3829.       EndProgress;
  3830.     end;
  3831.   finally
  3832.     Temp.Free;
  3833.   end;
  3834. end;
  3835.  
  3836. //--------------------------------------------------------------------------------------------------
  3837. // Version : 0.1 - 26/06/2000                                                                     //
  3838. // Version : 0.2 - 04/07/2000                                                                     //
  3839. //   At someone's request, i have added 3 news effects :                                          //
  3840. //    1 - Rotate                                                                                  //
  3841. //    2 - SplitBlur                                                                               //
  3842. //    3 - GaussianBlur                                                                            //
  3843. //--------------------------------------------------------------------------------------------------
  3844. //                           -   NEW SPECIAL EFFECT   -  (English)                                //
  3845. //--------------------------------------------------------------------------------------------------
  3846. //   At the start, my idea was to create a component derived from TCustomDXDraw. Unfortunately,   //
  3847. // it's impossible to run a graphic component (derived from TCustomDXDraw) in a conception's      //
  3848. // mode (i don't success, but perhaps, somebody know how doing ! In that case, please help me !!!)//
  3849. // Then, i'm used the DIB's unit for my work, but this unit is poor in special effect. Knowing a  //
  3850. // library with more effect, i'm undertaked to import this library in DIB's unit. You can see the //
  3851. // FastLib library at :                                                                           //
  3852. //                                                                                                //
  3853. //      ->      Gordon Alex Cowie <gfody@jps.net> www.jps.net/gfody                               //
  3854. //                                                                                                //
  3855. //   It was very difficult, because implementation's graphic was very different that DIB's unit.  //
  3856. // Sometimes, i'm deserted the possibility of original effect, particularly in conversion of DIB  //
  3857. // whith 256, 16 and 2 colors. If someone can implement this fonctionnality, thanks to tell me    //
  3858. // how this miracle is possible !!!                                                               //
  3859. // All these procedures are translated and adapted by :                                           //
  3860. //                                                                                                //
  3861. //      ->      Mickey (Michel HIBON) <mhibon@ifrance.com> http://mickey.tsx.org                  //
  3862. //                                                                                                //
  3863. // IMPORTANT : These procedures don't modify the DIB's unit structure                             //
  3864. // Nota Bene : I don't implement these type of graphics (32 and 16 bit per pixels),               //
  3865. //             for one reason : I haven't bitmaps of this type !!!                                //
  3866. //--------------------------------------------------------------------------------------------------
  3867. //--------------------------------------------------------------------------------------------------
  3868. //                        -   NOUVEAUX EFFETS SPECIAUX   -  (Français)                            //
  3869. //--------------------------------------------------------------------------------------------------
  3870. //   Au commencement, mon idée était de dériver un composant de TCustomDXDraw. Malheureusement,   //
  3871. // c'est impossible de faire fonctionner un composant graphique (derivé de TCustomDXDraw) en mode //
  3872. // conception (je n'y suis pas parvenu, mais peut-être, que quelqu'un sait comment faire ! Dans   //
  3873. // ce cas, vous seriez aimable de m'aider !!!)                                                    //
  3874. // Alors, j'ai utilisé l'unité DIB pour mon travail,mais celle-ci est pauvre en effet spéciaux.   //
  3875. // Connaissant une librairie avec beaucoup plus d'effets spéciaux, j'ai entrepris d'importer      //
  3876. // cette librairie dans l'unité DIB. Vous pouvez voir la librairie FastLib à :                    //
  3877. //                                                                                                //
  3878. //      ->      Gordon Alex Cowie <gfody@jps.net> www.jps.net/gfody                               //
  3879. //                                                                                                //
  3880. //   C'était très difficile car l'implémentation graphique est très différente de l'unité DIB.    //
  3881. // Parfois, j'ai abandonné les possibilités de l'effet original, particulièrement dans la         //
  3882. // conversion des DIB avec 256, 16 et 2 couleurs. Si quelqu'un arrive à implémenter ces           //
  3883. // fonctionnalités, merci de me dire comment ce miracle est possible !!!                          //
  3884. // Toutes ces procédures ont été traduites et adaptées par:                                       //
  3885. //                                                                                                //
  3886. //      ->      Mickey (Michel HIBON) <mhibon@ifrance.com> http://mickey.tsx.org                  //
  3887. //                                                                                                //
  3888. // IMPORTANT : Ces procédures ne modifient pas la structure de l'unité DIB                        //
  3889. // Nota Bene : Je n'ai pas implémenté ces types de graphiques (32 et 16 bit par pixels),          //
  3890. //             pour une raison : je n'ai pas de bitmap de ce type !!!                             //
  3891. //--------------------------------------------------------------------------------------------------
  3892.  
  3893. function TDIB.IntToColor(i: Integer): TBGR;
  3894. begin
  3895.   Result.b := i shr 16;
  3896.   Result.g := i shr 8;
  3897.   Result.r := i;
  3898. end;
  3899.  
  3900. function TDIB.Interval(iMin, iMax, iValue: Integer; iMark: Boolean): Integer;
  3901. begin
  3902.   if iMark then
  3903.   begin
  3904.     if iValue < iMin then
  3905.       Result := iMin
  3906.     else
  3907.       if iValue > iMax then
  3908.         Result := iMax
  3909.       else
  3910.         Result := iValue;
  3911.   end
  3912.   else
  3913.   begin
  3914.     if iValue < iMin then
  3915.       Result := iMin
  3916.     else
  3917.       if iValue > iMax then
  3918.         Result := iMin
  3919.       else
  3920.         Result := iValue;
  3921.   end;
  3922. end;
  3923.  
  3924. procedure TDIB.Contrast(Amount: Integer);
  3925. var
  3926.   x, y: Integer;
  3927.   Table1: array[0..255] of Byte;
  3928.   i: Byte;
  3929.   S, D: pointer;
  3930.   Temp1: TDIB;
  3931.   color: DWORD;
  3932.   P: PByte;
  3933.   R, G, B: Byte;
  3934. begin
  3935.   D := nil;
  3936.   S := nil;
  3937.   Temp1 := nil;
  3938.   for i := 0 to 126 do
  3939.   begin
  3940.     y := (Abs(128 - i) * Amount) div 256;
  3941.     Table1[i] := IntToByte(i - y);
  3942.   end;
  3943.   for i := 127 to 255 do
  3944.   begin
  3945.     y := (Abs(128 - i) * Amount) div 256;
  3946.     Table1[i] := IntToByte(i + y);
  3947.   end;
  3948.   case BitCount of
  3949.     32: Exit; // I haven't bitmap of this type ! Sorry
  3950.     24: ; // nothing to do
  3951.     16: ; // I have an artificial bitmap for this type ! i don't sure that it works
  3952.     8, 4:
  3953.       begin
  3954.         Temp1 := TDIB.Create;
  3955.         Temp1.Assign(self);
  3956.         Temp1.SetSize(Width, Height, BitCount);
  3957.         for i := 0 to 255 do
  3958.         begin
  3959.           with ColorTable[i] do
  3960.           begin
  3961.             rgbRed := IntToByte(Table1[rgbRed]);
  3962.             rgbGreen := IntToByte(Table1[rgbGreen]);
  3963.             rgbBlue := IntToByte(Table1[rgbBlue]);
  3964.           end;
  3965.         end;
  3966.         UpdatePalette;
  3967.       end;
  3968.   else
  3969.     // if the number of pixel is equal to 1 then exit of procedure
  3970.     Exit;
  3971.   end;
  3972.   for y := 0 to Pred(Height) do
  3973.   begin
  3974.     case BitCount of
  3975.       24, 16: D := ScanLine[y];
  3976.       8, 4:
  3977.         begin
  3978.           D := Temp1.ScanLine[y];
  3979.           S := Temp1.ScanLine[y];
  3980.         end;
  3981.     else
  3982.     end;
  3983.     for x := 0 to Pred(Width) do
  3984.     begin
  3985.       case BitCount of
  3986.         32: ;
  3987.         24:
  3988.           begin
  3989.             PBGR(D)^.B := Table1[PBGR(D)^.B];
  3990.             PBGR(D)^.G := Table1[PBGR(D)^.G];
  3991.             PBGR(D)^.R := Table1[PBGR(D)^.R];
  3992.             Inc(PBGR(D));
  3993.           end;
  3994.         16:
  3995.           begin
  3996.             pfGetRGB(NowPixelFormat, PWord(D)^, R, G, B);
  3997.             PWord(D)^ := Table1[R] + Table1[G] + Table1[B];
  3998.             Inc(PWord(D));
  3999.           end;
  4000.         8:
  4001.           begin
  4002.             with Temp1.ColorTable[PByte(S)^] do
  4003.               color := rgbRed + rgbGreen + rgbBlue;
  4004.             Inc(PByte(S));
  4005.             PByte(D)^ := color;
  4006.             Inc(PByte(D));
  4007.           end;
  4008.         4:
  4009.           begin
  4010.             with Temp1.ColorTable[PByte(S)^] do
  4011.               color := rgbRed + rgbGreen + rgbBlue;
  4012.             Inc(PByte(S));
  4013.             P := @PArrayByte(D)[X shr 1];
  4014.             P^ := (P^ and Mask4n[X and 1]) or (color shl Shift4[X and 1]);
  4015.           end;
  4016.       else
  4017.       end;
  4018.     end;
  4019.   end;
  4020.   case BitCount of
  4021.     8, 4: Temp1.Free;
  4022.   else
  4023.   end;
  4024. end;
  4025.  
  4026. procedure TDIB.Saturation(Amount: Integer);
  4027. var
  4028.   Grays: array[0..767] of Integer;
  4029.   Alpha: array[0..255] of Word;
  4030.   Gray, x, y: Integer;
  4031.   i: Byte;
  4032.   S, D: pointer;
  4033.   Temp1: TDIB;
  4034.   color: DWORD;
  4035.   P: PByte;
  4036.   R, G, B: Byte;
  4037. begin
  4038.   D := nil;
  4039.   S := nil;
  4040.   Temp1 := nil;
  4041.   for i := 0 to 255 do
  4042.     Alpha[i] := (i * Amount) shr 8;
  4043.   x := 0;
  4044.   for i := 0 to 255 do
  4045.   begin
  4046.     Gray := i - Alpha[i];
  4047.     Grays[x] := Gray;
  4048.     Inc(x);
  4049.     Grays[x] := Gray;
  4050.     Inc(x);
  4051.     Grays[x] := Gray;
  4052.     Inc(x);
  4053.   end;
  4054.   case BitCount of
  4055.     32: Exit; // I haven't bitmap of this type ! Sorry
  4056.     24: ; // nothing to do
  4057.     16: ; // I have an artificial bitmap for this type ! i don't sure that it works
  4058.     8, 4:
  4059.       begin
  4060.         Temp1 := TDIB.Create;
  4061.         Temp1.Assign(self);
  4062.         Temp1.SetSize(Width, Height, BitCount);
  4063.         for i := 0 to 255 do
  4064.         begin
  4065.           with ColorTable[i] do
  4066.           begin
  4067.             Gray := Grays[rgbRed + rgbGreen + rgbBlue];
  4068.             rgbRed := IntToByte(Gray + Alpha[rgbRed]);
  4069.             rgbGreen := IntToByte(Gray + Alpha[rgbGreen]);
  4070.             rgbBlue := IntToByte(Gray + Alpha[rgbBlue]);
  4071.           end;
  4072.         end;
  4073.         UpdatePalette;
  4074.       end;
  4075.   else
  4076.     // if the number of pixel is equal to 1 then exit of procedure
  4077.     Exit;
  4078.   end;
  4079.   for y := 0 to Pred(Height) do
  4080.   begin
  4081.     case BitCount of
  4082.       24, 16: D := ScanLine[y];
  4083.       8, 4:
  4084.         begin
  4085.           D := Temp1.ScanLine[y];
  4086.           S := Temp1.ScanLine[y];
  4087.         end;
  4088.     else
  4089.     end;
  4090.     for x := 0 to Pred(Width) do
  4091.     begin
  4092.       case BitCount of
  4093.         32: ;
  4094.         24:
  4095.           begin
  4096.             Gray := Grays[PBGR(D)^.R + PBGR(D)^.G + PBGR(D)^.B];
  4097.             PBGR(D)^.B := IntToByte(Gray + Alpha[PBGR(D)^.B]);
  4098.             PBGR(D)^.G := IntToByte(Gray + Alpha[PBGR(D)^.G]);
  4099.             PBGR(D)^.R := IntToByte(Gray + Alpha[PBGR(D)^.R]);
  4100.             Inc(PBGR(D));
  4101.           end;
  4102.         16:
  4103.           begin
  4104.             pfGetRGB(NowPixelFormat, PWord(D)^, R, G, B);
  4105.             PWord(D)^ := IntToByte(Gray + Alpha[B]) + IntToByte(Gray + Alpha[G]) +
  4106.               IntToByte(Gray + Alpha[R]);
  4107.             Inc(PWord(D));
  4108.           end;
  4109.         8:
  4110.           begin
  4111.             with Temp1.ColorTable[PByte(S)^] do
  4112.               color := rgbRed + rgbGreen + rgbBlue;
  4113.             Inc(PByte(S));
  4114.             PByte(D)^ := color;
  4115.             Inc(PByte(D));
  4116.           end;
  4117.         4:
  4118.           begin
  4119.             with Temp1.ColorTable[PByte(S)^] do
  4120.               color := rgbRed + rgbGreen + rgbBlue;
  4121.             Inc(PByte(S));
  4122.             P := @PArrayByte(D)[X shr 1];
  4123.             P^ := (P^ and Mask4n[X and 1]) or (color shl Shift4[X and 1]);
  4124.           end;
  4125.       else
  4126.       end;
  4127.     end;
  4128.   end;
  4129.   case BitCount of
  4130.     8, 4: Temp1.Free;
  4131.   else
  4132.   end;
  4133. end;
  4134.  
  4135. procedure TDIB.Lightness(Amount: Integer);
  4136. var
  4137.   x, y: Integer;
  4138.   Table1: array[0..255] of Byte;
  4139.   i: Byte;
  4140.   S, D: pointer;
  4141.   Temp1: TDIB;
  4142.   color: DWORD;
  4143.   P: PByte;
  4144.   R, G, B: Byte;
  4145. begin
  4146.   D := nil;
  4147.   S := nil;
  4148.   Temp1 := nil;
  4149.   if Amount < 0 then
  4150.   begin
  4151.     Amount := -Amount;
  4152.     for i := 0 to 255 do
  4153.       Table1[i] := IntToByte(i - ((Amount * i) shr 8));
  4154.   end
  4155.   else
  4156.     for i := 0 to 255 do
  4157.       Table1[i] := IntToByte(i + ((Amount * (i xor 255)) shr 8));
  4158.   case BitCount of
  4159.     32: Exit; // I haven't bitmap of this type ! Sorry
  4160.     24: ; // nothing to do
  4161.     16: ; // I have an artificial bitmap for this type ! i don't sure that it works
  4162.     8, 4:
  4163.       begin
  4164.         Temp1 := TDIB.Create;
  4165.         Temp1.Assign(self);
  4166.         Temp1.SetSize(Width, Height, BitCount);
  4167.         for i := 0 to 255 do
  4168.         begin
  4169.           with ColorTable[i] do
  4170.           begin
  4171.             rgbRed := IntToByte(Table1[rgbRed]);
  4172.             rgbGreen := IntToByte(Table1[rgbGreen]);
  4173.             rgbBlue := IntToByte(Table1[rgbBlue]);
  4174.           end;
  4175.         end;
  4176.         UpdatePalette;
  4177.       end;
  4178.   else
  4179.     // if the number of pixel is equal to 1 then exit of procedure
  4180.     Exit;
  4181.   end;
  4182.   for y := 0 to Pred(Height) do
  4183.   begin
  4184.     case BitCount of
  4185.       24, 16: D := ScanLine[y];
  4186.       8, 4:
  4187.         begin
  4188.           D := Temp1.ScanLine[y];
  4189.           S := Temp1.ScanLine[y];
  4190.         end;
  4191.     else
  4192.     end;
  4193.     for x := 0 to Pred(Width) do
  4194.     begin
  4195.       case BitCount of
  4196.         32: ;
  4197.         24:
  4198.           begin
  4199.             PBGR(D)^.B := Table1[PBGR(D)^.B];
  4200.             PBGR(D)^.G := Table1[PBGR(D)^.G];
  4201.             PBGR(D)^.R := Table1[PBGR(D)^.R];
  4202.             Inc(PBGR(D));
  4203.           end;
  4204.         16:
  4205.           begin
  4206.             pfGetRGB(NowPixelFormat, PWord(D)^, R, G, B);
  4207.             PWord(D)^ := Table1[R] + Table1[G] + Table1[B];
  4208.             Inc(PWord(D));
  4209.           end;
  4210.         8:
  4211.           begin
  4212.             with Temp1.ColorTable[PByte(S)^] do
  4213.               color := rgbRed + rgbGreen + rgbBlue;
  4214.             Inc(PByte(S));
  4215.             PByte(D)^ := color;
  4216.             Inc(PByte(D));
  4217.           end;
  4218.         4:
  4219.           begin
  4220.             with Temp1.ColorTable[PByte(S)^] do
  4221.               color := rgbRed + rgbGreen + rgbBlue;
  4222.             Inc(PByte(S));
  4223.             P := @PArrayByte(D)[X shr 1];
  4224.             P^ := (P^ and Mask4n[X and 1]) or (color shl Shift4[X and 1]);
  4225.           end;
  4226.       else
  4227.       end;
  4228.     end;
  4229.   end;
  4230.   case BitCount of
  4231.     8, 4: Temp1.Free;
  4232.   else
  4233.   end;
  4234. end;
  4235.  
  4236. procedure TDIB.AddRGB(aR, aG, aB: Byte);
  4237. var
  4238.   Table: array[0..255] of TBGR;
  4239.   x, y: Integer;
  4240.   i: Byte;
  4241.   D: pointer;
  4242.   P: PByte;
  4243.   color: DWORD;
  4244.   Temp1: TDIB;
  4245.   R, G, B: Byte;
  4246. begin
  4247.   color := 0;
  4248.   D := nil;
  4249.   Temp1 := nil;
  4250.   case BitCount of
  4251.     32: Exit; // I haven't bitmap of this type ! Sorry
  4252.     24, 16:
  4253.       begin
  4254.         for i := 0 to 255 do
  4255.         begin
  4256.           Table[i].b := IntToByte(i + aB);
  4257.           Table[i].g := IntToByte(i + aG);
  4258.           Table[i].r := IntToByte(i + aR);
  4259.         end;
  4260.       end;
  4261.     8, 4:
  4262.       begin
  4263.         Temp1 := TDIB.Create;
  4264.         Temp1.Assign(self);
  4265.         Temp1.SetSize(Width, Height, BitCount);
  4266.         for i := 0 to 255 do
  4267.         begin
  4268.           with ColorTable[i] do
  4269.           begin
  4270.             rgbRed := IntToByte(rgbRed + aR);
  4271.             rgbGreen := IntToByte(rgbGreen + aG);
  4272.             rgbBlue := IntToByte(rgbBlue + aB);
  4273.           end;
  4274.         end;
  4275.         UpdatePalette;
  4276.       end;
  4277.   else
  4278.     // if the number of pixel is equal to 1 then exit of procedure
  4279.     Exit;
  4280.   end;
  4281.   for y := 0 to Pred(Height) do
  4282.   begin
  4283.     case BitCount of
  4284.       24, 16: D := ScanLine[y];
  4285.       8, 4:
  4286.         begin
  4287.           D := Temp1.ScanLine[y];
  4288.         end;
  4289.     else
  4290.     end;
  4291.     for x := 0 to Pred(Width) do
  4292.     begin
  4293.       case BitCount of
  4294.         32: ; // I haven't bitmap of this type ! Sorry
  4295.         24:
  4296.           begin
  4297.             PBGR(D)^.B := Table[PBGR(D)^.B].b;
  4298.             PBGR(D)^.G := Table[PBGR(D)^.G].g;
  4299.             PBGR(D)^.R := Table[PBGR(D)^.R].r;
  4300.             Inc(PBGR(D));
  4301.           end;
  4302.         16:
  4303.           begin
  4304.             pfGetRGB(NowPixelFormat, PWord(D)^, R, G, B);
  4305.             PWord(D)^ := Table[R].r + Table[G].g + Table[B].b;
  4306.             Inc(PWord(D));
  4307.           end;
  4308.         8:
  4309.           begin
  4310.             Inc(PByte(D));
  4311.           end;
  4312.         4:
  4313.           begin
  4314.             P := @PArrayByte(D)[X shr 1];
  4315.             P^ := (P^ and Mask4n[X and 1]) or (color shl Shift4[X and 1]);
  4316.           end;
  4317.       else
  4318.       end;
  4319.     end;
  4320.   end;
  4321.   case BitCount of
  4322.     8, 4: Temp1.Free;
  4323.   else
  4324.   end;
  4325. end;
  4326.  
  4327. function TDIB.Filter(Dest: TDIB; Filter: TFilter): Boolean;
  4328. var
  4329.   Sum, r, g, b, x, y: Integer;
  4330.   a, i, j: byte;
  4331.   tmp: TBGR;
  4332.   Col: PBGR;
  4333.   D: Pointer;
  4334. begin
  4335.   Result := True;
  4336.   Sum := Filter[0, 0] + Filter[1, 0] + Filter[2, 0] +
  4337.     Filter[0, 1] + Filter[1, 1] + Filter[2, 1] +
  4338.     Filter[0, 2] + Filter[1, 2] + Filter[2, 2];
  4339.   if Sum = 0 then
  4340.     Sum := 1;
  4341.   Col := PBits;
  4342.   for y := 0 to Pred(Height) do
  4343.   begin
  4344.     D := Dest.ScanLine[y];
  4345.     for x := 0 to Pred(Width) do
  4346.     begin
  4347.       r := 0; g := 0; b := 0;
  4348.       case BitCount of
  4349.         32, 16, 4, 1:
  4350.           begin
  4351.             Result := False;
  4352.             Exit;
  4353.           end;
  4354.         24:
  4355.           begin
  4356.             for i := 0 to 2 do
  4357.             begin
  4358.               for j := 0 to 2 do
  4359.               begin
  4360.                 Tmp := IntToColor(Pixels[Interval(0, Pred(Width), x + Pred(i), True),
  4361.                   Interval(0, Pred(Height), y + Pred(j), True)]);
  4362.                 Inc(b, Filter[i, j] * Tmp.b);
  4363.                 Inc(g, Filter[i, j] * Tmp.g);
  4364.                 Inc(r, Filter[i, j] * Tmp.r);
  4365.               end;
  4366.             end;
  4367.             Col.b := IntToByte(b div Sum);
  4368.             Col.g := IntToByte(g div Sum);
  4369.             Col.r := IntToByte(r div Sum);
  4370.             Dest.Pixels[x, y] := rgb(Col.r, Col.g, Col.b);
  4371.           end;
  4372.         8:
  4373.           begin
  4374.             for i := 0 to 2 do
  4375.             begin
  4376.               for j := 0 to 2 do
  4377.               begin
  4378.                 a := (Pixels[Interval(0, Pred(Width), x + Pred(i), True),
  4379.                   Interval(0, Pred(Height), y + Pred(j), True)]);
  4380.                 tmp.r := ColorTable[a].rgbRed;
  4381.                 tmp.g := ColorTable[a].rgbGreen;
  4382.                 tmp.b := ColorTable[a].rgbBlue;
  4383.                 Inc(b, Filter[i, j] * Tmp.b);
  4384.                 Inc(g, Filter[i, j] * Tmp.g);
  4385.                 Inc(r, Filter[i, j] * Tmp.r);
  4386.               end;
  4387.             end;
  4388.             Col.b := IntToByte(b div Sum);
  4389.             Col.g := IntToByte(g div Sum);
  4390.             Col.r := IntToByte(r div Sum);
  4391.             PByte(D)^ := rgb(Col.r, Col.g, Col.b);
  4392.             Inc(PByte(D));
  4393.           end;
  4394.       end;
  4395.     end;
  4396.   end;
  4397. end;
  4398.  
  4399. procedure TDIB.Spray(Amount: Integer);
  4400. var
  4401.   value, x, y: Integer;
  4402.   D: Pointer;
  4403.   color: DWORD;
  4404.   P: PByte;
  4405. begin
  4406.   for y := Pred(Height) downto 0 do
  4407.   begin
  4408.     D := ScanLine[y];
  4409.     for x := 0 to Pred(Width) do
  4410.     begin
  4411.       value := Random(Amount);
  4412.       color := Pixels[Interval(0, Pred(Width), x + (value - Random(value * 2)), True),
  4413.         Interval(0, Pred(Height), y + (value - Random(value * 2)), True)];
  4414.       case BitCount of
  4415.         32:
  4416.           begin
  4417.             PDWord(D)^ := color;
  4418.             Inc(PDWord(D));
  4419.           end;
  4420.         24:
  4421.           begin
  4422.             PBGR(D)^ := IntToColor(color);
  4423.             Inc(PBGR(D));
  4424.           end;
  4425.         16:
  4426.           begin
  4427.             PWord(D)^ := color;
  4428.             Inc(PWord(D));
  4429.           end;
  4430.         8:
  4431.           begin
  4432.             PByte(D)^ := color;
  4433.             Inc(PByte(D));
  4434.           end;
  4435.         4:
  4436.           begin
  4437.             P := @PArrayByte(D)[X shr 1];
  4438.             P^ := (P^ and Mask4n[X and 1]) or (color shl Shift4[X and 1]);
  4439.           end;
  4440.         1:
  4441.           begin
  4442.             P := @PArrayByte(D)[X shr 3];
  4443.             P^ := (P^ and Mask1n[X and 7]) or (color shl Shift1[X and 7]);
  4444.           end;
  4445.       else
  4446.       end;
  4447.     end;
  4448.   end;
  4449. end;
  4450.  
  4451. procedure TDIB.Sharpen(Amount: Integer);
  4452. var
  4453.   Lin0, Lin1, Lin2: PLines;
  4454.   pc: PBGR;
  4455.   cx, x, y: Integer;
  4456.   Buf: array[0..8] of TBGR;
  4457.   D: pointer;
  4458.   c: DWORD;
  4459.   i: byte;
  4460.   P1: PByte;
  4461.   Temp1: TDIB;
  4462.  
  4463. begin
  4464.   D := nil;
  4465.   GetMem(pc, SizeOf(TBGR));
  4466.   c := 0;
  4467.   Temp1 := nil;
  4468.   case Bitcount of
  4469.     32, 16, 1: Exit;
  4470.     24:
  4471.       begin
  4472.         Temp1 := TDIB.Create;
  4473.         Temp1.Assign(self);
  4474.         Temp1.SetSize(Width, Height, bitCount);
  4475.       end;
  4476.     8:
  4477.       begin
  4478.         Temp1 := TDIB.Create;
  4479.         Temp1.Assign(self);
  4480.         Temp1.SetSize(Width, Height, bitCount);
  4481.         for i := 0 to 255 do
  4482.         begin
  4483.           with Temp1.ColorTable[i] do
  4484.           begin
  4485.             Buf[0].B := ColorTable[i - Amount].rgbBlue;
  4486.             Buf[0].G := ColorTable[i - Amount].rgbGreen;
  4487.             Buf[0].R := ColorTable[i - Amount].rgbRed;
  4488.             Buf[1].B := ColorTable[i].rgbBlue;
  4489.             Buf[1].G := ColorTable[i].rgbGreen;
  4490.             Buf[1].R := ColorTable[i].rgbRed;
  4491.             Buf[2].B := ColorTable[i + Amount].rgbBlue;
  4492.             Buf[2].G := ColorTable[i + Amount].rgbGreen;
  4493.             Buf[2].R := ColorTable[i + Amount].rgbRed;
  4494.             Buf[3].B := ColorTable[i - Amount].rgbBlue;
  4495.             Buf[3].G := ColorTable[i - Amount].rgbGreen;
  4496.             Buf[3].R := ColorTable[i - Amount].rgbRed;
  4497.             Buf[4].B := ColorTable[i].rgbBlue;
  4498.             Buf[4].G := ColorTable[i].rgbGreen;
  4499.             Buf[4].R := ColorTable[i].rgbRed;
  4500.             Buf[5].B := ColorTable[i + Amount].rgbBlue;
  4501.             Buf[5].G := ColorTable[i + Amount].rgbGreen;
  4502.             Buf[5].R := ColorTable[i + Amount].rgbRed;
  4503.             Buf[6].B := ColorTable[i - Amount].rgbBlue;
  4504.             Buf[6].G := ColorTable[i - Amount].rgbGreen;
  4505.             Buf[6].R := ColorTable[i - Amount].rgbRed;
  4506.             Buf[7].B := ColorTable[i].rgbBlue;
  4507.             Buf[7].G := ColorTable[i].rgbGreen;
  4508.             Buf[7].R := ColorTable[i].rgbRed;
  4509.             Buf[8].B := ColorTable[i + Amount].rgbBlue;
  4510.             Buf[8].G := ColorTable[i + Amount].rgbGreen;
  4511.             Buf[8].R := ColorTable[i + Amount].rgbRed;
  4512.             Temp1.colorTable[i].rgbBlue := IntToByte((256 * Buf[4].b - (Buf[0].b + Buf[1].b + Buf[2].b + Buf[3].b +
  4513.               Buf[5].b + Buf[6].b + Buf[7].b + Buf[8].b) * 16) div 128);
  4514.             Temp1.colorTable[i].rgbGreen := IntToByte((256 * Buf[4].g - (Buf[0].g + Buf[1].g + Buf[2].g + Buf[3].g +
  4515.               Buf[5].g + Buf[6].g + Buf[7].g + Buf[8].g) * 16) div 128);
  4516.             Temp1.colorTable[i].rgbRed := IntToByte((256 * Buf[4].r - (Buf[0].r + Buf[1].r + Buf[2].r + Buf[3].r +
  4517.               Buf[5].r + Buf[6].r + Buf[7].r + Buf[8].r) * 16) div 128);
  4518.  
  4519.           end;
  4520.         end;
  4521.         Temp1.UpdatePalette;
  4522.       end;
  4523.     4:
  4524.       begin
  4525.         Temp1 := TDIB.Create;
  4526.         Temp1.Assign(self);
  4527.         Temp1.SetSize(Width, Height, bitCount);
  4528.         for i := 0 to 255 do
  4529.         begin
  4530.           with Temp1.ColorTable[i] do
  4531.           begin
  4532.             Buf[0].B := ColorTable[i - Amount].rgbBlue;
  4533.             Buf[0].G := ColorTable[i - Amount].rgbGreen;
  4534.             Buf[0].R := ColorTable[i - Amount].rgbRed;
  4535.             Buf[1].B := ColorTable[i].rgbBlue;
  4536.             Buf[1].G := ColorTable[i].rgbGreen;
  4537.             Buf[1].R := ColorTable[i].rgbRed;
  4538.             Buf[2].B := ColorTable[i + Amount].rgbBlue;
  4539.             Buf[2].G := ColorTable[i + Amount].rgbGreen;
  4540.             Buf[2].R := ColorTable[i + Amount].rgbRed;
  4541.             Buf[3].B := ColorTable[i - Amount].rgbBlue;
  4542.             Buf[3].G := ColorTable[i - Amount].rgbGreen;
  4543.             Buf[3].R := ColorTable[i - Amount].rgbRed;
  4544.             Buf[4].B := ColorTable[i].rgbBlue;
  4545.             Buf[4].G := ColorTable[i].rgbGreen;
  4546.             Buf[4].R := ColorTable[i].rgbRed;
  4547.             Buf[5].B := ColorTable[i + Amount].rgbBlue;
  4548.             Buf[5].G := ColorTable[i + Amount].rgbGreen;
  4549.             Buf[5].R := ColorTable[i + Amount].rgbRed;
  4550.             Buf[6].B := ColorTable[i - Amount].rgbBlue;
  4551.             Buf[6].G := ColorTable[i - Amount].rgbGreen;
  4552.             Buf[6].R := ColorTable[i - Amount].rgbRed;
  4553.             Buf[7].B := ColorTable[i].rgbBlue;
  4554.             Buf[7].G := ColorTable[i].rgbGreen;
  4555.             Buf[7].R := ColorTable[i].rgbRed;
  4556.             Buf[8].B := ColorTable[i + Amount].rgbBlue;
  4557.             Buf[8].G := ColorTable[i + Amount].rgbGreen;
  4558.             Buf[8].R := ColorTable[i + Amount].rgbRed;
  4559.             colorTable[i].rgbBlue := IntToByte((256 * Buf[4].b - (Buf[0].b + Buf[1].b + Buf[2].b + Buf[3].b +
  4560.               Buf[5].b + Buf[6].b + Buf[7].b + Buf[8].b) * 16) div 128);
  4561.             colorTable[i].rgbGreen := IntToByte((256 * Buf[4].g - (Buf[0].g + Buf[1].g + Buf[2].g + Buf[3].g +
  4562.               Buf[5].g + Buf[6].g + Buf[7].g + Buf[8].g) * 16) div 128);
  4563.             colorTable[i].rgbRed := IntToByte((256 * Buf[4].r - (Buf[0].r + Buf[1].r + Buf[2].r + Buf[3].r +
  4564.               Buf[5].r + Buf[6].r + Buf[7].r + Buf[8].r) * 16) div 128);
  4565.           end;
  4566.         end;
  4567.         UpdatePalette;
  4568.       end;
  4569.   end;
  4570.   for y := 0 to Pred(Height) do
  4571.   begin
  4572.     Lin0 := ScanLine[Interval(0, Pred(Height), y - Amount, True)];
  4573.     Lin1 := ScanLine[y];
  4574.     Lin2 := ScanLine[Interval(0, Pred(Height), y + Amount, True)];
  4575.     case Bitcount of
  4576.       24, 8, 4: D := Temp1.ScanLine[y];
  4577.     end;
  4578.     for x := 0 to Pred(Width) do
  4579.     begin
  4580.       case BitCount of
  4581.         24:
  4582.           begin
  4583.             cx := Interval(0, Pred(Width), x - Amount, True);
  4584.             Buf[0] := Lin0[cx];
  4585.             Buf[1] := Lin1[cx];
  4586.             Buf[2] := Lin2[cx];
  4587.             Buf[3] := Lin0[x];
  4588.             Buf[4] := Lin1[x];
  4589.             Buf[5] := Lin2[x];
  4590.             cx := Interval(0, Pred(Width), x + Amount, true);
  4591.             Buf[6] := Lin0[cx];
  4592.             Buf[7] := Lin1[cx];
  4593.             Buf[8] := Lin0[cx];
  4594.             pc.b := IntToByte((256 * Buf[4].b - (Buf[0].b + Buf[1].b + Buf[2].b + Buf[3].b +
  4595.               Buf[5].b + Buf[6].b + Buf[7].b + Buf[8].b) * 16) div 128);
  4596.             pc.g := IntToByte((256 * Buf[4].g - (Buf[0].g + Buf[1].g + Buf[2].g + Buf[3].g +
  4597.               Buf[5].g + Buf[6].g + Buf[7].g + Buf[8].g) * 16) div 128);
  4598.             pc.r := IntToByte((256 * Buf[4].r - (Buf[0].r + Buf[1].r + Buf[2].r + Buf[3].r +
  4599.               Buf[5].r + Buf[6].r + Buf[7].r + Buf[8].r) * 16) div 128);
  4600.             PBGR(D)^.B := pc.b;
  4601.             PBGR(D)^.G := pc.g;
  4602.             PBGR(D)^.R := pc.r;
  4603.             Inc(PBGR(D));
  4604.           end;
  4605.         8:
  4606.           begin
  4607.             Inc(PByte(D));
  4608.           end;
  4609.         4:
  4610.           begin
  4611.             P1 := @PArrayByte(D)[X shr 1];
  4612.             P1^ := ((P1^ and Mask4n[X and 1]) or ((c shl Shift4[X and 1])));
  4613.           end;
  4614.       end;
  4615.     end;
  4616.   end;
  4617.   case BitCount of
  4618.     24, 8:
  4619.       begin
  4620.         Assign(Temp1);
  4621.         Temp1.Free;
  4622.       end;
  4623.     4: Temp1.Free;
  4624.   end;
  4625.   FreeMem(pc, SizeOf(TBGR));
  4626. end;
  4627.  
  4628. procedure TDIB.Emboss;
  4629. var
  4630.   x, y: longint;
  4631.   D, D1, P: pointer;
  4632.   color: TBGR;
  4633.   c: DWORD;
  4634.   P1: PByte;
  4635.  
  4636. begin
  4637.   D := nil;
  4638.   D1 := nil;
  4639.   P := nil;
  4640.   case BitCount of
  4641.     32, 16, 1: Exit;
  4642.     24:
  4643.       begin
  4644.         D := PBits;
  4645.         D1 := Ptr(Integer(D) + 3);
  4646.       end;
  4647.   else
  4648.   end;
  4649.   for y := 0 to Pred(Height) do
  4650.   begin
  4651.     case Bitcount of
  4652.       8, 4:
  4653.         begin
  4654.           P := ScanLine[y];
  4655.         end;
  4656.     end;
  4657.     for x := 0 to Pred(Width) do
  4658.     begin
  4659.       case BitCount of
  4660.         24:
  4661.           begin
  4662.             PBGR(D)^.B := ((PBGR(D)^.B + (PBGR(D1)^.B xor $FF)) shr 1);
  4663.             PBGR(D)^.G := ((PBGR(D)^.G + (PBGR(D1)^.G xor $FF)) shr 1);
  4664.             PBGR(D)^.R := ((PBGR(D)^.R + (PBGR(D1)^.R xor $FF)) shr 1);
  4665.             Inc(PBGR(D));
  4666.             if (y < Height - 2) and (x < Width - 2) then
  4667.               Inc(PBGR(D1));
  4668.           end;
  4669.         8:
  4670.           begin
  4671.             color.R := (((Pixels[x, y] + (Pixels[x + 3, y] xor $FF)) shr 1) + 30) div 3;
  4672.             color.G := (((Pixels[x, y] + (Pixels[x + 3, y] xor $FF)) shr 1) + 30) div 3;
  4673.             color.B := (((Pixels[x, y] + (Pixels[x + 3, y] xor $FF)) shr 1) + 30) div 3;
  4674.             c := (color.R + color.G + color.B) shr 1;
  4675.             PByte(P)^ := c;
  4676.             Inc(PByte(P));
  4677.           end;
  4678.         4:
  4679.           begin
  4680.             color.R := (((Pixels[x, y] + (Pixels[x + 3, y] xor $FF) + 1) shr 1) + 30) div 3;
  4681.             color.G := (((Pixels[x, y] + (Pixels[x + 3, y] xor $FF) - 1) shr 1) + 30) div 3;
  4682.             color.B := (((Pixels[x, y] + (Pixels[x + 3, y] xor $FF) + 1) shr 1) + 30) div 3;
  4683.             c := (color.R + color.G + color.B) shr 1;
  4684.             if c > 64 then
  4685.               c := c - 8;
  4686.             P1 := @PArrayByte(P)[X shr 1];
  4687.             P1^ := (P1^ and Mask4n[X and 1]) or ((c) shl Shift4[X and 1]);
  4688.           end;
  4689.       else
  4690.       end;
  4691.     end;
  4692.     case BitCount of
  4693.       24:
  4694.         begin
  4695.           D := Ptr(Integer(D1));
  4696.           if y < Height - 2 then
  4697.             D1 := Ptr(Integer(D1) + 6)
  4698.           else
  4699.             D1 := Ptr(Integer(ScanLine[Pred(Height)]) + 3);
  4700.         end;
  4701.     else
  4702.     end;
  4703.   end;
  4704. end;
  4705.  
  4706. procedure TDIB.AddMonoNoise(Amount: Integer);
  4707. var
  4708.   value: cardinal;
  4709.   x, y: longint;
  4710.   a: byte;
  4711.   D: pointer;
  4712.   color: DWORD;
  4713.   P: PByte;
  4714. begin
  4715.   for y := 0 to Pred(Height) do
  4716.   begin
  4717.     D := ScanLine[y];
  4718.     for x := 0 to Pred(Width) do
  4719.     begin
  4720.       case BitCount of
  4721.         32: Exit; // I haven't bitmap of this type ! Sorry
  4722.         24:
  4723.           begin
  4724.             value := Random(Amount) - (Amount shr 1);
  4725.             PBGR(D)^.B := IntToByte(PBGR(D)^.B + value);
  4726.             PBGR(D)^.G := IntToByte(PBGR(D)^.G + value);
  4727.             PBGR(D)^.R := IntToByte(PBGR(D)^.R + value);
  4728.             Inc(PBGR(D));
  4729.           end;
  4730.         16: Exit; // I haven't bitmap of this type ! Sorry
  4731.         8:
  4732.           begin
  4733.             a := ((Random(Amount shr 1) - (Amount div 4))) div 8;
  4734.             color := Interval(0, 255, (pixels[x, y] - a), True);
  4735.             PByte(D)^ := color;
  4736.             Inc(PByte(D));
  4737.           end;
  4738.         4:
  4739.           begin
  4740.             a := ((Random(Amount shr 1) - (Amount div 4))) div 16;
  4741.             color := Interval(0, 15, (pixels[x, y] - a), True);
  4742.             P := @PArrayByte(D)[X shr 1];
  4743.             P^ := ((P^ and Mask4n[X and 1]) or ((color shl Shift4[X and 1])));
  4744.           end;
  4745.         1:
  4746.           begin
  4747.             a := ((Random(Amount shr 1) - (Amount div 4))) div 32;
  4748.             color := Interval(0, 1, (pixels[x, y] - a), True);
  4749.             P := @PArrayByte(D)[X shr 3];
  4750.             P^ := (P^ and Mask1n[X and 7]) or (color shl Shift1[X and 7]);
  4751.           end;
  4752.       else
  4753.       end;
  4754.     end;
  4755.   end;
  4756. end;
  4757.  
  4758. procedure TDIB.AddGradiantNoise(Amount: byte);
  4759. var
  4760.   a, i: byte;
  4761.   x, y: Integer;
  4762.   Table: array[0..255] of TBGR;
  4763.   S, D: pointer;
  4764.   color: DWORD;
  4765.   Temp1: TDIB;
  4766.   P: PByte;
  4767.  
  4768. begin
  4769.   D := nil;
  4770.   S := nil;
  4771.   Temp1 := nil;
  4772.   case BitCount of
  4773.     32: Exit; // I haven't bitmap of this type ! Sorry
  4774.     24:
  4775.       begin
  4776.         for i := 0 to 255 do
  4777.         begin
  4778.           a := Random(Amount);
  4779.           Table[i].b := IntToByte(i + a);
  4780.           Table[i].g := IntToByte(i + a);
  4781.           Table[i].r := IntToByte(i + a);
  4782.         end;
  4783.       end;
  4784.     16: Exit; // I haven't bitmap of this type ! Sorry
  4785.     8, 4:
  4786.       begin
  4787.         Temp1 := TDIB.Create;
  4788.         Temp1.Assign(self);
  4789.         Temp1.SetSize(Width, Height, BitCount);
  4790.         for i := 0 to 255 do
  4791.         begin
  4792.           with ColorTable[i] do
  4793.           begin
  4794.             a := Random(Amount);
  4795.             rgbRed := IntToByte(rgbRed + a);
  4796.             rgbGreen := IntToByte(rgbGreen + a);
  4797.             rgbBlue := IntToByte(rgbBlue + a);
  4798.           end;
  4799.         end;
  4800.         UpdatePalette;
  4801.       end;
  4802.   else
  4803.     // if the number of pixel is equal to 1 then exit of procedure
  4804.     Exit;
  4805.   end;
  4806.   for y := 0 to Pred(Height) do
  4807.   begin
  4808.     case BitCount of
  4809.       24: D := ScanLine[y];
  4810.       8, 4:
  4811.         begin
  4812.           D := Temp1.ScanLine[y];
  4813.           S := Temp1.ScanLine[y];
  4814.         end;
  4815.     else
  4816.     end;
  4817.     for x := 0 to Pred(Width) do
  4818.     begin
  4819.       case BitCount of
  4820.         32: ; // I haven't bitmap of this type ! Sorry
  4821.         24:
  4822.           begin
  4823.             PBGR(D)^.B := Table[PBGR(D)^.B].b;
  4824.             PBGR(D)^.G := Table[PBGR(D)^.G].g;
  4825.             PBGR(D)^.R := Table[PBGR(D)^.R].r;
  4826.             Inc(PBGR(D));
  4827.           end;
  4828.         16: ; // I haven't bitmap of this type ! Sorry
  4829.         8:
  4830.           begin
  4831.             with Temp1.ColorTable[PByte(S)^] do
  4832.               color := rgbRed + rgbGreen + rgbBlue;
  4833.             Inc(PByte(S));
  4834.             PByte(D)^ := color;
  4835.             Inc(PByte(D));
  4836.           end;
  4837.         4:
  4838.           begin
  4839.             with Temp1.ColorTable[PByte(S)^] do
  4840.               color := rgbRed + rgbGreen + rgbBlue;
  4841.             Inc(PByte(S));
  4842.             P := @PArrayByte(D)[X shr 1];
  4843.             P^ := (P^ and Mask4n[X and 1]) or (color shl Shift4[X and 1]);
  4844.           end;
  4845.       else
  4846.       end;
  4847.     end;
  4848.   end;
  4849.   case BitCount of
  4850.     8, 4: Temp1.Free;
  4851.   else
  4852.   end;
  4853. end;
  4854.  
  4855. function TDIB.FishEye(bmp: TDIB): Boolean;
  4856. var
  4857.   weight, xmid, ymid, fx, fy, r1, r2, dx, dy, rmax: Double;
  4858.   Amount, ifx, ify, ty, tx, new_red, new_green, new_blue, ix, iy: Integer;
  4859.   weight_x, weight_y: array[0..1] of Double;
  4860.   total_red, total_green, total_blue: Double;
  4861.   sli, slo: PLines;
  4862.   //D: Pointer;
  4863. begin
  4864.   Result := True;
  4865.   case BitCount of
  4866.     32, 16, 8, 4, 1:
  4867.       begin
  4868.         Result := False;
  4869.         Exit;
  4870.       end;
  4871.   end;
  4872.   Amount := 1;
  4873.   xmid := Width / 2;
  4874.   ymid := Height / 2;
  4875.   rmax := Max(Bmp.Width, Bmp.Height) * Amount;
  4876.   for ty := 0 to Pred(Height) do
  4877.   begin
  4878.     for tx := 0 to Pred(Width) do
  4879.     begin
  4880.       dx := tx - xmid;
  4881.       dy := ty - ymid;
  4882.       r1 := Sqrt(Sqr(dx) + Sqr(dy));
  4883.       if r1 <> 0 then
  4884.       begin
  4885.         r2 := rmax / 2 * (1 / (1 - r1 / rmax) - 1);
  4886.         fx := dx * r2 / r1 + xmid;
  4887.         fy := dy * r2 / r1 + ymid;
  4888.       end
  4889.       else
  4890.       begin
  4891.         fx := xmid;
  4892.         fy := ymid;
  4893.       end;
  4894.       ify := Trunc(fy);
  4895.       ifx := Trunc(fx);
  4896.       if fy >= 0 then
  4897.       begin
  4898.         weight_y[1] := fy - ify;
  4899.         weight_y[0] := 1 - weight_y[1];
  4900.       end
  4901.       else
  4902.       begin
  4903.         weight_y[0] := -(fy - ify);
  4904.         weight_y[1] := 1 - weight_y[0];
  4905.       end;
  4906.       if fx >= 0 then
  4907.       begin
  4908.         weight_x[1] := fx - ifx;
  4909.         weight_x[0] := 1 - weight_x[1];
  4910.       end
  4911.       else
  4912.       begin
  4913.         weight_x[0] := -(fx - ifx);
  4914.         Weight_x[1] := 1 - weight_x[0];
  4915.       end;
  4916.       if ifx < 0 then
  4917.         ifx := Pred(Width) - (-ifx mod Width)
  4918.       else
  4919.         if ifx > Pred(Width) then
  4920.           ifx := ifx mod Width;
  4921.       if ify < 0 then
  4922.         ify := Pred(Height) - (-ify mod Height)
  4923.       else
  4924.         if ify > Pred(Height) then
  4925.           ify := ify mod Height;
  4926.       total_red := 0.0;
  4927.       total_green := 0.0;
  4928.       total_blue := 0.0;
  4929.       for ix := 0 to 1 do
  4930.       begin
  4931.         for iy := 0 to 1 do
  4932.         begin
  4933.           if ify + iy < Height then
  4934.             sli := ScanLine[ify + iy]
  4935.           else
  4936.             sli := ScanLine[Height - ify - iy];
  4937.           if ifx + ix < Width then
  4938.           begin
  4939.             new_red := sli^[ifx + ix].r;
  4940.             new_green := sli^[ifx + ix].g;
  4941.             new_blue := sli^[ifx + ix].b;
  4942.           end
  4943.           else
  4944.           begin
  4945.             new_red := sli^[Width - ifx - ix].r;
  4946.             new_green := sli^[Width - ifx - ix].g;
  4947.             new_blue := sli^[Width - ifx - ix].b;
  4948.           end;
  4949.           weight := weight_x[ix] * weight_y[iy];
  4950.           total_red := total_red + new_red * weight;
  4951.           total_green := total_green + new_green * weight;
  4952.           total_blue := total_blue + new_blue * weight;
  4953.         end;
  4954.       end;
  4955.       case bitCount of
  4956.         24:
  4957.           begin
  4958.             slo := Bmp.ScanLine[ty];
  4959.             slo^[tx].r := Round(total_red);
  4960.             slo^[tx].g := Round(total_green);
  4961.             slo^[tx].b := Round(total_blue);
  4962.           end;
  4963.       else
  4964.         // You can implement this procedure for 16,8,4,2 and 32 BitCount's DIB
  4965.         Exit;
  4966.       end;
  4967.     end;
  4968.   end;
  4969. end;
  4970.  
  4971. function TDIB.SmoothRotateWrap(Bmp: TDIB; cx, cy: Integer; Degree: Extended): Boolean;
  4972. var
  4973.   weight, Theta, cosTheta, sinTheta, sfrom_y, sfrom_x: Double;
  4974.   ifrom_y, ifrom_x, xDiff, yDiff, to_y, to_x: Integer;
  4975.   weight_x, weight_y: array[0..1] of Double;
  4976.   ix, iy, new_red, new_green, new_blue: Integer;
  4977.   total_red, total_green, total_blue: Double;
  4978.   sli, slo: PLines;
  4979. begin
  4980.   Result := True;
  4981.   case BitCount of
  4982.     32, 16, 8, 4, 1:
  4983.       begin
  4984.         Result := False;
  4985.         Exit;
  4986.       end;
  4987.   end;
  4988.   Theta := -Degree * Pi / 180;
  4989.   sinTheta := Sin(Theta);
  4990.   cosTheta := Cos(Theta);
  4991.   xDiff := (Bmp.Width - Width) div 2;
  4992.   yDiff := (Bmp.Height - Height) div 2;
  4993.   for to_y := 0 to Pred(Bmp.Height) do
  4994.   begin
  4995.     for to_x := 0 to Pred(Bmp.Width) do
  4996.     begin
  4997.       sfrom_x := (cx + (to_x - cx) * cosTheta - (to_y - cy) * sinTheta) - xDiff;
  4998.       ifrom_x := Trunc(sfrom_x);
  4999.       sfrom_y := (cy + (to_x - cx) * sinTheta + (to_y - cy) * cosTheta) - yDiff;
  5000.       ifrom_y := Trunc(sfrom_y);
  5001.       if sfrom_y >= 0 then
  5002.       begin
  5003.         weight_y[1] := sfrom_y - ifrom_y;
  5004.         weight_y[0] := 1 - weight_y[1];
  5005.       end
  5006.       else
  5007.       begin
  5008.         weight_y[0] := -(sfrom_y - ifrom_y);
  5009.         weight_y[1] := 1 - weight_y[0];
  5010.       end;
  5011.       if sfrom_x >= 0 then
  5012.       begin
  5013.         weight_x[1] := sfrom_x - ifrom_x;
  5014.         weight_x[0] := 1 - weight_x[1];
  5015.       end
  5016.       else
  5017.       begin
  5018.         weight_x[0] := -(sfrom_x - ifrom_x);
  5019.         Weight_x[1] := 1 - weight_x[0];
  5020.       end;
  5021.       if ifrom_x < 0 then
  5022.         ifrom_x := Pred(Width) - (-ifrom_x mod Width)
  5023.       else
  5024.         if ifrom_x > Pred(Width) then
  5025.           ifrom_x := ifrom_x mod Width;
  5026.       if ifrom_y < 0 then
  5027.         ifrom_y := Pred(Height) - (-ifrom_y mod Height)
  5028.       else
  5029.         if ifrom_y > Pred(Height) then
  5030.           ifrom_y := ifrom_y mod Height;
  5031.       total_red := 0.0;
  5032.       total_green := 0.0;
  5033.       total_blue := 0.0;
  5034.       for ix := 0 to 1 do
  5035.       begin
  5036.         for iy := 0 to 1 do
  5037.         begin
  5038.           if ifrom_y + iy < Height then
  5039.             sli := ScanLine[ifrom_y + iy]
  5040.           else
  5041.             sli := ScanLine[Height - ifrom_y - iy];
  5042.           if ifrom_x + ix < Width then
  5043.           begin
  5044.             new_red := sli^[ifrom_x + ix].r;
  5045.             new_green := sli^[ifrom_x + ix].g;
  5046.             new_blue := sli^[ifrom_x + ix].b;
  5047.           end
  5048.           else
  5049.           begin
  5050.             new_red := sli^[Width - ifrom_x - ix].r;
  5051.             new_green := sli^[Width - ifrom_x - ix].g;
  5052.             new_blue := sli^[Width - ifrom_x - ix].b;
  5053.           end;
  5054.           weight := weight_x[ix] * weight_y[iy];
  5055.           total_red := total_red + new_red * weight;
  5056.           total_green := total_green + new_green * weight;
  5057.           total_blue := total_blue + new_blue * weight;
  5058.         end;
  5059.       end;
  5060.       case bitCount of
  5061.         24:
  5062.           begin
  5063.             slo := Bmp.ScanLine[to_y];
  5064.             slo^[to_x].r := Round(total_red);
  5065.             slo^[to_x].g := Round(total_green);
  5066.             slo^[to_x].b := Round(total_blue);
  5067.           end;
  5068.       else
  5069.         // You can implement this procedure for 16,8,4,2 and 32 BitCount's DIB
  5070.         Exit;
  5071.       end;
  5072.     end;
  5073.   end;
  5074. end;
  5075.  
  5076. function TDIB.Rotate(Dst: TDIB; cx, cy: Integer; Angle: Double): Boolean;
  5077. var
  5078.   x, y, dx, dy, sdx, sdy, xDiff, yDiff, isinTheta, icosTheta: Integer;
  5079.   D, S: Pointer;
  5080.   sinTheta, cosTheta, Theta: Double;
  5081.   Col: TBGR;
  5082.   i: byte;
  5083.   color: DWORD;
  5084.   P: PByte;
  5085. begin
  5086.   D := nil;
  5087.   S := nil;
  5088.   Result := True;
  5089.   dst.SetSize(Width, Height, Bitcount);
  5090.   dst.Canvas.Brush.Color := clBlack;
  5091.   Dst.Canvas.FillRect(Bounds(0, 0, Width, Height));
  5092.   case BitCount of
  5093.     32, 16:
  5094.       begin
  5095.         Result := False;
  5096.         Exit;
  5097.       end;
  5098.     8, 4, 1:
  5099.       begin
  5100.         for i := 0 to 255 do
  5101.           Dst.ColorTable[i] := ColorTable[i];
  5102.         Dst.UpdatePalette;
  5103.       end;
  5104.   end;
  5105.   Theta := -Angle * Pi / 180;
  5106.   sinTheta := Sin(Theta);
  5107.   cosTheta := Cos(Theta);
  5108.   xDiff := (Dst.Width - Width) div 2;
  5109.   yDiff := (Dst.Height - Height) div 2;
  5110.   isinTheta := Round(sinTheta * $10000);
  5111.   icosTheta := Round(cosTheta * $10000);
  5112.   for y := 0 to Pred(Dst.Height) do
  5113.   begin
  5114.     case BitCount of
  5115.       4, 1:
  5116.         begin
  5117.           D := Dst.ScanLine[y];
  5118.           S := ScanLine[y];
  5119.         end;
  5120.     else
  5121.     end;
  5122.     sdx := Round(((cx + (-cx) * cosTheta - (y - cy) * sinTheta) - xDiff) * $10000);
  5123.     sdy := Round(((cy + (-cy) * sinTheta + (y - cy) * cosTheta) - yDiff) * $10000);
  5124.     for x := 0 to Pred(Dst.Width) do
  5125.     begin
  5126.       dx := (sdx shr 16);
  5127.       dy := (sdy shr 16);
  5128.       if (dx > -1) and (dx < Width) and (dy > -1) and (dy < Height) then
  5129.       begin
  5130.         case bitcount of
  5131.           8, 24: Dst.pixels[x, y] := Pixels[dx, dy];
  5132.           4:
  5133.             begin
  5134.               pfGetRGB(NowPixelFormat, Pixels[dx, dy], col.r, col.g, col.b);
  5135.               color := col.r + col.g + col.b;
  5136.               Inc(PByte(S));
  5137.               P := @PArrayByte(D)[x shr 1];
  5138.               P^ := (P^ and Mask4n[x and 1]) or (color shl Shift4[x and 1]);
  5139.             end;
  5140.           1:
  5141.             begin
  5142.               pfGetRGB(NowPixelFormat, Pixels[dx, dy], col.r, col.g, col.b);
  5143.               color := col.r + col.g + col.b;
  5144.               Inc(PByte(S));
  5145.               P := @PArrayByte(D)[X shr 3];
  5146.               P^ := (P^ and Mask1n[X and 7]) or (color shl Shift1[X and 7]);
  5147.             end;
  5148.         end;
  5149.       end;
  5150.       Inc(sdx, icosTheta);
  5151.       Inc(sdy, isinTheta);
  5152.     end;
  5153.   end;
  5154. end;
  5155.  
  5156. procedure TDIB.GaussianBlur(Bmp: TDIB; Amount: Integer);
  5157. var
  5158.   i: Integer;
  5159. begin
  5160.   for i := 1 to Amount do
  5161.     Bmp.SplitBlur(i);
  5162. end;
  5163.  
  5164. procedure TDIB.SplitBlur(Amount: Integer);
  5165. var
  5166.   Lin1, Lin2: PLines;
  5167.   cx, x, y: Integer;
  5168.   Buf: array[0..3] of TBGR;
  5169.   D: Pointer;
  5170.  
  5171. begin
  5172.   case Bitcount of
  5173.     32, 16, 8, 4, 1: Exit;
  5174.   end;
  5175.   for y := 0 to Pred(Height) do
  5176.   begin
  5177.     Lin1 := ScanLine[TrimInt(y + Amount, 0, Pred(Height))];
  5178.     Lin2 := ScanLine[TrimInt(y - Amount, 0, Pred(Height))];
  5179.     D := ScanLine[y];
  5180.     for x := 0 to Pred(Width) do
  5181.     begin
  5182.       cx := TrimInt(x + Amount, 0, Pred(Width));
  5183.       Buf[0] := Lin1[cx];
  5184.       Buf[1] := Lin2[cx];
  5185.       cx := TrimInt(x - Amount, 0, Pred(Width));
  5186.       Buf[2] := Lin1[cx];
  5187.       Buf[3] := Lin2[cx];
  5188.       PBGR(D)^.b := (Buf[0].b + Buf[1].b + Buf[2].b + Buf[3].b) shr 2;
  5189.       PBGR(D)^.g := (Buf[0].g + Buf[1].g + Buf[2].g + Buf[3].g) shr 2;
  5190.       PBGR(D)^.r := (Buf[0].r + Buf[1].r + Buf[2].r + Buf[3].r) shr 2;
  5191.       Inc(PBGR(D));
  5192.     end;
  5193.   end;
  5194. end;
  5195.  
  5196. function TDIB.Twist(bmp: TDIB; Amount: byte): Boolean;
  5197. var
  5198.   fxmid, fymid: Single;
  5199.   txmid, tymid: Single;
  5200.   fx, fy: Single;
  5201.   tx2, ty2: Single;
  5202.   r: Single;
  5203.   theta: Single;
  5204.   ifx, ify: Integer;
  5205.   dx, dy: Single;
  5206.   OFFSET: Single;
  5207.   ty, tx, ix, iy: Integer;
  5208.   weight_x, weight_y: array[0..1] of Single;
  5209.   weight: Single;
  5210.   new_red, new_green, new_blue: Integer;
  5211.   total_red, total_green, total_blue: Single;
  5212.   sli, slo: PLines;
  5213.  
  5214.   function ArcTan2(xt, yt: Single): Single; {$IFDEF VER9UP}inline;{$ENDIF}
  5215.   begin
  5216.     if xt = 0 then
  5217.       if yt > 0 then
  5218.         Result := Pi / 2
  5219.       else
  5220.         Result := -(Pi / 2)
  5221.     else
  5222.     begin
  5223.       Result := ArcTan(yt / xt);
  5224.       if xt < 0 then
  5225.         Result := Pi + ArcTan(yt / xt);
  5226.     end;
  5227.   end;
  5228.  
  5229. begin
  5230.   Result := True;
  5231.   case BitCount of
  5232.     32, 16, 8, 4, 1:
  5233.       begin
  5234.         Result := False;
  5235.         Exit;
  5236.       end;
  5237.   end;
  5238.   if Amount = 0 then
  5239.     Amount := 1;
  5240.   OFFSET := -(Pi / 2);
  5241.   dx := Pred(Width);
  5242.   dy := Pred(Height);
  5243.   r := Sqrt(dx * dx + dy * dy);
  5244.   tx2 := r;
  5245.   ty2 := r;
  5246.   txmid := (Pred(Width)) / 2;
  5247.   tymid := (Pred(Height)) / 2;
  5248.   fxmid := (Pred(Width)) / 2;
  5249.   fymid := (Pred(Height)) / 2;
  5250.   if tx2 >= Width then
  5251.     tx2 := Pred(Width);
  5252.   if ty2 >= Height then
  5253.     ty2 := Pred(Height);
  5254.   for ty := 0 to Round(ty2) do
  5255.   begin
  5256.     for tx := 0 to Round(tx2) do
  5257.     begin
  5258.       dx := tx - txmid;
  5259.       dy := ty - tymid;
  5260.       r := Sqrt(dx * dx + dy * dy);
  5261.       if r = 0 then
  5262.       begin
  5263.         fx := 0;
  5264.         fy := 0;
  5265.       end
  5266.       else
  5267.       begin
  5268.         theta := ArcTan2(dx, dy) - r / Amount - OFFSET;
  5269.         fx := r * Cos(theta);
  5270.         fy := r * Sin(theta);
  5271.       end;
  5272.       fx := fx + fxmid;
  5273.       fy := fy + fymid;
  5274.       ify := Trunc(fy);
  5275.       ifx := Trunc(fx);
  5276.       if fy >= 0 then
  5277.       begin
  5278.         weight_y[1] := fy - ify;
  5279.         weight_y[0] := 1 - weight_y[1];
  5280.       end
  5281.       else
  5282.       begin
  5283.         weight_y[0] := -(fy - ify);
  5284.         weight_y[1] := 1 - weight_y[0];
  5285.       end;
  5286.       if fx >= 0 then
  5287.       begin
  5288.         weight_x[1] := fx - ifx;
  5289.         weight_x[0] := 1 - weight_x[1];
  5290.       end
  5291.       else
  5292.       begin
  5293.         weight_x[0] := -(fx - ifx);
  5294.         Weight_x[1] := 1 - weight_x[0];
  5295.       end;
  5296.       if ifx < 0 then
  5297.         ifx := Pred(Width) - (-ifx mod Width)
  5298.       else
  5299.         if ifx > Pred(Width) then
  5300.           ifx := ifx mod Width;
  5301.       if ify < 0 then
  5302.         ify := Pred(Height) - (-ify mod Height)
  5303.       else
  5304.         if ify > Pred(Height) then
  5305.           ify := ify mod Height;
  5306.       total_red := 0.0;
  5307.       total_green := 0.0;
  5308.       total_blue := 0.0;
  5309.       for ix := 0 to 1 do
  5310.       begin
  5311.         for iy := 0 to 1 do
  5312.         begin
  5313.           if ify + iy < Height then
  5314.             sli := ScanLine[ify + iy]
  5315.           else
  5316.             sli := ScanLine[Height - ify - iy];
  5317.           if ifx + ix < Width then
  5318.           begin
  5319.             new_red := sli^[ifx + ix].r;
  5320.             new_green := sli^[ifx + ix].g;
  5321.             new_blue := sli^[ifx + ix].b;
  5322.           end
  5323.           else
  5324.           begin
  5325.             new_red := sli^[Width - ifx - ix].r;
  5326.             new_green := sli^[Width - ifx - ix].g;
  5327.             new_blue := sli^[Width - ifx - ix].b;
  5328.           end;
  5329.           weight := weight_x[ix] * weight_y[iy];
  5330.           total_red := total_red + new_red * weight;
  5331.           total_green := total_green + new_green * weight;
  5332.           total_blue := total_blue + new_blue * weight;
  5333.         end;
  5334.       end;
  5335.       case bitCount of
  5336.         24:
  5337.           begin
  5338.             slo := bmp.ScanLine[ty];
  5339.             slo^[tx].r := Round(total_red);
  5340.             slo^[tx].g := Round(total_green);
  5341.             slo^[tx].b := Round(total_blue);
  5342.           end;
  5343.       else
  5344.         // You can implement this procedure for 16,8,4,2 and 32 BitCount's DIB
  5345.         Exit;
  5346.       end;
  5347.     end;
  5348.   end;
  5349. end;
  5350.  
  5351. function TDIB.TrimInt(i, Min, Max: Integer): Integer;
  5352. begin
  5353.   if i > Max then
  5354.     Result := Max
  5355.   else
  5356.     if i < Min then
  5357.       Result := Min
  5358.     else
  5359.       Result := i;
  5360. end;
  5361.  
  5362. function TDIB.IntToByte(i: Integer): Byte;
  5363. begin
  5364.   if i > 255 then
  5365.     Result := 255
  5366.   else
  5367.     if i < 0 then
  5368.       Result := 0
  5369.     else
  5370.       Result := i;
  5371. end;
  5372.  
  5373. //--------------------------------------------------------------------------------------------------
  5374. // End of these New Special Effect                                                                //
  5375. // Please contributes to add effects and filters to this collection                               //
  5376. // Please, work to implement 32,16,8,4,2 BitCount's DIB                                           //
  5377. // Have fun - Mickey - Good job                                                                   //
  5378. //--------------------------------------------------------------------------------------------------
  5379.  
  5380. function TDIB.GetAlphaChannel: TDIB;
  5381. var
  5382.   I: Integer;
  5383. begin
  5384.   RetAlphaChannel(Result);
  5385.   if Result = nil then Exit;
  5386.  
  5387.   if FFreeList.Count > 0 then
  5388.     for I := 0 to FFreeList.Count - 1 do
  5389.       if FFreeList[I] = Result then Exit;
  5390.  
  5391.   FFreeList.Add(Result);
  5392. end;
  5393.  
  5394. procedure TDIB.SetAlphaChannel(const Value: TDIB);
  5395. begin
  5396.   if not AssignAlphaChannel(Value{$IFNDEF VER4UP}, False{$ENDIF}) then
  5397.     Exception.Create('Cannot set alphachannel from DIB.');
  5398. end;
  5399.  
  5400. procedure TDIB.Fill(aColor: TColor);
  5401. var
  5402.   p: PRGBA;
  5403.   y: Integer;
  5404.   x: Integer;
  5405. begin
  5406.   Canvas.Brush.Color := aColor;
  5407.   Canvas.FillRect(ClientRect);
  5408.   if Self.BitCount = 32 then
  5409.   begin
  5410.     //fill alpha chanell too with $FF
  5411.     for Y := 0 to Self.Height - 1 do
  5412.     begin
  5413.       p := Self.ScanLine[Y];
  5414.       for X := 0 to Self.Width - 1 do
  5415.       begin
  5416.         p[X].rgbReserved := $FF
  5417.       end;
  5418.     end;
  5419.   end;
  5420. end;
  5421.  
  5422. function TDIB.GetClientRect: TRect;
  5423. begin
  5424.   Result := Bounds(0, 0, Width, Height);
  5425. end;
  5426.  
  5427. {  TCustomDXDIB  }
  5428.  
  5429. constructor TCustomDXDIB.Create(AOnwer: TComponent);
  5430. begin
  5431.   inherited Create(AOnwer);
  5432.   FDIB := TDIB.Create;
  5433. end;
  5434.  
  5435. destructor TCustomDXDIB.Destroy;
  5436. begin
  5437.   FDIB.Free;
  5438.   inherited Destroy;
  5439. end;
  5440.  
  5441. procedure TCustomDXDIB.SetDIB(Value: TDIB);
  5442. begin
  5443.   FDIB.Assign(Value);
  5444. end;
  5445.  
  5446. {  TCustomDXPaintBox  }
  5447.  
  5448. constructor TCustomDXPaintBox.Create(AOwner: TComponent);
  5449. begin
  5450.   inherited Create(AOwner);
  5451.   FDIB := TDIB.Create;
  5452.  
  5453.   ControlStyle := ControlStyle + [csReplicatable];
  5454.   Height := 105;
  5455.   Width := 105;
  5456. end;
  5457.  
  5458. destructor TCustomDXPaintBox.Destroy;
  5459. begin
  5460.   FDIB.Free;
  5461.   inherited Destroy;
  5462. end;
  5463.  
  5464. function TCustomDXPaintBox.GetPalette: HPALETTE;
  5465. begin
  5466.   Result := FDIB.Palette;
  5467. end;
  5468.  
  5469. procedure TCustomDXPaintBox.Paint;
  5470.  
  5471.   procedure Draw2(Width, Height: Integer);
  5472.   begin
  5473.     if (Width <> FDIB.Width) or (Height <> FDIB.Height) then
  5474.     begin
  5475.       if FCenter then
  5476.       begin
  5477.         inherited Canvas.StretchDraw(Bounds(-(Width - ClientWidth) div 2,
  5478.           -(Height - ClientHeight) div 2, Width, Height), FDIB);
  5479.       end
  5480.       else
  5481.       begin
  5482.         inherited Canvas.StretchDraw(Bounds(0, 0, Width, Height), FDIB);
  5483.       end;
  5484.     end
  5485.     else
  5486.     begin
  5487.       if FCenter then
  5488.       begin
  5489.         inherited Canvas.Draw(-(Width - ClientWidth) div 2, -(Height - ClientHeight) div 2,
  5490.           FDIB);
  5491.       end
  5492.       else
  5493.       begin
  5494.         inherited Canvas.Draw(0, 0, FDIB);
  5495.       end;
  5496.     end;
  5497.   end;
  5498.  
  5499. var
  5500.   r, r2: Single;
  5501.   ViewWidth2, ViewHeight2: Integer;
  5502. begin
  5503.   inherited Paint;
  5504.  
  5505.   with inherited Canvas do
  5506.   begin
  5507.     if (csDesigning in ComponentState) then
  5508.     begin
  5509.       Pen.Style := psDash;
  5510.       Brush.Style := bsClear;
  5511.       Rectangle(0, 0, Width, Height);
  5512.     end;
  5513.  
  5514.     if FDIB.Empty then Exit;
  5515.  
  5516.     if (FViewWidth > 0) or (FViewHeight > 0) then
  5517.     begin
  5518.       ViewWidth2 := FViewWidth;
  5519.       if ViewWidth2 = 0 then ViewWidth2 := FDIB.Width;
  5520.       ViewHeight2 := FViewHeight;
  5521.       if ViewHeight2 = 0 then ViewHeight2 := FDIB.Height;
  5522.  
  5523.       if FAutoStretch then
  5524.       begin
  5525.         if (ClientWidth < ViewWidth2) or (ClientHeight < ViewHeight2) then
  5526.         begin
  5527.           r := ViewWidth2 / ClientWidth;
  5528.           r2 := ViewHeight2 / ClientHeight;
  5529.           if r > r2 then
  5530.             r := r2;
  5531.           Draw2(Round(r * ClientWidth), Round(r * ClientHeight));
  5532.         end
  5533.         else
  5534.           Draw2(ViewWidth2, ViewHeight2);
  5535.       end
  5536.       else
  5537.         Draw2(ViewWidth2, ViewHeight2);
  5538.     end
  5539.     else
  5540.     begin
  5541.       if FAutoStretch then
  5542.       begin
  5543.         if (FDIB.Width > ClientWidth) or (FDIB.Height > ClientHeight) then
  5544.         begin
  5545.           r := ClientWidth / FDIB.Width;
  5546.           r2 := ClientHeight / FDIB.Height;
  5547.           if r > r2 then
  5548.             r := r2;
  5549.           Draw2(Round(r * FDIB.Width), Round(r * FDIB.Height));
  5550.         end
  5551.         else
  5552.           Draw2(FDIB.Width, FDIB.Height);
  5553.       end
  5554.       else
  5555.         if FStretch then
  5556.         begin
  5557.           if FKeepAspect then
  5558.           begin
  5559.             r := ClientWidth / FDIB.Width;
  5560.             r2 := ClientHeight / FDIB.Height;
  5561.             if r > r2 then
  5562.               r := r2;
  5563.             Draw2(Round(r * FDIB.Width), Round(r * FDIB.Height));
  5564.           end
  5565.           else
  5566.             Draw2(ClientWidth, ClientHeight);
  5567.         end
  5568.         else
  5569.           Draw2(FDIB.Width, FDIB.Height);
  5570.     end;
  5571.   end;
  5572. end;
  5573.  
  5574. procedure TCustomDXPaintBox.SetAutoStretch(Value: Boolean);
  5575. begin
  5576.   if FAutoStretch <> Value then
  5577.   begin
  5578.     FAutoStretch := Value;
  5579.     Invalidate;
  5580.   end;
  5581. end;
  5582.  
  5583. procedure TCustomDXPaintBox.SetCenter(Value: Boolean);
  5584. begin
  5585.   if FCenter <> Value then
  5586.   begin
  5587.     FCenter := Value;
  5588.     Invalidate;
  5589.   end;
  5590. end;
  5591.  
  5592. procedure TCustomDXPaintBox.SetDIB(Value: TDIB);
  5593. begin
  5594.   if FDIB <> Value then
  5595.   begin
  5596.     FDIB.Assign(Value);
  5597.     Invalidate;
  5598.   end;
  5599. end;
  5600.  
  5601. procedure TCustomDXPaintBox.SetKeepAspect(Value: Boolean);
  5602. begin
  5603.   if Value <> FKeepAspect then
  5604.   begin
  5605.     FKeepAspect := Value;
  5606.     Invalidate;
  5607.   end;
  5608. end;
  5609.  
  5610. procedure TCustomDXPaintBox.SetStretch(Value: Boolean);
  5611. begin
  5612.   if Value <> FStretch then
  5613.   begin
  5614.     FStretch := Value;
  5615.     Invalidate;
  5616.   end;
  5617. end;
  5618.  
  5619. procedure TCustomDXPaintBox.SetViewWidth(Value: Integer);
  5620. begin
  5621.   if Value < 0 then Value := 0;
  5622.   if Value <> FViewWidth then
  5623.   begin
  5624.     FViewWidth := Value;
  5625.     Invalidate;
  5626.   end;
  5627. end;
  5628.  
  5629. procedure TCustomDXPaintBox.SetViewHeight(Value: Integer);
  5630. begin
  5631.   if Value < 0 then Value := 0;
  5632.   if Value <> FViewHeight then
  5633.   begin
  5634.     FViewHeight := Value;
  5635.     Invalidate;
  5636.   end;
  5637. end;
  5638.  
  5639. { DXFusion -> }
  5640.  
  5641. function PosValue(Value: Integer): Integer;
  5642. begin
  5643.   if Value < 0 then result := 0 else result := Value;
  5644. end;
  5645.  
  5646. procedure TDIB.CreateDIBFromBitmap(const Bitmap: TBitmap);
  5647. var
  5648.   pf: Integer;
  5649.   X, Y: Integer;
  5650.   P: PLinesA;
  5651.   q: PRGBA;
  5652. begin
  5653.   if Bitmap.PixelFormat = pf32bit then pf := 32 else pf := 24;
  5654.   SetSize(Bitmap.Width, Bitmap.Height, pf); {always >=24}
  5655.   Canvas.Brush.Color := clWhite;
  5656.   Canvas.FillRect(Bounds(0, 0, Width, Height));
  5657.   Canvas.Draw(0, 0, Bitmap);
  5658.   //Note. Transparent background from bitmap is not drawed when is alphalayer active
  5659.   if (pf = 32) {and (Bitmap.AlphaFormat <> afIgnored)} then
  5660.   begin
  5661.     for y := 0 to Bitmap.Height-1 do
  5662.     begin
  5663.       p := Bitmap.ScanLine[y]; //BGRA
  5664.       q := Self.ScanLine[y]; //ARGB
  5665.       for x := 0 to Width-1 do //copy only alphachannel
  5666.         q[x].rgbReserved := P[x].A;
  5667.     end;
  5668.   end;
  5669. end;
  5670.  
  5671. function TDIB.CreateBitmapFromDIB: TBitmap;
  5672. var
  5673.   ach: Boolean;
  5674.   X, Y: Integer;
  5675.   P: PLinesA;
  5676.   q: PRGBA;
  5677. begin
  5678.   ach := False;
  5679.   Result := TBitmap.Create;
  5680.   case BitCount of
  5681.     32:
  5682.       begin
  5683.         Result.PixelFormat := pf32bit;
  5684.         ach := HasAlphaChannel;
  5685.       end;
  5686.     24: Result.PixelFormat := pf24bit;
  5687.     15: Result.PixelFormat := pf16bit;
  5688.      8: Result.PixelFormat := pf8bit;
  5689.   else
  5690.     Result.PixelFormat := pf24bit;
  5691.   end;
  5692.  
  5693.   Result.Width := Width;
  5694.   Result.Height := Height;
  5695.   Result.Canvas.Draw(0, 0, Self);
  5696.   if (BitCount = 32)  then
  5697.   begin
  5698.     if ach then
  5699.     begin
  5700.       {$IFDEF VER16UP}
  5701.       Result.AlphaFormat := afDefined;
  5702.       {$ENDIF}
  5703.       for y := 0 to Height-1 do
  5704.       begin
  5705.         p := Result.ScanLine[y]; //BGRA
  5706.         q := Self.ScanLine[y]; //ARGB
  5707.         for x := 0 to Width-1 do //copy only alphachannel
  5708.           P[x].A := q[x].rgbReserved;
  5709.       end;
  5710.     end;
  5711.   end;
  5712. end;
  5713.  
  5714. procedure TDIB.DrawTo(SrcDIB: TDIB; X, Y, Width, Height,
  5715.   SourceX, SourceY: Integer);
  5716. begin
  5717.   SrcDIB.DrawOn(Rect(X, Y, Width, Height), Self.Canvas, SourceX, SourceY);
  5718. end;
  5719.  
  5720. procedure TDIB.DrawTransparent(SrcDIB: TDIB; const X, Y, Width, Height,
  5721.   SourceX, SourceY: Integer; const Color: TColor);
  5722. var
  5723.   i, j: Integer;
  5724.   k1, k2: Integer;
  5725.   n: Integer;
  5726.   p1, p2: PByteArray;
  5727.  
  5728.   Startk1, Startk2: Integer;
  5729.  
  5730.   StartY: Integer;
  5731.   EndY: Integer;
  5732.  
  5733.   DestStartY: Integer;
  5734. begin
  5735.   if Self.BitCount <> 24 then Exit;
  5736.   if SrcDIB.BitCount <> 24 then Exit;
  5737.   Startk1 := 3 * SourceX;
  5738.   Startk2 := 3 * X;
  5739.  
  5740.   DestStartY := Y - SourceY;
  5741.  
  5742.   StartY := SourceY;
  5743.   EndY := SourceY + Height;
  5744.  
  5745.   if (StartY + DestStartY < 0) then
  5746.     StartY := -DestStartY;
  5747.   if (EndY + DestStartY > Self.Height) then
  5748.     EndY := Self.Height - DestStartY;
  5749.  
  5750.   if (StartY < 0) then
  5751.     StartY := 0;
  5752.   if (EndY > SrcDIB.Height) then
  5753.     EndY := SrcDIB.Height;
  5754.  
  5755.   for j := StartY to EndY - 1 do
  5756.   begin
  5757.     p1 := Self.Scanline[j + DestStartY];
  5758.     p2 := SrcDIB.Scanline[j];
  5759.  
  5760.     k1 := Startk1;
  5761.     k2 := Startk2;
  5762.  
  5763.     for i := SourceX to SourceX + Width - 1 do
  5764.     begin
  5765.       n := (p2[k1] shl 16) + (p2[k1 + 1] shl 8) + p2[k1 + 2];
  5766.  
  5767.       if not (n = Color) then
  5768.       begin
  5769.         p1[k2] := p2[k1];
  5770.         p1[k2 + 1] := p2[k1 + 1];
  5771.         p1[k2 + 2] := p2[k1 + 2];
  5772.       end;
  5773.  
  5774.       k1 := k1 + 3;
  5775.       k2 := k2 + 3;
  5776.     end;
  5777.   end;
  5778. end;
  5779.  
  5780. procedure TDIB.DrawShadow(SrcDIB: TDIB; X, Y, Width, Height,
  5781.   Frame: Integer; FilterMode: TFilterMode);
  5782. var
  5783.   i, j: Integer;
  5784.   p1, p2: PByte;
  5785.   FW: Integer;
  5786. begin
  5787.   if Self.BitCount <> 24 then Exit;
  5788.   if SrcDIB.BitCount <> 24 then Exit;
  5789.  
  5790.   FW := Frame * Width;
  5791.   for i := 1 to Height - 1 do
  5792.   begin
  5793.     p1 := Self.Scanline[i + Y];
  5794.     p2 := SrcDIB.Scanline[i];
  5795.     Inc(p1, 3 * (X + 1));
  5796.     Inc(p2, 3 * (FW + 1));
  5797.     for j := 1 to Width - 1 do
  5798.     begin
  5799.       if (p2^ = 0) then
  5800.       begin
  5801.         case FilterMode of
  5802.           fmNormal, fmMix50:
  5803.             begin
  5804.               p1^ := p1^ shr 1; // Blue
  5805.               Inc(p1);
  5806.               p1^ := p1^ shr 1; // Green
  5807.               Inc(p1);
  5808.               p1^ := p1^ shr 1; // Red
  5809.               Inc(p1);
  5810.             end;
  5811.           fmMix25:
  5812.             begin
  5813.               p1^ := p1^ - p1^ shr 2; // Blue
  5814.               Inc(p1);
  5815.               p1^ := p1^ - p1^ shr 2; // Green
  5816.               Inc(p1);
  5817.               p1^ := p1^ - p1^ shr 2; // Red
  5818.               Inc(p1);
  5819.             end;
  5820.           fmMix75:
  5821.             begin
  5822.               p1^ := p1^ shr 2; // Blue
  5823.               Inc(p1);
  5824.               p1^ := p1^ shr 2; // Green
  5825.               Inc(p1);
  5826.               p1^ := p1^ shr 2; // Red
  5827.               Inc(p1);
  5828.             end;
  5829.         end;
  5830.       end
  5831.       else
  5832.         Inc(p1, 3); // Not in the loop...
  5833.       Inc(p2, 3);
  5834.     end;
  5835.   end;
  5836. end;
  5837.  
  5838. procedure TDIB.DrawShadows(SrcDIB: TDIB; X, Y, Width, Height,
  5839.   Frame: Integer; Alpha: Byte);
  5840. {plynule nastavovani stiny dle alpha}  
  5841. type
  5842.   P3ByteArray = ^T3ByteArray;
  5843.   T3ByteArray = array[0..32767] of TBGR;
  5844. var
  5845.   i, j, l1, l2: Integer;
  5846.   p1, p2: P3ByteArray;
  5847.   FW: Integer;
  5848. begin
  5849.   if Self.BitCount <> 24 then Exit;
  5850.   if SrcDIB.BitCount <> 24 then Exit;
  5851.  
  5852.   FW := Frame * Width;
  5853.   for i := 0 to Height - 1 do
  5854.   begin
  5855.     p1 := Self.Scanline[i + Y];
  5856.     p2 := SrcDIB.Scanline[i];
  5857.     l1 := X;
  5858.     l2 := FW;
  5859.     for j := 0 to Width - 1 do
  5860.     begin
  5861.       if (p2[j + l2].B = 0) and (p2[j + l2].G = 0) and (p2[j + l2].R = 0) then
  5862.       begin
  5863.          p1[J + l1].B := Round(p1[J + l1].B / $FF * Alpha);
  5864.          p1[J + l1].G := Round(p1[J + l1].G / $FF * Alpha);
  5865.          p1[J + l1].R := Round(p1[J + l1].R / $FF * Alpha);
  5866.       end
  5867.     end;
  5868.   end;
  5869. end;
  5870.  
  5871. procedure TDIB.DrawDarken(SrcDIB: TDIB; X, Y, Width, Height,
  5872.   Frame: Integer);
  5873. var
  5874.   frameoffset, i, j: Integer;
  5875.   p1, p2: pByte;
  5876.   XOffset: Integer;
  5877. begin
  5878.   if Self.BitCount <> 24 then Exit;
  5879.   if SrcDIB.BitCount <> 24 then Exit;
  5880.  
  5881.   frameoffset := 3 * (Frame * Width) + 3;
  5882.   XOffset := 3 * X + 3;
  5883.   for i := 1 to Height - 1 do
  5884.   begin
  5885.     p1 := Self.Scanline[i + Y];
  5886.     p2 := SrcDIB.Scanline[i];
  5887.     inc(p1, XOffset);
  5888.     inc(p2, frameoffset);
  5889.     for j := 1 to Width - 1 do
  5890.     begin
  5891.       p1^ := (p2^ * p1^) shr 8; // R
  5892.       inc(p1);
  5893.       inc(p2);
  5894.       p1^ := (p2^ * p1^) shr 8; // G
  5895.       inc(p1);
  5896.       inc(p2);
  5897.       p1^ := (p2^ * p1^) shr 8; // B
  5898.       inc(p1);
  5899.       inc(p2);
  5900.     end;
  5901.   end;
  5902. end;
  5903.  
  5904. procedure TDIB.DrawQuickAlpha(SrcDIB: TDIB; const X, Y, Width, Height,
  5905.   SourceX, SourceY: Integer; const Color: TColor; FilterMode: TFilterMode);
  5906. var
  5907.   i, j: Integer;
  5908.   k1, k2: Integer;
  5909.   n: Integer;
  5910.   p1, p2: PByteArray;
  5911.   BitSwitch1, BitSwitch2: Boolean;
  5912.  
  5913.   Startk1, Startk2: Integer;
  5914.   StartY: Integer;
  5915.   EndY: Integer;
  5916.  
  5917.   DestStartY: Integer;
  5918. begin
  5919.   if Self.BitCount <> 24 then Exit;
  5920.   if SrcDIB.BitCount <> 24 then Exit;
  5921.  
  5922.   Startk1 := 3 * SourceX;
  5923.   Startk2 := 3 * X;
  5924.  
  5925.   DestStartY := Y - SourceY;
  5926.  
  5927.   StartY := SourceY;
  5928.   EndY := SourceY + Height;
  5929.  
  5930.   if (StartY + DestStartY < 0) then
  5931.     StartY := -DestStartY;
  5932.   if (EndY + DestStartY > Self.Height) then
  5933.     EndY := Self.Height - DestStartY;
  5934.  
  5935.   if (StartY < 0) then
  5936.     StartY := 0;
  5937.   if (EndY > SrcDIB.Height) then
  5938.     EndY := SrcDIB.Height;
  5939.  
  5940.   if Odd(Y) then BitSwitch1 := true else BitSwitch1 := false;
  5941.   if Odd(X) then BitSwitch2 := true else BitSwitch2 := false;
  5942.  
  5943.   for j := StartY to EndY - 1 do
  5944.   begin
  5945.     BitSwitch1 := not BitSwitch1;
  5946.     p1 := Self.Scanline[j + DestStartY];
  5947.     p2 := SrcDIB.Scanline[j];
  5948.  
  5949.     k1 := Startk1;
  5950.     k2 := Startk2;
  5951.  
  5952.     for i := SourceX to SourceX + Width - 1 do
  5953.     begin
  5954.       BitSwitch2 := not BitSwitch2;
  5955.  
  5956.       n := (p2[k1] shl 16) + (p2[k1 + 1] shl 8) + p2[k1 + 2];
  5957.  
  5958.       case FilterMode of
  5959.         fmNormal, fmMix50: if not (n = Color) and (BitSwitch1 xor BitSwitch2) then
  5960.           begin
  5961.             p1[k2] := p2[k1];
  5962.             p1[k2 + 1] := p2[k1 + 1];
  5963.             p1[k2 + 2] := p2[k1 + 2];
  5964.           end;
  5965.         fmMix25: if not (n = Color) and (BitSwitch1 and BitSwitch2) then
  5966.           begin
  5967.             p1[k2] := p2[k1];
  5968.             p1[k2 + 1] := p2[k1 + 1];
  5969.             p1[k2 + 2] := p2[k1 + 2];
  5970.           end;
  5971.         fmMix75: if not (n = Color) and (BitSwitch1 or BitSwitch2) then
  5972.           begin
  5973.             p1[k2] := p2[k1];
  5974.             p1[k2 + 1] := p2[k1 + 1];
  5975.             p1[k2 + 2] := p2[k1 + 2];
  5976.           end;
  5977.       end;
  5978.  
  5979.       k1 := k1 + 3;
  5980.       k2 := k2 + 3;
  5981.     end;
  5982.   end;
  5983. end;
  5984.  
  5985. procedure TDIB.DrawAdditive(SrcDIB: TDIB; X, Y, Width, Height, Alpha, Frame:
  5986.   Integer);
  5987. var
  5988.   frameoffset, i, j, Wid: Integer;
  5989.   p1, p2: pByte;
  5990. begin
  5991.   if Self.BitCount <> 24 then Exit;
  5992.   if SrcDIB.BitCount <> 24 then Exit;
  5993.  
  5994.   if (Alpha < 1) or (Alpha > 256) then Exit;
  5995.   Wid := Width shl 1 + Width;
  5996.   frameoffset := Wid * Frame;
  5997.   for i := 1 to Height - 1 do
  5998.   begin
  5999.     if (i + Y) > (Self.Height - 1) then Break; //add 25.5.2004 JB.
  6000.     p1 := Self.Scanline[i + Y];
  6001.     p2 := SrcDIB.Scanline[i];
  6002.     inc(p1, X shl 1 + X + 3);
  6003.     inc(p2, frameoffset + 3);
  6004.     for j := 3 to Wid - 4 do
  6005.     begin
  6006.       inc(p1^, (Alpha - p1^) * p2^ shr 8);
  6007.       inc(p1);
  6008.       inc(p2);
  6009.     end;
  6010.   end;
  6011. end;
  6012.  
  6013. procedure TDIB.DrawTranslucent(SrcDIB: TDIB; const X, Y, Width, Height,
  6014.   SourceX, SourceY: Integer; const Color: TColor);
  6015. var
  6016.   i, j: Integer;
  6017.   k1, k2: Integer;
  6018.   n: Integer;
  6019.   p1, p2: PByteArray;
  6020.  
  6021.   Startk1, Startk2: Integer;
  6022.   StartY: Integer;
  6023.   EndY: Integer;
  6024.  
  6025.   DestStartY: Integer;
  6026. begin
  6027.   if Self.BitCount <> 24 then Exit;
  6028.   if SrcDIB.BitCount <> 24 then Exit;
  6029.  
  6030.   Startk1 := 3 * SourceX;
  6031.   Startk2 := 3 * X;
  6032.  
  6033.   DestStartY := Y - SourceY;
  6034.  
  6035.   StartY := SourceY;
  6036.   EndY := SourceY + Height;
  6037.  
  6038.   if (StartY + DestStartY < 0) then
  6039.     StartY := -DestStartY;
  6040.   if (EndY + DestStartY > Self.Height) then
  6041.     EndY := Self.Height - DestStartY;
  6042.  
  6043.   if (StartY < 0) then
  6044.     StartY := 0;
  6045.   if (EndY > SrcDIB.Height) then
  6046.     EndY := SrcDIB.Height;
  6047.  
  6048.   for j := StartY to EndY - 1 do
  6049.   begin
  6050.     p1 := Self.Scanline[j + DestStartY];
  6051.     p2 := SrcDIB.Scanline[j];
  6052.  
  6053.     k1 := Startk1;
  6054.     k2 := Startk2;
  6055.  
  6056.     for i := SourceX to SourceX + Width - 1 do
  6057.     begin
  6058.       n := (p2[k1] shl 16) + (p2[k1 + 1] shl 8) + p2[k1 + 2];
  6059.  
  6060.       if not (n = Color) then
  6061.       begin
  6062.         p1[k2] := (p1[k2] + p2[k1]) shr 1;
  6063.         p1[k2 + 1] := (p1[k2 + 1] + p2[k1 + 1]) shr 1;
  6064.         p1[k2 + 2] := (p1[k2 + 2] + p2[k1 + 2]) shr 1;
  6065.       end;
  6066.  
  6067.       k1 := k1 + 3;
  6068.       k2 := k2 + 3;
  6069.     end;
  6070.   end;
  6071. end;
  6072.  
  6073. procedure TDIB.DrawAlpha(SrcDIB: TDIB; const X, Y, Width, Height,
  6074.   SourceX, SourceY, Alpha: Integer; const Color: TColor);
  6075. var
  6076.   i, j: Integer;
  6077.   k1, k2: Integer;
  6078.   n: Integer;
  6079.   p1, p2: PByteArray;
  6080.  
  6081.   Startk1, Startk2: Integer;
  6082.   StartY: Integer;
  6083.   EndY: Integer;
  6084.  
  6085.   DestStartY: Integer;
  6086. begin
  6087.   if Self.BitCount <> 24 then Exit;
  6088.   if SrcDIB.BitCount <> 24 then Exit;
  6089.  
  6090.   Startk1 := 3 * SourceX;
  6091.   Startk2 := 3 * x;
  6092.  
  6093.   DestStartY := Y - SourceY;
  6094.  
  6095.   StartY := SourceY;
  6096.   EndY := SourceY + Height;
  6097.  
  6098.   if (EndY + DestStartY > Self.Height) then
  6099.     EndY := Self.Height - DestStartY;
  6100.  
  6101.   if (EndY > SrcDIB.Height) then
  6102.     EndY := SrcDIB.Height;
  6103.  
  6104.   if (StartY < 0) then
  6105.     StartY := 0;
  6106.  
  6107.   if (StartY + DestStartY < 0) then
  6108.     StartY := DestStartY;
  6109.  
  6110.   for j := StartY to EndY - 1 do
  6111.   begin
  6112.     p1 := Self.Scanline[j + DestStartY];
  6113.     p2 := SrcDIB.Scanline[j];
  6114.  
  6115.     k1 := Startk1;
  6116.     k2 := Startk2;
  6117.  
  6118.     for i := SourceX to SourceX + Width - 1 do
  6119.     begin
  6120.       n := (p2[k1] shl 16) + (p2[k1 + 1] shl 8) + p2[k1 + 2];
  6121.  
  6122.       if not (n = Color) then
  6123.       begin
  6124.         p1[k2] := (p1[k2] * (256 - Alpha) + p2[k1] * Alpha) shr 8;
  6125.         p1[k2 + 1] := (p1[k2 + 1] * (256 - Alpha) + p2[k1 + 1] * Alpha) shr 8;
  6126.         p1[k2 + 2] := (p1[k2 + 2] * (256 - Alpha) + p2[k1 + 2] * Alpha) shr 8;
  6127.       end;
  6128.  
  6129.       k1 := k1 + 3;
  6130.       k2 := k2 + 3;
  6131.     end;
  6132.   end;
  6133. end;
  6134.  
  6135. procedure TDIB.DrawAlphaMask(SrcDIB, MaskDIB: TDIB; const X, Y,
  6136.   Width, Height, SourceX, SourceY: Integer);
  6137. var
  6138.   i, j: Integer;
  6139.   k1, k2, k3: Integer;
  6140.   p1, p2, p3: PByteArray;
  6141.  
  6142.   Startk1, Startk2: Integer;
  6143.   StartY: Integer;
  6144.   EndY: Integer;
  6145.  
  6146.   DestStartY: Integer;
  6147. begin
  6148.   if Self.BitCount <> 24 then Exit;
  6149.   if SrcDIB.BitCount <> 24 then Exit;
  6150.  
  6151.   Startk1 := 3 * SourceX;
  6152.   Startk2 := 3 * x;
  6153.  
  6154.   DestStartY := Y - SourceY;
  6155.  
  6156.   StartY := SourceY;
  6157.   EndY := SourceY + Height;
  6158.  
  6159.   if (EndY + DestStartY > Self.Height) then
  6160.     EndY := Self.Height - DestStartY;
  6161.  
  6162.   if (EndY > SrcDIB.Height) then
  6163.     EndY := SrcDIB.Height;
  6164.  
  6165.   if (StartY < 0) then
  6166.     StartY := 0;
  6167.  
  6168.   if (StartY + DestStartY < 0) then
  6169.     StartY := DestStartY;
  6170.  
  6171.   for j := StartY to EndY - 1 do
  6172.   begin
  6173.     p1 := Self.Scanline[j + DestStartY];
  6174.     p2 := SrcDIB.Scanline[j];
  6175.     p3 := MaskDIB.Scanline[j];
  6176.  
  6177.     k1 := Startk1;
  6178.     k2 := Startk2;
  6179.     k3 := 0;
  6180.  
  6181.     for i := SourceX to SourceX + Width - 1 do
  6182.     begin
  6183.       p1[k2] := (p1[k2] * (256 - p3[k3]) + p2[k1] * p3[k3]) shr 8;
  6184.       p1[k2 + 1] := (p1[k2 + 1] * (256 - p3[k3]) + p2[k1 + 1] * p3[k3]) shr 8;
  6185.       p1[k2 + 2] := (p1[k2 + 2] * (256 - p3[k3]) + p2[k1 + 2] * p3[k3]) shr 8;
  6186.  
  6187.       k1 := k1 + 3;
  6188.       k2 := k2 + 3;
  6189.       k3 := k3 + 3;
  6190.     end;
  6191.   end;
  6192. end;
  6193.  
  6194. procedure TDIB.DrawMorphed(SrcDIB: TDIB; const X, Y, Width, Height,
  6195.   SourceX, SourceY: Integer; const Color: TColor);
  6196. var
  6197.   i, j, r, g, b: Integer;
  6198.   k1, k2: Integer;
  6199.   n: Integer;
  6200.   p1, p2: PByteArray;
  6201.  
  6202.   Startk1, Startk2: Integer;
  6203.   StartY: Integer;
  6204.   EndY: Integer;
  6205.  
  6206.   DestStartY: Integer;
  6207. begin
  6208.   if Self.BitCount <> 24 then Exit;
  6209.   if SrcDIB.BitCount <> 24 then Exit;
  6210.  
  6211.   Startk1 := 3 * SourceX;
  6212.   Startk2 := 3 * x;
  6213.  
  6214.   DestStartY := Y - SourceY;
  6215.  
  6216.   StartY := SourceY;
  6217.   EndY := SourceY + Height;
  6218.  
  6219.   if (EndY + DestStartY > Self.Height) then
  6220.     EndY := Self.Height - DestStartY;
  6221.  
  6222.   if (EndY > SrcDIB.Height) then
  6223.     EndY := SrcDIB.Height;
  6224.  
  6225.   if (StartY < 0) then
  6226.     StartY := 0;
  6227.  
  6228.   if (StartY + DestStartY < 0) then
  6229.     StartY := DestStartY;
  6230.  
  6231.   r := 0;
  6232.   g := 0;
  6233.   b := 0;
  6234.  
  6235.   for j := StartY to EndY - 1 do
  6236.   begin
  6237.     p1 := Self.Scanline[j + DestStartY];
  6238.     p2 := SrcDIB.Scanline[j];
  6239.  
  6240.     k1 := Startk1;
  6241.     k2 := Startk2;
  6242.  
  6243.     for i := SourceX to SourceX + Width - 1 do
  6244.     begin
  6245.       n := (p2[k1] shl 16) + (p2[k1 + 1] shl 8) + p2[k1 + 2];
  6246.  
  6247.       if Random(100) < 50 then
  6248.       begin
  6249.         b := p1[k2];
  6250.         g := p1[k2 + 1];
  6251.         r := p1[k2 + 2];
  6252.       end;
  6253.  
  6254.       if not (n = Color) then
  6255.       begin
  6256.         p1[k2] := b;
  6257.         p1[k2 + 1] := g;
  6258.         p1[k2 + 2] := r;
  6259.       end;
  6260.  
  6261.       k1 := k1 + 3;
  6262.       k2 := k2 + 3;
  6263.     end;
  6264.   end;
  6265. end;
  6266.  
  6267. procedure TDIB.DrawMono(SrcDIB: TDIB; const X, Y, Width, Height,
  6268.   SourceX, SourceY: Integer; const TransColor, ForeColor, BackColor: TColor);
  6269. var
  6270.   i, j, r1, g1, b1, r2, g2, b2: Integer;
  6271.   k1, k2: Integer;
  6272.   n: Integer;
  6273.   p1, p2: PByteArray;
  6274.   Startk1, Startk2, StartY, EndY, DestStartY: Integer;
  6275. begin
  6276.   if Self.BitCount <> 24 then Exit;
  6277.   if SrcDIB.BitCount <> 24 then Exit;
  6278.  
  6279.   Startk1 := 3 * SourceX;
  6280.   Startk2 := 3 * x;
  6281.  
  6282.   DestStartY := Y - SourceY;
  6283.  
  6284.   StartY := SourceY;
  6285.   EndY := SourceY + Height;
  6286.  
  6287.   if (EndY + DestStartY > Self.Height) then
  6288.     EndY := Self.Height - DestStartY;
  6289.  
  6290.   if (EndY > SrcDIB.Height) then
  6291.     EndY := SrcDIB.Height;
  6292.  
  6293.   if (StartY < 0) then
  6294.     StartY := 0;
  6295.  
  6296.   if (StartY + DestStartY < 0) then
  6297.     StartY := DestStartY;
  6298.  
  6299.   r1 := GetRValue(BackColor);
  6300.   g1 := GetGValue(BackColor);
  6301.   b1 := GetBValue(BackColor);
  6302.  
  6303.   r2 := GetRValue(ForeColor);
  6304.   g2 := GetGValue(ForeColor);
  6305.   b2 := GetBValue(ForeColor);
  6306.  
  6307.  
  6308.   for j := StartY to EndY - 1 do
  6309.   begin
  6310.     p1 := Self.Scanline[j + DestStartY];
  6311.     p2 := SrcDIB.Scanline[j];
  6312.  
  6313.     k1 := Startk1;
  6314.     k2 := Startk2;
  6315.  
  6316.     for i := SourceX to SourceX + Width - 1 do
  6317.     begin
  6318.       n := (p2[k1] shl 16) + (p2[k1 + 1] shl 8) + p2[k1 + 2];
  6319.  
  6320.       if (n = TransColor) then
  6321.       begin
  6322.         p1[k2] := b1;
  6323.         p1[k2 + 1] := g1;
  6324.         p1[k2 + 2] := r1;
  6325.       end
  6326.       else
  6327.       begin
  6328.         p1[k2] := b2;
  6329.         p1[k2 + 1] := g2;
  6330.         p1[k2 + 2] := r2;
  6331.       end;
  6332.  
  6333.       k1 := k1 + 3;
  6334.       k2 := k2 + 3;
  6335.     end;
  6336.   end;
  6337. end;
  6338.  
  6339. procedure TDIB.Draw3x3Matrix(SrcDIB: TDIB; Setting: TMatrixSetting);
  6340. var i, j, k: Integer;
  6341.   p1, p2, p3, p4: PByteArray;
  6342. begin
  6343.   if Self.BitCount <> 24 then Exit;
  6344.   if SrcDIB.BitCount <> 24 then Exit;
  6345.  
  6346.   for i := 1 to SrcDIB.Height - 2 do
  6347.   begin
  6348.     p1 := SrcDIB.ScanLine[i - 1];
  6349.     p2 := SrcDIB.ScanLine[i];
  6350.     p3 := SrcDIB.ScanLine[i + 1];
  6351.     p4 := Self.ScanLine[i];
  6352.     for j := 3 to 3 * SrcDIB.Width - 4 do
  6353.     begin
  6354.       k := (p1[j - 3] * Setting[0] + p1[j] * Setting[1] + p1[j + 3] * Setting[2] +
  6355.         p2[j - 3] * Setting[3] + p2[j] * Setting[4] + p2[j + 3] * Setting[5] +
  6356.         p3[j - 3] * Setting[6] + p3[j] * Setting[7] + p3[j + 3] * Setting[8])
  6357.         div Setting[9];
  6358.       if k < 0 then k := 0;
  6359.       if k > 255 then k := 255;
  6360.       p4[j] := k;
  6361.     end;
  6362.   end;
  6363. end;
  6364.  
  6365. procedure TDIB.DrawAntialias(SrcDIB: TDIB);
  6366. var i, j, k, l, m: Integer;
  6367.   p1, p2, p3: PByteArray;
  6368. begin
  6369.   if Self.BitCount <> 24 then Exit;
  6370.   if SrcDIB.BitCount <> 24 then Exit;
  6371.  
  6372.   for i := 1 to Self.Height - 1 do
  6373.   begin
  6374.     k := i shl 1;
  6375.     p1 := SrcDIB.Scanline[k];
  6376.     p2 := SrcDIB.Scanline[k + 1];
  6377.     p3 := Self.Scanline[i];
  6378.     for j := 1 to Self.Width - 1 do
  6379.     begin
  6380.       m := 3 * j;
  6381.       l := m shl 1;
  6382.       p3[m] := (p1[l] + p1[l + 3] + p2[l] + p2[l + 3]) shr 2;
  6383.       p3[m + 1] := (p1[l + 1] + p1[l + 4] + p2[l + 1] + p2[l + 4]) shr 2;
  6384.       p3[m + 2] := (p1[l + 2] + p1[l + 5] + p2[l + 2] + p2[l + 5]) shr 2;
  6385.     end;
  6386.   end;
  6387. end;
  6388.  
  6389. procedure TDIB.FilterLine(X1, Y1, X2, Y2: Integer; Color: TColor;
  6390.   FilterMode: TFilterMode);
  6391. var
  6392.   i, j: Integer;
  6393.   t: TColor;
  6394.   r1, g1, b1, r2, g2, b2: Integer;
  6395. begin
  6396.   j := ROUND(Sqrt(Sqr(ABS(X2 - X1)) + Sqr(ABS(Y2 - Y1))));
  6397.   if j < 1 then Exit;
  6398.  
  6399.   r1 := GetRValue(Color);
  6400.   g1 := GetGValue(Color);
  6401.   b1 := GetBValue(Color);
  6402.  
  6403.   for i := 0 to j do
  6404.   begin
  6405.     t := Self.Pixels[X1 + ((X2 - X1) * i div j), Y1 + ((Y2 - Y1) * i div j)];
  6406.     r2 := GetRValue(t);
  6407.     g2 := GetGValue(t);
  6408.     b2 := GetBValue(t);
  6409.     case FilterMode of
  6410.       fmNormal: t := RGB(r1 + (((256 - r1) * r2) shr 8),
  6411.           g1 + (((256 - g1) * g2) shr 8),
  6412.           b1 + (((256 - b1) * b2) shr 8));
  6413.       fmMix25: t := RGB((r1 + r2 * 3) shr 2, (g1 + g2 * 3) shr 2, (b1 + b2 * 3) shr 2);
  6414.       fmMix50: t := RGB((r1 + r2) shr 1, (g1 + g2) shr 1, (b1 + b2) shr 1);
  6415.       fmMix75: t := RGB((r1 * 3 + r2) shr 2, (g1 * 3 + g2) shr 2, (b1 * 3 + b2) shr 2);
  6416.     end;
  6417.     Self.Pixels[X1 + ((X2 - X1) * i div j), Y1 + ((Y2 - Y1) * i div j)] := t;
  6418.   end;
  6419. end;
  6420.  
  6421. procedure TDIB.FilterRect(X, Y, Width, Height: Integer;
  6422.   Color: TColor; FilterMode: TFilterMode);
  6423. var
  6424.   i, j, r, g, b, C1: Integer;
  6425.   p1, p2, p3: pByte;
  6426. begin
  6427.   if Self.BitCount <> 24 then Exit;
  6428.  
  6429.   r := GetRValue(Color);
  6430.   g := GetGValue(Color);
  6431.   b := GetBValue(Color);
  6432.  
  6433.   for i := 0 to Height - 1 do
  6434.   begin
  6435.     p1 := Self.Scanline[i + Y];
  6436.     Inc(p1, (3 * X));
  6437.     for j := 0 to Width - 1 do
  6438.     begin
  6439.       case FilterMode of
  6440.         fmNormal:
  6441.           begin
  6442.             p2 := p1;
  6443.             Inc(p2);
  6444.             p3 := p2;
  6445.             Inc(p3);
  6446.             C1 := (p1^ + p2^ + p3^) div 3;
  6447.  
  6448.             p1^ := (C1 * b) shr 8;
  6449.             Inc(p1);
  6450.             p1^ := (C1 * g) shr 8;
  6451.             Inc(p1);
  6452.             p1^ := (C1 * r) shr 8;
  6453.             Inc(p1);
  6454.           end;
  6455.         fmMix25:
  6456.           begin
  6457.             p1^ := (3 * p1^ + b) shr 2;
  6458.             Inc(p1);
  6459.             p1^ := (3 * p1^ + g) shr 2;
  6460.             Inc(p1);
  6461.             p1^ := (3 * p1^ + r) shr 2;
  6462.             Inc(p1);
  6463.           end;
  6464.         fmMix50:
  6465.           begin
  6466.             p1^ := (p1^ + b) shr 1;
  6467.             Inc(p1);
  6468.             p1^ := (p1^ + g) shr 1;
  6469.             Inc(p1);
  6470.             p1^ := (p1^ + r) shr 1;
  6471.             Inc(p1);
  6472.           end;
  6473.         fmMix75:
  6474.           begin
  6475.             p1^ := (p1^ + 3 * b) shr 2;
  6476.             Inc(p1);
  6477.             p1^ := (p1^ + 3 * g) shr 2;
  6478.             Inc(p1);
  6479.             p1^ := (p1^ + 3 * r) shr 2;
  6480.             Inc(p1);
  6481.           end;
  6482.       end;
  6483.     end;
  6484.   end;
  6485. end;
  6486.  
  6487. procedure TDIB.InitLight(Count, Detail: Integer);
  6488. var
  6489.   i, j: Integer;
  6490. begin
  6491.   LG_COUNT := Count;
  6492.   LG_DETAIL := Detail;
  6493.  
  6494.   for i := 0 to 255 do // Build Lightning LUT
  6495.     for j := 0 to 255 do
  6496.       FLUTDist[i, j] := ROUND(Sqrt(Sqr(i * 10) + Sqr(j * 10)));
  6497. end;
  6498.  
  6499. procedure TDIB.DrawLights(FLight: TLightArray;
  6500.   AmbientLight: TColor);
  6501. var
  6502.   i, j, l, m, n, o, q, D1, D2, R, G, B, AR, AG, AB: Integer;
  6503.   P: array{$IFNDEF VER4UP} [0..4096]{$ENDIF} of PByteArray;
  6504. begin
  6505.   if Self.BitCount <> 24 then Exit;
  6506.  
  6507. {$IFDEF VER4UP}
  6508.   SetLength(P, LG_DETAIL);
  6509. {$ENDIF}
  6510.   AR := GetRValue(AmbientLight);
  6511.   AG := GetGValue(AmbientLight);
  6512.   AB := GetBValue(AmbientLight);
  6513.  
  6514.   for i := (Self.Height div (LG_DETAIL + 1)) downto 1 do
  6515.   begin
  6516.     for o := 0 to LG_DETAIL do
  6517.       P[o] := Self.Scanline[(LG_DETAIL + 1) * i - o];
  6518.  
  6519.     for j := (Self.Width div (LG_DETAIL + 1)) downto 1 do
  6520.     begin
  6521.       R := AR;
  6522.       G := AG;
  6523.       B := AB;
  6524.  
  6525.       for l := LG_COUNT - 1 downto 0 do // Check the lightsources
  6526.       begin
  6527.         D1 := ABS(j * (LG_DETAIL + 1) - FLight[l].X) div FLight[l].Size1;
  6528.         D2 := ABS(i * (LG_DETAIL + 1) - FLight[l].Y) div FLight[l].Size2;
  6529.         if D1 > 255 then D1 := 255;
  6530.         if D2 > 255 then D2 := 255;
  6531.  
  6532.         m := 255 - FLUTDist[D1, D2];
  6533.         if m < 0 then m := 0;
  6534.  
  6535.         Inc(R, (PosValue(GetRValue(FLight[l].Color) - R) * m shr 8));
  6536.         Inc(G, (PosValue(GetGValue(FLight[l].Color) - G) * m shr 8));
  6537.         Inc(B, (PosValue(GetBValue(FLight[l].Color) - B) * m shr 8));
  6538.       end;
  6539.  
  6540.       for q := LG_DETAIL downto 0 do
  6541.       begin
  6542.         n := 3 * (j * (LG_DETAIL + 1) - q);
  6543.  
  6544.         for o := LG_DETAIL downto 0 do
  6545.         begin
  6546.           P[o][n] := (P[o][n] * B) shr 8;
  6547.           P[o][n + 1] := (P[o][n + 1] * G) shr 8;
  6548.           P[o][n + 2] := (P[o][n + 2] * R) shr 8;
  6549.         end;
  6550.       end;
  6551.     end;
  6552.   end;
  6553. {$IFDEF VER4UP}
  6554.   SetLength(P, 0);
  6555. {$ENDIF}
  6556. end;
  6557.  
  6558. procedure TDIB.DrawOn(Dest: TRect; DestCanvas: TCanvas; Xsrc, Ysrc: Integer);
  6559. {procedure is supplement of original TDIBUltra function}
  6560. begin
  6561.   //if not AsSigned(SrcCanvas) then Exit;
  6562.   if (Xsrc < 0) then
  6563.   begin
  6564.     Dec(Dest.Left, Xsrc);
  6565.     Inc(Dest.Right {Width }, Xsrc);
  6566.     Xsrc := 0
  6567.   end;
  6568.   if (Ysrc < 0) then
  6569.   begin
  6570.     Dec(Dest.Top, Ysrc);
  6571.     Inc(Dest.Bottom {Height}, Ysrc);
  6572.     Ysrc := 0
  6573.   end;
  6574.   BitBlt(DestCanvas.Handle, Dest.Left, Dest.Top, Dest.Right, Dest.Bottom, Self.Canvas.Handle, Xsrc, Ysrc, SRCCOPY);
  6575. end;
  6576.  
  6577. { DXFusion <- }
  6578.  
  6579. { added effect for DIB }
  6580.  
  6581. function IntToByte(i: Integer): Byte;
  6582. begin
  6583.   if i > 255 then Result := 255
  6584.   else if i < 0 then Result := 0
  6585.   else Result := i;
  6586. end;
  6587.  
  6588. {standalone routine}
  6589.  
  6590. procedure TDIB.Darker(Percent: Integer);
  6591. {color to dark in percent}
  6592. var
  6593.   p0: pbytearray;
  6594.   r, g, b, x, y: Integer;
  6595. begin
  6596.   if Self.BitCount <> 24 then Exit;
  6597.   for y := 0 to Self.Height - 1 do
  6598.   begin
  6599.     p0 := Self.ScanLine[y];
  6600.     for x := 0 to Self.Width - 1 do
  6601.     begin
  6602.       r := p0[x * 3];
  6603.       g := p0[x * 3 + 1];
  6604.       b := p0[x * 3 + 2];
  6605.       p0[x * 3] := Round(R * Percent / 100);
  6606.       p0[x * 3 + 1] := Round(G * Percent / 100);
  6607.       p0[x * 3 + 2] := Round(B * Percent / 100);
  6608.     end;
  6609.   end;
  6610. end;
  6611.  
  6612. procedure TDIB.Lighter(Percent: Integer);
  6613. var
  6614.   p0: pbytearray;
  6615.   r, g, b, x, y: Integer;
  6616. begin
  6617.   if Self.BitCount <> 24 then Exit;
  6618.   for y := 0 to Self.Height - 1 do
  6619.   begin
  6620.     p0 := Self.ScanLine[y];
  6621.     for x := 0 to Self.Width - 1 do
  6622.     begin
  6623.       r := p0[x * 3];
  6624.       g := p0[x * 3 + 1];
  6625.       b := p0[x * 3 + 2];
  6626.       p0[x * 3] := Round(R * Percent / 100) + Round(255 - Percent / 100 * 255);
  6627.       p0[x * 3 + 1] := Round(G * Percent / 100) + Round(255 - Percent / 100 * 255);
  6628.       p0[x * 3 + 2] := Round(B * Percent / 100) + Round(255 - Percent / 100 * 255);
  6629.     end;
  6630.   end;
  6631. end;
  6632.  
  6633. procedure TDIB.Darkness(Amount: Integer);
  6634. var
  6635.   p0: pbytearray;
  6636.   r, g, b, x, y: Integer;
  6637. begin
  6638.   if Self.BitCount <> 24 then Exit;
  6639.   for y := 0 to Self.Height - 1 do
  6640.   begin
  6641.     p0 := Self.ScanLine[y];
  6642.     for x := 0 to Self.Width - 1 do
  6643.     begin
  6644.       r := p0[x * 3];
  6645.       g := p0[x * 3 + 1];
  6646.       b := p0[x * 3 + 2];
  6647.       p0[x * 3] := IntToByte(r - ((r) * Amount) div 255);
  6648.       p0[x * 3 + 1] := IntToByte(g - ((g) * Amount) div 255);
  6649.       p0[x * 3 + 2] := IntToByte(b - ((b) * Amount) div 255);
  6650.     end;
  6651.   end;
  6652. end;
  6653.  
  6654. function TrimInt(i, Min, Max: Integer): Integer; {$IFDEF VER9UP}inline;{$ENDIF}
  6655. begin
  6656.   if i > Max then Result := Max
  6657.   else if i < Min then Result := Min
  6658.   else Result := i;
  6659. end;
  6660.  
  6661. procedure TDIB.DoSmoothRotate(Src: TDIB; cx, cy: Integer; Angle: Extended);
  6662. var
  6663.   Top, Bottom, eww, nsw, fx, fy: Extended;
  6664.   cAngle, sAngle: Double;
  6665.   xDiff, yDiff, ifx, ify, px, py, ix, iy, x, y: Integer;
  6666.   nw, ne, sw, se: TBGR;
  6667.   P1, P2, P3: Pbytearray;
  6668. begin
  6669.   Angle := angle;
  6670.   Angle := -Angle * Pi / 180;
  6671.   sAngle := Sin(Angle);
  6672.   cAngle := Cos(Angle);
  6673.   xDiff := (Self.Width - Src.Width) div 2;
  6674.   yDiff := (Self.Height - Src.Height) div 2;
  6675.   for y := 0 to Self.Height - 1 do
  6676.   begin
  6677.     P3 := Self.scanline[y];
  6678.     py := 2 * (y - cy) + 1;
  6679.     for x := 0 to Self.Width - 1 do
  6680.     begin
  6681.       px := 2 * (x - cx) + 1;
  6682.       fx := (((px * cAngle - py * sAngle) - 1) / 2 + cx) - xDiff;
  6683.       fy := (((px * sAngle + py * cAngle) - 1) / 2 + cy) - yDiff;
  6684.       ifx := Round(fx);
  6685.       ify := Round(fy);
  6686.  
  6687.       if (ifx > -1) and (ifx < Src.Width) and (ify > -1) and (ify < Src.Height) then
  6688.       begin
  6689.         eww := fx - ifx;
  6690.         nsw := fy - ify;
  6691.         iy := TrimInt(ify + 1, 0, Src.Height - 1);
  6692.         ix := TrimInt(ifx + 1, 0, Src.Width - 1);
  6693.         P1 := Src.scanline[ify];
  6694.         P2 := Src.scanline[iy];
  6695.         nw.r := P1[ifx * 3];
  6696.         nw.g := P1[ifx * 3 + 1];
  6697.         nw.b := P1[ifx * 3 + 2];
  6698.         ne.r := P1[ix * 3];
  6699.         ne.g := P1[ix * 3 + 1];
  6700.         ne.b := P1[ix * 3 + 2];
  6701.         sw.r := P2[ifx * 3];
  6702.         sw.g := P2[ifx * 3 + 1];
  6703.         sw.b := P2[ifx * 3 + 2];
  6704.         se.r := P2[ix * 3];
  6705.         se.g := P2[ix * 3 + 1];
  6706.         se.b := P2[ix * 3 + 2];
  6707.  
  6708.         Top := nw.b + eww * (ne.b - nw.b);
  6709.         Bottom := sw.b + eww * (se.b - sw.b);
  6710.         P3[x * 3 + 2] := IntToByte(Round(Top + nsw * (Bottom - Top)));
  6711.  
  6712.         Top := nw.g + eww * (ne.g - nw.g);
  6713.         Bottom := sw.g + eww * (se.g - sw.g);
  6714.         P3[x * 3 + 1] := IntToByte(Round(Top + nsw * (Bottom - Top)));
  6715.  
  6716.         Top := nw.r + eww * (ne.r - nw.r);
  6717.         Bottom := sw.r + eww * (se.r - sw.r);
  6718.         P3[x * 3] := IntToByte(Round(Top + nsw * (Bottom - Top)));
  6719.       end;
  6720.     end;
  6721.   end;
  6722. end;
  6723.  
  6724. //----------------------
  6725. //--- 24 bit count routines ----------------------
  6726. //----------------------
  6727.  
  6728. procedure TDIB.DoInvert;
  6729.   procedure PicInvert(src: TDIB);
  6730.   var w, h, x, y: Integer;
  6731.     p: pbytearray;
  6732.   begin
  6733.     w := src.width;
  6734.     h := src.height;
  6735.     src.BitCount := 24;
  6736.     for y := 0 to h - 1 do
  6737.     begin
  6738.       p := src.scanline[y];
  6739.       for x := 0 to w - 1 do
  6740.       begin
  6741.         p[x * 3] := not p[x * 3];
  6742.         p[x * 3 + 1] := not p[x * 3 + 1];
  6743.         p[x * 3 + 2] := not p[x * 3 + 2];
  6744.       end;
  6745.     end;
  6746.   end;
  6747. begin
  6748.   PicInvert(Self);
  6749. end;
  6750.  
  6751. procedure TDIB.DoAddColorNoise(Amount: Integer);
  6752.   procedure AddColorNoise(var clip: TDIB; Amount: Integer);
  6753.   var
  6754.     p0: pbytearray;
  6755.     x, y, r, g, b: Integer;
  6756.   begin
  6757.     for y := 0 to clip.Height - 1 do
  6758.     begin
  6759.       p0 := clip.ScanLine[y];
  6760.       for x := 0 to clip.Width - 1 do
  6761.       begin
  6762.         r := p0[x * 3] + (Random(Amount) - (Amount shr 1));
  6763.         g := p0[x * 3 + 1] + (Random(Amount) - (Amount shr 1));
  6764.         b := p0[x * 3 + 2] + (Random(Amount) - (Amount shr 1));
  6765.         p0[x * 3] := IntToByte(r);
  6766.         p0[x * 3 + 1] := IntToByte(g);
  6767.         p0[x * 3 + 2] := IntToByte(b);
  6768.       end;
  6769.     end;
  6770.   end;
  6771. var BB: TDIB;
  6772. begin
  6773.   BB := TDIB.Create;
  6774.   BB.BitCount := 24;
  6775.   BB.Assign(Self);
  6776.   AddColorNoise(bb, Amount);
  6777.   Self.Assign(BB);
  6778.   BB.Free;
  6779. end;
  6780.  
  6781. procedure TDIB.DoAddMonoNoise(Amount: Integer);
  6782.   procedure _AddMonoNoise(var clip: TDIB; Amount: Integer);
  6783.   var
  6784.     p0: pbytearray;
  6785.     x, y, a, r, g, b: Integer;
  6786.   begin
  6787.     for y := 0 to clip.Height - 1 do
  6788.     begin
  6789.       p0 := clip.scanline[y];
  6790.       for x := 0 to clip.Width - 1 do
  6791.       begin
  6792.         a := Random(Amount) - (Amount shr 1);
  6793.         r := p0[x * 3] + a;
  6794.         g := p0[x * 3 + 1] + a;
  6795.         b := p0[x * 3 + 2] + a;
  6796.         p0[x * 3] := IntToByte(r);
  6797.         p0[x * 3 + 1] := IntToByte(g);
  6798.         p0[x * 3 + 2] := IntToByte(b);
  6799.       end;
  6800.     end;
  6801.   end;
  6802. var BB: TDIB;
  6803. begin
  6804.   BB := TDIB.Create;
  6805.   BB.BitCount := 24;
  6806.   BB.Assign(Self);
  6807.   _AddMonoNoise(bb, Amount);
  6808.   Self.Assign(BB);
  6809.   BB.Free;
  6810. end;
  6811.  
  6812. procedure TDIB.DoAntiAlias;
  6813.   procedure AntiAlias(clip: TDIB);
  6814.     procedure AntiAliasRect(clip: TDIB; XOrigin, YOrigin, XFinal, YFinal: Integer);
  6815.     var Memo, x, y: Integer; (* Composantes primaires des points environnants *)
  6816.       p0, p1, p2: pbytearray;
  6817.     begin
  6818.       if XFinal < XOrigin then begin Memo := XOrigin; XOrigin := XFinal; XFinal := Memo; end; (* Inversion des valeurs   *)
  6819.       if YFinal < YOrigin then begin Memo := YOrigin; YOrigin := YFinal; YFinal := Memo; end; (* si diff‚rence n‚gative*)
  6820.       XOrigin := max(1, XOrigin);
  6821.       YOrigin := max(1, YOrigin);
  6822.       XFinal := min(clip.width - 2, XFinal);
  6823.       YFinal := min(clip.height - 2, YFinal);
  6824.       clip.BitCount := 24;
  6825.       for y := YOrigin to YFinal do
  6826.       begin
  6827.         p0 := clip.ScanLine[y - 1];
  6828.         p1 := clip.scanline[y];
  6829.         p2 := clip.ScanLine[y + 1];
  6830.         for x := XOrigin to XFinal do
  6831.         begin
  6832.           p1[x * 3] := (p0[x * 3] + p2[x * 3] + p1[(x - 1) * 3] + p1[(x + 1) * 3]) div 4;
  6833.           p1[x * 3 + 1] := (p0[x * 3 + 1] + p2[x * 3 + 1] + p1[(x - 1) * 3 + 1] + p1[(x + 1) * 3 + 1]) div 4;
  6834.           p1[x * 3 + 2] := (p0[x * 3 + 2] + p2[x * 3 + 2] + p1[(x - 1) * 3 + 2] + p1[(x + 1) * 3 + 2]) div 4;
  6835.         end;
  6836.       end;
  6837.     end;
  6838.   begin
  6839.     AntiAliasRect(clip, 0, 0, clip.width, clip.height);
  6840.   end;
  6841. begin
  6842.   AntiAlias(Self);
  6843. end;
  6844.  
  6845. procedure TDIB.DoContrast(Amount: Integer);
  6846.   procedure _Contrast(var clip: TDIB; Amount: Integer);
  6847.   var
  6848.     p0: pbytearray;
  6849.     rg, gg, bg, r, g, b, x, y: Integer;
  6850.   begin
  6851.     for y := 0 to clip.Height - 1 do
  6852.     begin
  6853.       p0 := clip.scanline[y];
  6854.       for x := 0 to clip.Width - 1 do
  6855.       begin
  6856.         r := p0[x * 3];
  6857.         g := p0[x * 3 + 1];
  6858.         b := p0[x * 3 + 2];
  6859.         rg := (Abs(127 - r) * Amount) div 255;
  6860.         gg := (Abs(127 - g) * Amount) div 255;
  6861.         bg := (Abs(127 - b) * Amount) div 255;
  6862.         if r > 127 then r := r + rg else r := r - rg;
  6863.         if g > 127 then g := g + gg else g := g - gg;
  6864.         if b > 127 then b := b + bg else b := b - bg;
  6865.         p0[x * 3] := IntToByte(r);
  6866.         p0[x * 3 + 1] := IntToByte(g);
  6867.         p0[x * 3 + 2] := IntToByte(b);
  6868.       end;
  6869.     end;
  6870.   end;
  6871. var BB: TDIB;
  6872. begin
  6873.   BB := TDIB.Create;
  6874.   BB.BitCount := 24;
  6875.   BB.Assign(Self);
  6876.   _Contrast(bb, Amount);
  6877.   Self.Assign(BB);
  6878.   BB.Free;
  6879. end;
  6880.  
  6881. procedure TDIB.DoFishEye(Amount: Integer);
  6882.   procedure _FishEye(var Bmp, Dst: TDIB; Amount: Extended);
  6883.   var
  6884.     xmid, ymid: Single;
  6885.     fx, fy: Single;
  6886.     r1, r2: Single;
  6887.     ifx, ify: Integer;
  6888.     dx, dy: Single;
  6889.     rmax: Single;
  6890.     ty, tx: Integer;
  6891.     weight_x, weight_y: array[0..1] of Single;
  6892.     weight: Single;
  6893.     new_red, new_green: Integer;
  6894.     new_blue: Integer;
  6895.     total_red, total_green: Single;
  6896.     total_blue: Single;
  6897.     ix, iy: Integer;
  6898.     sli, slo: PByteArray;
  6899.   begin
  6900.     xmid := Bmp.Width / 2;
  6901.     ymid := Bmp.Height / 2;
  6902.     rmax := Dst.Width * Amount;
  6903.  
  6904.     for ty := 0 to Dst.Height - 1 do
  6905.     begin
  6906.       for tx := 0 to Dst.Width - 1 do
  6907.       begin
  6908.         dx := tx - xmid;
  6909.         dy := ty - ymid;
  6910.         r1 := Sqrt(dx * dx + dy * dy);
  6911.         if r1 = 0 then
  6912.         begin
  6913.           fx := xmid;
  6914.           fy := ymid;
  6915.         end
  6916.         else
  6917.         begin
  6918.           r2 := rmax / 2 * (1 / (1 - r1 / rmax) - 1);
  6919.           fx := dx * r2 / r1 + xmid;
  6920.           fy := dy * r2 / r1 + ymid;
  6921.         end;
  6922.         ify := Trunc(fy);
  6923.         ifx := Trunc(fx);
  6924.         // Calculate the weights.
  6925.         if fy >= 0 then
  6926.         begin
  6927.           weight_y[1] := fy - ify;
  6928.           weight_y[0] := 1 - weight_y[1];
  6929.         end
  6930.         else
  6931.         begin
  6932.           weight_y[0] := -(fy - ify);
  6933.           weight_y[1] := 1 - weight_y[0];
  6934.         end;
  6935.         if fx >= 0 then
  6936.         begin
  6937.           weight_x[1] := fx - ifx;
  6938.           weight_x[0] := 1 - weight_x[1];
  6939.         end
  6940.         else
  6941.         begin
  6942.           weight_x[0] := -(fx - ifx);
  6943.           Weight_x[1] := 1 - weight_x[0];
  6944.         end;
  6945.  
  6946.         if ifx < 0 then
  6947.           ifx := Bmp.Width - 1 - (-ifx mod Bmp.Width)
  6948.         else if ifx > Bmp.Width - 1 then
  6949.           ifx := ifx mod Bmp.Width;
  6950.         if ify < 0 then
  6951.           ify := Bmp.Height - 1 - (-ify mod Bmp.Height)
  6952.         else if ify > Bmp.Height - 1 then
  6953.           ify := ify mod Bmp.Height;
  6954.  
  6955.         total_red := 0.0;
  6956.         total_green := 0.0;
  6957.         total_blue := 0.0;
  6958.         for ix := 0 to 1 do
  6959.         begin
  6960.           for iy := 0 to 1 do
  6961.           begin
  6962.             if ify + iy < Bmp.Height then
  6963.               sli := Bmp.scanline[ify + iy]
  6964.             else
  6965.               sli := Bmp.scanline[Bmp.Height - ify - iy];
  6966.             if ifx + ix < Bmp.Width then
  6967.             begin
  6968.               new_red := sli[(ifx + ix) * 3];
  6969.               new_green := sli[(ifx + ix) * 3 + 1];
  6970.               new_blue := sli[(ifx + ix) * 3 + 2];
  6971.             end
  6972.             else
  6973.             begin
  6974.               new_red := sli[(Bmp.Width - ifx - ix) * 3];
  6975.               new_green := sli[(Bmp.Width - ifx - ix) * 3 + 1];
  6976.               new_blue := sli[(Bmp.Width - ifx - ix) * 3 + 2];
  6977.             end;
  6978.             weight := weight_x[ix] * weight_y[iy];
  6979.             total_red := total_red + new_red * weight;
  6980.             total_green := total_green + new_green * weight;
  6981.             total_blue := total_blue + new_blue * weight;
  6982.           end;
  6983.         end;
  6984.         slo := Dst.scanline[ty];
  6985.         slo[tx * 3] := Round(total_red);
  6986.         slo[tx * 3 + 1] := Round(total_green);
  6987.         slo[tx * 3 + 2] := Round(total_blue);
  6988.  
  6989.       end;
  6990.     end;
  6991.   end;
  6992. var BB1, BB2: TDIB;
  6993. begin
  6994.   BB1 := TDIB.Create;
  6995.   BB1.BitCount := 24;
  6996.   BB1.Assign(Self);
  6997.   BB2 := TDIB.Create;
  6998.   BB2.BitCount := 24;
  6999.   BB2.Assign(BB1);
  7000.   _FishEye(BB1, BB2, Amount);
  7001.   Self.Assign(BB2);
  7002.   BB1.Free;
  7003.   BB2.Free;
  7004. end;
  7005.  
  7006. procedure TDIB.DoGrayScale;
  7007.   procedure GrayScale(var clip: TDIB);
  7008.   var
  7009.     p0: pbytearray;
  7010.     Gray, x, y: Integer;
  7011.   begin
  7012.     for y := 0 to clip.Height - 1 do
  7013.     begin
  7014.       p0 := clip.scanline[y];
  7015.       for x := 0 to clip.Width - 1 do
  7016.       begin
  7017.         Gray := Round(p0[x * 3] * 0.3 + p0[x * 3 + 1] * 0.59 + p0[x * 3 + 2] * 0.11);
  7018.         p0[x * 3] := Gray;
  7019.         p0[x * 3 + 1] := Gray;
  7020.         p0[x * 3 + 2] := Gray;
  7021.       end;
  7022.     end;
  7023.   end;
  7024. var BB: TDIB;
  7025. begin
  7026.   BB := TDIB.Create;
  7027.   BB.BitCount := 24;
  7028.   BB.Assign(Self);
  7029.   GrayScale(BB);
  7030.   Self.Assign(BB);
  7031.   BB.Free;
  7032. end;
  7033.  
  7034. procedure TDIB.DoLightness(Amount: Integer);
  7035.   procedure _Lightness(var clip: TDIB; Amount: Integer);
  7036.   var
  7037.     p0: pbytearray;
  7038.     r, g, b, x, y: Integer;
  7039.   begin
  7040.     for y := 0 to clip.Height - 1 do
  7041.     begin
  7042.       p0 := clip.scanline[y];
  7043.       for x := 0 to clip.Width - 1 do
  7044.       begin
  7045.         r := p0[x * 3];
  7046.         g := p0[x * 3 + 1];
  7047.         b := p0[x * 3 + 2];
  7048.         p0[x * 3] := IntToByte(r + ((255 - r) * Amount) div 255);
  7049.         p0[x * 3 + 1] := IntToByte(g + ((255 - g) * Amount) div 255);
  7050.         p0[x * 3 + 2] := IntToByte(b + ((255 - b) * Amount) div 255);
  7051.       end;
  7052.     end;
  7053.   end;
  7054. var BB: TDIB;
  7055. begin
  7056.   BB := TDIB.Create;
  7057.   BB.BitCount := 24;
  7058.   BB.Assign(Self);
  7059.   _Lightness(BB, Amount);
  7060.   Self.Assign(BB);
  7061.   BB.Free;
  7062. end;
  7063.  
  7064. procedure TDIB.DoDarkness(Amount: Integer);
  7065. var BB: TDIB;
  7066. begin
  7067.   BB := TDIB.Create;
  7068.   BB.BitCount := 24;
  7069.   BB.Assign(Self);
  7070.   BB.Darkness(Amount);
  7071.   Self.Assign(BB);
  7072.   BB.Free;
  7073. end;
  7074.  
  7075. procedure TDIB.DoSaturation(Amount: Integer);
  7076.   procedure _Saturation(var clip: TDIB; Amount: Integer);
  7077.   var
  7078.     p0: pbytearray;
  7079.     Gray, r, g, b, x, y: Integer;
  7080.   begin
  7081.     for y := 0 to clip.Height - 1 do
  7082.     begin
  7083.       p0 := clip.scanline[y];
  7084.       for x := 0 to clip.Width - 1 do
  7085.       begin
  7086.         r := p0[x * 3];
  7087.         g := p0[x * 3 + 1];
  7088.         b := p0[x * 3 + 2];
  7089.         Gray := (r + g + b) div 3;
  7090.         p0[x * 3] := IntToByte(Gray + (((r - Gray) * Amount) div 255));
  7091.         p0[x * 3 + 1] := IntToByte(Gray + (((g - Gray) * Amount) div 255));
  7092.         p0[x * 3 + 2] := IntToByte(Gray + (((b - Gray) * Amount) div 255));
  7093.       end;
  7094.     end;
  7095.   end;
  7096. var BB: TDIB;
  7097. begin
  7098.   BB := TDIB.Create;
  7099.   BB.BitCount := 24;
  7100.   BB.Assign(Self);
  7101.   _Saturation(BB, Amount);
  7102.   Self.Assign(BB);
  7103.   BB.Free;
  7104. end;
  7105.  
  7106. procedure TDIB.DoSplitBlur(Amount: Integer);
  7107.   {NOTE: For a gaussian blur is amount 3}
  7108.   procedure _SplitBlur(var clip: TDIB; Amount: Integer);
  7109.   var
  7110.     p0, p1, p2: pbytearray;
  7111.     cx, x, y: Integer;
  7112.     Buf: array[0..3, 0..2] of byte;
  7113.   begin
  7114.     if Amount = 0 then Exit;
  7115.     for y := 0 to clip.Height - 1 do
  7116.     begin
  7117.       p0 := clip.scanline[y];
  7118.       if y - Amount < 0 then p1 := clip.scanline[y]
  7119.       else {y-Amount>0} p1 := clip.ScanLine[y - Amount];
  7120.       if y + Amount < clip.Height then p2 := clip.ScanLine[y + Amount]
  7121.       else {y+Amount>=Height} p2 := clip.ScanLine[clip.Height - y];
  7122.  
  7123.       for x := 0 to clip.Width - 1 do
  7124.       begin
  7125.         if x - Amount < 0 then cx := x
  7126.         else {x-Amount>0} cx := x - Amount;
  7127.         Buf[0, 0] := p1[cx * 3];
  7128.         Buf[0, 1] := p1[cx * 3 + 1];
  7129.         Buf[0, 2] := p1[cx * 3 + 2];
  7130.         Buf[1, 0] := p2[cx * 3];
  7131.         Buf[1, 1] := p2[cx * 3 + 1];
  7132.         Buf[1, 2] := p2[cx * 3 + 2];
  7133.         if x + Amount < clip.Width then cx := x + Amount
  7134.         else {x+Amount>=Width} cx := clip.Width - x;
  7135.         Buf[2, 0] := p1[cx * 3];
  7136.         Buf[2, 1] := p1[cx * 3 + 1];
  7137.         Buf[2, 2] := p1[cx * 3 + 2];
  7138.         Buf[3, 0] := p2[cx * 3];
  7139.         Buf[3, 1] := p2[cx * 3 + 1];
  7140.         Buf[3, 2] := p2[cx * 3 + 2];
  7141.         p0[x * 3] := (Buf[0, 0] + Buf[1, 0] + Buf[2, 0] + Buf[3, 0]) shr 2;
  7142.         p0[x * 3 + 1] := (Buf[0, 1] + Buf[1, 1] + Buf[2, 1] + Buf[3, 1]) shr 2;
  7143.         p0[x * 3 + 2] := (Buf[0, 2] + Buf[1, 2] + Buf[2, 2] + Buf[3, 2]) shr 2;
  7144.       end;
  7145.     end;
  7146.   end;
  7147. var BB: TDIB;
  7148. begin
  7149.   BB := TDIB.Create;
  7150.   BB.BitCount := 24;
  7151.   BB.Assign(Self);
  7152.   _SplitBlur(BB, Amount);
  7153.   Self.Assign(BB);
  7154.   BB.Free;
  7155. end;
  7156.  
  7157. procedure TDIB.DoGaussianBlur(Amount: Integer);
  7158. var BB: TDIB;
  7159. begin
  7160.   BB := TDIB.Create;
  7161.   BB.BitCount := 24;
  7162.   BB.BitCount := 24;
  7163.   BB.Assign(Self);
  7164.   GaussianBlur(BB, Amount);
  7165.   Self.Assign(BB);
  7166.   BB.Free;
  7167. end;
  7168.  
  7169. procedure TDIB.DoMosaic(Size: Integer);
  7170.   procedure Mosaic(var Bm: TDIB; size: Integer);
  7171.   var
  7172.     x, y, i, j: Integer;
  7173.     p1, p2: pbytearray;
  7174.     r, g, b: byte;
  7175.   begin
  7176.     y := 0;
  7177.     repeat
  7178.       p1 := bm.scanline[y];
  7179.       repeat
  7180.         j := 1;
  7181.         repeat
  7182.           p2 := bm.scanline[y];
  7183.           x := 0;
  7184.           repeat
  7185.             r := p1[x * 3];
  7186.             g := p1[x * 3 + 1];
  7187.             b := p1[x * 3 + 2];
  7188.             i := 1;
  7189.             repeat
  7190.               p2[x * 3] := r;
  7191.               p2[x * 3 + 1] := g;
  7192.               p2[x * 3 + 2] := b;
  7193.               inc(x);
  7194.               inc(i);
  7195.             until (x >= bm.width) or (i > size);
  7196.           until x >= bm.width;
  7197.           inc(j);
  7198.           inc(y);
  7199.         until (y >= bm.height) or (j > size);
  7200.       until (y >= bm.height) or (x >= bm.width);
  7201.     until y >= bm.height;
  7202.   end;
  7203. var BB: TDIB;
  7204. begin
  7205.   BB := TDIB.Create;
  7206.   BB.BitCount := 24;
  7207.   BB.Assign(Self);
  7208.   Mosaic(BB, Size);
  7209.   Self.Assign(BB);
  7210.   BB.Free;
  7211. end;
  7212.  
  7213. procedure TDIB.DoTwist(Amount: Integer);
  7214.   procedure _Twist(var Bmp, Dst: TDIB; Amount: Integer);
  7215.   var
  7216.     fxmid, fymid: Single;
  7217.     txmid, tymid: Single;
  7218.     fx, fy: Single;
  7219.     tx2, ty2: Single;
  7220.     r: Single;
  7221.     theta: Single;
  7222.     ifx, ify: Integer;
  7223.     dx, dy: Single;
  7224.     OFFSET: Single;
  7225.     ty, tx: Integer;
  7226.     weight_x, weight_y: array[0..1] of Single;
  7227.     weight: Single;
  7228.     new_red, new_green: Integer;
  7229.     new_blue: Integer;
  7230.     total_red, total_green: Single;
  7231.     total_blue: Single;
  7232.     ix, iy: Integer;
  7233.     sli, slo: PBytearray;
  7234.  
  7235.     function ArcTan2(xt, yt: Single): Single; {$IFDEF VER9UP}inline;{$ENDIF}
  7236.     begin
  7237.       if xt = 0 then
  7238.         if yt > 0 then
  7239.           Result := Pi / 2
  7240.         else
  7241.           Result := -(Pi / 2)
  7242.       else
  7243.       begin
  7244.         Result := ArcTan(yt / xt);
  7245.         if xt < 0 then
  7246.           Result := Pi + ArcTan(yt / xt);
  7247.       end;
  7248.     end;
  7249.  
  7250.   begin
  7251.     OFFSET := -(Pi / 2);
  7252.     dx := Bmp.Width - 1;
  7253.     dy := Bmp.Height - 1;
  7254.     r := Sqrt(dx * dx + dy * dy);
  7255.     tx2 := r;
  7256.     ty2 := r;
  7257.     txmid := (Bmp.Width - 1) / 2; //Adjust these to move center of rotation
  7258.     tymid := (Bmp.Height - 1) / 2; //Adjust these to move ......
  7259.     fxmid := (Bmp.Width - 1) / 2;
  7260.     fymid := (Bmp.Height - 1) / 2;
  7261.     if tx2 >= Bmp.Width then tx2 := Bmp.Width - 1;
  7262.     if ty2 >= Bmp.Height then ty2 := Bmp.Height - 1;
  7263.  
  7264.     for ty := 0 to Round(ty2) do
  7265.     begin
  7266.       for tx := 0 to Round(tx2) do
  7267.       begin
  7268.         dx := tx - txmid;
  7269.         dy := ty - tymid;
  7270.         r := Sqrt(dx * dx + dy * dy);
  7271.         if r = 0 then
  7272.         begin
  7273.           fx := 0;
  7274.           fy := 0;
  7275.         end
  7276.         else
  7277.         begin
  7278.           theta := ArcTan2(dx, dy) - r / Amount - OFFSET;
  7279.           fx := r * Cos(theta);
  7280.           fy := r * Sin(theta);
  7281.         end;
  7282.         fx := fx + fxmid;
  7283.         fy := fy + fymid;
  7284.  
  7285.         ify := Trunc(fy);
  7286.         ifx := Trunc(fx);
  7287.                   // Calculate the weights.
  7288.         if fy >= 0 then
  7289.         begin
  7290.           weight_y[1] := fy - ify;
  7291.           weight_y[0] := 1 - weight_y[1];
  7292.         end
  7293.         else
  7294.         begin
  7295.           weight_y[0] := -(fy - ify);
  7296.           weight_y[1] := 1 - weight_y[0];
  7297.         end;
  7298.         if fx >= 0 then
  7299.         begin
  7300.           weight_x[1] := fx - ifx;
  7301.           weight_x[0] := 1 - weight_x[1];
  7302.         end
  7303.         else
  7304.         begin
  7305.           weight_x[0] := -(fx - ifx);
  7306.           Weight_x[1] := 1 - weight_x[0];
  7307.         end;
  7308.  
  7309.         if ifx < 0 then
  7310.           ifx := Bmp.Width - 1 - (-ifx mod Bmp.Width)
  7311.         else if ifx > Bmp.Width - 1 then
  7312.           ifx := ifx mod Bmp.Width;
  7313.         if ify < 0 then
  7314.           ify := Bmp.Height - 1 - (-ify mod Bmp.Height)
  7315.         else if ify > Bmp.Height - 1 then
  7316.           ify := ify mod Bmp.Height;
  7317.  
  7318.         total_red := 0.0;
  7319.         total_green := 0.0;
  7320.         total_blue := 0.0;
  7321.         for ix := 0 to 1 do
  7322.         begin
  7323.           for iy := 0 to 1 do
  7324.           begin
  7325.             if ify + iy < Bmp.Height then
  7326.               sli := Bmp.scanline[ify + iy]
  7327.             else
  7328.               sli := Bmp.scanline[Bmp.Height - ify - iy];
  7329.             if ifx + ix < Bmp.Width then
  7330.             begin
  7331.               new_red := sli[(ifx + ix) * 3];
  7332.               new_green := sli[(ifx + ix) * 3 + 1];
  7333.               new_blue := sli[(ifx + ix) * 3 + 2];
  7334.             end
  7335.             else
  7336.             begin
  7337.               new_red := sli[(Bmp.Width - ifx - ix) * 3];
  7338.               new_green := sli[(Bmp.Width - ifx - ix) * 3 + 1];
  7339.               new_blue := sli[(Bmp.Width - ifx - ix) * 3 + 2];
  7340.             end;
  7341.             weight := weight_x[ix] * weight_y[iy];
  7342.             total_red := total_red + new_red * weight;
  7343.             total_green := total_green + new_green * weight;
  7344.             total_blue := total_blue + new_blue * weight;
  7345.           end;
  7346.         end;
  7347.         slo := Dst.scanline[ty];
  7348.         slo[tx * 3] := Round(total_red);
  7349.         slo[tx * 3 + 1] := Round(total_green);
  7350.         slo[tx * 3 + 2] := Round(total_blue);
  7351.       end;
  7352.     end;
  7353.   end;
  7354. var BB1, BB2: TDIB;
  7355. begin
  7356.   BB1 := TDIB.Create;
  7357.   BB1.BitCount := 24;
  7358.   BB1.Assign(Self);
  7359.   BB2 := TDIB.Create;
  7360.   BB2.BitCount := 24;
  7361.   BB2.Assign(BB1);
  7362.   _Twist(BB1, BB2, Amount);
  7363.   Self.Assign(BB2);
  7364.   BB1.Free;
  7365.   BB2.Free;
  7366. end;
  7367.  
  7368. procedure TDIB.DoTrace(Amount: Integer);
  7369.   procedure Trace(src: TDIB; intensity: Integer);
  7370.   var
  7371.     x, y, i: Integer;
  7372.     P1, P2, P3, P4: PByteArray;
  7373.     tb, TraceB: byte;
  7374.     hasb: Boolean;
  7375.     bitmap: TDIB;
  7376.   begin
  7377.     bitmap := TDIB.create;
  7378.     bitmap.width := src.width;
  7379.     bitmap.height := src.height;
  7380.     bitmap.canvas.draw(0, 0, src);
  7381.     bitmap.BitCount := 8;
  7382.     src.BitCount := 24;
  7383.     hasb := false;
  7384.     TraceB := $00; tb := 0;
  7385.     for i := 1 to Intensity do
  7386.     begin
  7387.       for y := 0 to BitMap.height - 2 do
  7388.       begin
  7389.         P1 := BitMap.ScanLine[y];
  7390.         P2 := BitMap.scanline[y + 1];
  7391.         P3 := src.scanline[y];
  7392.         P4 := src.scanline[y + 1];
  7393.         x := 0;
  7394.         repeat
  7395.           if p1[x] <> p1[x + 1] then
  7396.           begin
  7397.             if not hasb then
  7398.             begin
  7399.               tb := p1[x + 1];
  7400.               hasb := true;
  7401.               p3[x * 3] := TraceB;
  7402.               p3[x * 3 + 1] := TraceB;
  7403.               p3[x * 3 + 2] := TraceB;
  7404.             end
  7405.             else
  7406.             begin
  7407.               if p1[x] <> tb then
  7408.               begin
  7409.                 p3[x * 3] := TraceB;
  7410.                 p3[x * 3 + 1] := TraceB;
  7411.                 p3[x * 3 + 2] := TraceB;
  7412.               end
  7413.               else
  7414.               begin
  7415.                 p3[(x + 1) * 3] := TraceB;
  7416.                 p3[(x + 1) * 3 + 1] := TraceB;
  7417.                 p3[(x + 1) * 3 + 1] := TraceB;
  7418.               end;
  7419.             end;
  7420.           end;
  7421.           if p1[x] <> p2[x] then
  7422.           begin
  7423.             if not hasb then
  7424.             begin
  7425.               tb := p2[x];
  7426.               hasb := true;
  7427.               p3[x * 3] := TraceB;
  7428.               p3[x * 3 + 1] := TraceB;
  7429.               p3[x * 3 + 2] := TraceB;
  7430.             end
  7431.             else
  7432.             begin
  7433.               if p1[x] <> tb then
  7434.               begin
  7435.                 p3[x * 3] := TraceB;
  7436.                 p3[x * 3 + 1] := TraceB;
  7437.                 p3[x * 3 + 2] := TraceB;
  7438.               end
  7439.               else
  7440.               begin
  7441.                 p4[x * 3] := TraceB;
  7442.                 p4[x * 3 + 1] := TraceB;
  7443.                 p4[x * 3 + 2] := TraceB;
  7444.               end;
  7445.             end;
  7446.           end;
  7447.           inc(x);
  7448.         until x >= (BitMap.width - 2);
  7449.       end;
  7450.       if i > 1 then
  7451.         for y := BitMap.height - 1 downto 1 do
  7452.         begin
  7453.           P1 := BitMap.ScanLine[y];
  7454.           P2 := BitMap.scanline[y - 1];
  7455.           P3 := src.scanline[y];
  7456.           P4 := src.scanline[y - 1];
  7457.           x := Bitmap.width - 1;
  7458.           repeat
  7459.             if p1[x] <> p1[x - 1] then
  7460.             begin
  7461.               if not hasb then
  7462.               begin
  7463.                 tb := p1[x - 1];
  7464.                 hasb := true;
  7465.                 p3[x * 3] := TraceB;
  7466.                 p3[x * 3 + 1] := TraceB;
  7467.                 p3[x * 3 + 2] := TraceB;
  7468.               end
  7469.               else
  7470.               begin
  7471.                 if p1[x] <> tb then
  7472.                 begin
  7473.                   p3[x * 3] := TraceB;
  7474.                   p3[x * 3 + 1] := TraceB;
  7475.                   p3[x * 3 + 2] := TraceB;
  7476.                 end
  7477.                 else
  7478.                 begin
  7479.                   p3[(x - 1) * 3] := TraceB;
  7480.                   p3[(x - 1) * 3 + 1] := TraceB;
  7481.                   p3[(x - 1) * 3 + 2] := TraceB;
  7482.                 end;
  7483.               end;
  7484.             end;
  7485.             if p1[x] <> p2[x] then
  7486.             begin
  7487.               if not hasb then
  7488.               begin
  7489.                 tb := p2[x];
  7490.                 hasb := true;
  7491.                 p3[x * 3] := TraceB;
  7492.                 p3[x * 3 + 1] := TraceB;
  7493.                 p3[x * 3 + 2] := TraceB;
  7494.               end
  7495.               else
  7496.               begin
  7497.                 if p1[x] <> tb then
  7498.                 begin
  7499.                   p3[x * 3] := TraceB;
  7500.                   p3[x * 3 + 1] := TraceB;
  7501.                   p3[x * 3 + 2] := TraceB;
  7502.                 end
  7503.                 else
  7504.                 begin
  7505.                   p4[x * 3] := TraceB;
  7506.                   p4[x * 3 + 1] := TraceB;
  7507.                   p4[x * 3 + 2] := TraceB;
  7508.                 end;
  7509.               end;
  7510.             end;
  7511.             dec(x);
  7512.           until x <= 1;
  7513.         end;
  7514.     end;
  7515.     bitmap.free;
  7516.   end;
  7517. var BB1, BB2: TDIB;
  7518. begin
  7519.   BB1 := TDIB.Create;
  7520.   BB1.BitCount := 24;
  7521.   BB1.Assign(Self);
  7522.   BB2 := TDIB.Create;
  7523.   BB2.BitCount := 24;
  7524.   BB2.Assign(BB1);
  7525.   Trace(BB2, Amount);
  7526.   Self.Assign(BB2);
  7527.   BB1.Free;
  7528.   BB2.Free;
  7529. end;
  7530.  
  7531. procedure TDIB.DoSplitlight(Amount: Integer);
  7532.   procedure Splitlight(var clip: TDIB; amount: Integer);
  7533.   var
  7534.     x, y, i: Integer;
  7535.     p1: pbytearray;
  7536.  
  7537.     function sinpixs(a: Integer): Integer;
  7538.     begin
  7539.       result := variant(sin(a / 255 * pi / 2) * 255);
  7540.     end;
  7541.   begin
  7542.     for i := 1 to amount do
  7543.       for y := 0 to clip.height - 1 do
  7544.       begin
  7545.         p1 := clip.scanline[y];
  7546.         for x := 0 to clip.width - 1 do
  7547.         begin
  7548.           p1[x * 3] := sinpixs(p1[x * 3]);
  7549.           p1[x * 3 + 1] := sinpixs(p1[x * 3 + 1]);
  7550.           p1[x * 3 + 2] := sinpixs(p1[x * 3 + 2]);
  7551.         end;
  7552.       end;
  7553.   end;
  7554. var BB1 {,BB2}: TDIB;
  7555. begin
  7556.   BB1 := TDIB.Create;
  7557.   BB1.BitCount := 24;
  7558.   BB1.Assign(Self);
  7559. //  BB2 := TDIB.Create;
  7560. //  BB2.BitCount := 24;
  7561. //  BB2.Assign (BB1);
  7562.   Splitlight(BB1, Amount);
  7563.   Self.Assign(BB1);
  7564.   BB1.Free;
  7565. //  BB2.Free;
  7566. end;
  7567.  
  7568. procedure TDIB.DoTile(Amount: Integer);
  7569.   procedure SmoothResize(var Src, Dst: TDIB);
  7570.   var
  7571.     x, y, xP, yP,
  7572.       yP2, xP2: Integer;
  7573.     Read, Read2: PByteArray;
  7574.     t, z, z2, iz2: Integer;
  7575.     pc: PBytearray;
  7576.     w1, w2, w3, w4: Integer;
  7577.     Col1r, col1g, col1b, Col2r, col2g, col2b: byte;
  7578.   begin
  7579.     xP2 := ((src.Width - 1) shl 15) div Dst.Width;
  7580.     yP2 := ((src.Height - 1) shl 15) div Dst.Height;
  7581.     yP := 0;
  7582.     for y := 0 to Dst.Height - 1 do
  7583.     begin
  7584.       xP := 0;
  7585.       Read := src.ScanLine[yP shr 15];
  7586.       if yP shr 16 < src.Height - 1 then
  7587.         Read2 := src.ScanLine[yP shr 15 + 1]
  7588.       else
  7589.         Read2 := src.ScanLine[yP shr 15];
  7590.       pc := Dst.scanline[y];
  7591.       z2 := yP and $7FFF;
  7592.       iz2 := $8000 - z2;
  7593.       for x := 0 to Dst.Width - 1 do
  7594.       begin
  7595.         t := xP shr 15;
  7596.         Col1r := Read[t * 3];
  7597.         Col1g := Read[t * 3 + 1];
  7598.         Col1b := Read[t * 3 + 2];
  7599.         Col2r := Read2[t * 3];
  7600.         Col2g := Read2[t * 3 + 1];
  7601.         Col2b := Read2[t * 3 + 2];
  7602.         z := xP and $7FFF;
  7603.         w2 := (z * iz2) shr 15;
  7604.         w1 := iz2 - w2;
  7605.         w4 := (z * z2) shr 15;
  7606.         w3 := z2 - w4;
  7607.         pc[x * 3 + 2] :=
  7608.           (Col1b * w1 + Read[(t + 1) * 3 + 2] * w2 +
  7609.           Col2b * w3 + Read2[(t + 1) * 3 + 2] * w4) shr 15;
  7610.         pc[x * 3 + 1] :=
  7611.           (Col1g * w1 + Read[(t + 1) * 3 + 1] * w2 +
  7612.           Col2g * w3 + Read2[(t + 1) * 3 + 1] * w4) shr 15;
  7613.         pc[x * 3] :=
  7614.           (Col1r * w1 + Read2[(t + 1) * 3] * w2 +
  7615.           Col2r * w3 + Read2[(t + 1) * 3] * w4) shr 15;
  7616.         Inc(xP, xP2);
  7617.       end;
  7618.       Inc(yP, yP2);
  7619.     end;
  7620.   end;
  7621.   procedure Tile(src, dst: TDIB; amount: Integer);
  7622.   var
  7623.     w, h, w2, h2, i, j: Integer;
  7624.     bm: TDIB;
  7625.   begin
  7626.     w := src.width;
  7627.     h := src.height;
  7628.     dst.width := w;
  7629.     dst.height := h;
  7630.     dst.Canvas.draw(0, 0, src);
  7631.     if (amount <= 0) or ((w div amount) < 5) or ((h div amount) < 5) then exit;
  7632.     h2 := h div amount;
  7633.     w2 := w div amount;
  7634.     bm := TDIB.create;
  7635.     bm.width := w2;
  7636.     bm.height := h2;
  7637.     bm.BitCount := 24;
  7638.     smoothresize(src, bm);
  7639.     for j := 0 to amount - 1 do
  7640.       for i := 0 to amount - 1 do
  7641.         dst.canvas.Draw(i * w2, j * h2, bm);
  7642.     bm.free;
  7643.   end;
  7644. var BB1, BB2: TDIB;
  7645. begin
  7646.   BB1 := TDIB.Create;
  7647.   BB1.BitCount := 24;
  7648.   BB1.Assign(Self);
  7649.   BB2 := TDIB.Create;
  7650.   BB2.BitCount := 24;
  7651.   BB2.Assign(BB1);
  7652.   Tile(BB1, BB2, Amount);
  7653.   Self.Assign(BB2);
  7654.   BB1.Free;
  7655.   BB2.Free;
  7656. end;
  7657.  
  7658. procedure TDIB.DoSpotLight(Amount: Integer; Spot: TRect);
  7659.   procedure SpotLight(var src: TDIB; Amount: Integer; Spot: TRect);
  7660.   var
  7661.     bm, z: TDIB;
  7662.     w, h: Integer;
  7663.   begin
  7664.     z := TDIB.Create;
  7665.     try
  7666.       z.SetSize(src.Width, src.Height, 24);
  7667.       z.DrawTo(src, 0, 0, src.Width, src.Height, 0, 0);
  7668.       w := z.Width;
  7669.       h := z.Height;
  7670.       bm := TDIB.create;
  7671.       try
  7672.         bm.Width := w;
  7673.         bm.Height := h;
  7674.         bm.Canvas.Brush.color := clblack;
  7675.         bm.Canvas.FillRect(rect(0, 0, w, h));
  7676.         bm.Canvas.Brush.Color := clwhite;
  7677.         bm.Canvas.Ellipse(Spot.left, spot.top, spot.right, spot.bottom);
  7678.         bm.Transparent := true;
  7679.         z.Canvas.CopyMode := cmSrcAnd; {as transparentcolor for white}
  7680.         z.Canvas.Draw(0, 0, src);
  7681.         z.Canvas.Draw(0, 0, bm);
  7682.         src.Darkness(Amount);
  7683.         src.Canvas.CopyMode := cmSrcPaint;
  7684.         src.DrawTransparent(z, 0, 0, z.Width, z.Height, 0, 0, clBlack);
  7685.       finally
  7686.         bm.Free;
  7687.       end;
  7688.     finally
  7689.       z.Free
  7690.     end;
  7691.   end;
  7692. var BB1, BB2: TDIB;
  7693. begin
  7694.   BB1 := TDIB.Create;
  7695.   BB1.BitCount := 24;
  7696.   BB1.Assign(Self);
  7697.   BB2 := TDIB.Create;
  7698.   BB2.BitCount := 24;
  7699.   BB2.Assign(BB1);
  7700.   SpotLight(BB2, Amount, Spot);
  7701.   Self.Assign(BB2);
  7702.   BB1.Free;
  7703.   BB2.Free;
  7704. end;
  7705.  
  7706. procedure TDIB.DoEmboss;
  7707.   procedure Emboss(var Bmp: TDIB);
  7708.   var
  7709.     x, y: Integer;
  7710.     p1, p2: Pbytearray;
  7711.   begin
  7712.     for y := 0 to Bmp.Height - 2 do
  7713.     begin
  7714.       p1 := bmp.scanline[y];
  7715.       p2 := bmp.scanline[y + 1];
  7716.       for x := 0 to Bmp.Width - 4 do
  7717.       begin
  7718.         p1[x * 3] := (p1[x * 3] + (p2[(x + 3) * 3] xor $FF)) shr 1;
  7719.         p1[x * 3 + 1] := (p1[x * 3 + 1] + (p2[(x + 3) * 3 + 1] xor $FF)) shr 1;
  7720.         p1[x * 3 + 2] := (p1[x * 3 + 2] + (p2[(x + 3) * 3 + 2] xor $FF)) shr 1;
  7721.       end;
  7722.     end;
  7723.   end;
  7724. var BB1, BB2: TDIB;
  7725. begin
  7726.   BB1 := TDIB.Create;
  7727.   BB1.BitCount := 24;
  7728.   BB1.Assign(Self);
  7729.   BB2 := TDIB.Create;
  7730.   BB2.BitCount := 24;
  7731.   BB2.Assign(BB1);
  7732.   Emboss(BB2);
  7733.   Self.Assign(BB2);
  7734.   BB1.Free;
  7735.   BB2.Free;
  7736. end;
  7737.  
  7738. procedure TDIB.DoSolorize(Amount: Integer);
  7739.   procedure Solorize(src, dst: TDIB; amount: Integer);
  7740.   var
  7741.     w, h, x, y: Integer;
  7742.     ps, pd: pbytearray;
  7743.     c: Integer;
  7744.   begin
  7745.     w := src.width;
  7746.     h := src.height;
  7747.     src.BitCount := 24;
  7748.     dst.BitCount := 24;
  7749.     for y := 0 to h - 1 do
  7750.     begin
  7751.       ps := src.scanline[y];
  7752.       pd := dst.scanline[y];
  7753.       for x := 0 to w - 1 do
  7754.       begin
  7755.         c := (ps[x * 3] + ps[x * 3 + 1] + ps[x * 3 + 2]) div 3;
  7756.         if c > amount then
  7757.         begin
  7758.           pd[x * 3] := 255 - ps[x * 3];
  7759.           pd[x * 3 + 1] := 255 - ps[x * 3 + 1];
  7760.           pd[x * 3 + 2] := 255 - ps[x * 3 + 2];
  7761.         end
  7762.         else
  7763.         begin
  7764.           pd[x * 3] := ps[x * 3];
  7765.           pd[x * 3 + 1] := ps[x * 3 + 1];
  7766.           pd[x * 3 + 2] := ps[x * 3 + 2];
  7767.         end;
  7768.       end;
  7769.     end;
  7770.   end;
  7771. var BB1, BB2: TDIB;
  7772. begin
  7773.   BB1 := TDIB.Create;
  7774.   BB1.BitCount := 24;
  7775.   BB1.Assign(Self);
  7776.   BB2 := TDIB.Create;
  7777.   BB2.BitCount := 24;
  7778.   BB2.Assign(BB1);
  7779.   Solorize(BB1, BB2, Amount);
  7780.   Self.Assign(BB2);
  7781.   BB1.Free;
  7782.   BB2.Free;
  7783. end;
  7784.  
  7785. procedure TDIB.DoPosterize(Amount: Integer);
  7786.   procedure Posterize(src, dst: TDIB; amount: Integer);
  7787.   var
  7788.     w, h, x, y: Integer;
  7789.     ps, pd: pbytearray;
  7790.   begin
  7791.     w := src.width;
  7792.     h := src.height;
  7793.     src.BitCount := 24;
  7794.     dst.BitCount := 24;
  7795.     for y := 0 to h - 1 do
  7796.     begin
  7797.       ps := src.scanline[y];
  7798.       pd := dst.scanline[y];
  7799.       for x := 0 to w - 1 do
  7800.       begin
  7801.         pd[x * 3] := round(ps[x * 3] / amount) * amount;
  7802.         pd[x * 3 + 1] := round(ps[x * 3 + 1] / amount) * amount;
  7803.         pd[x * 3 + 2] := round(ps[x * 3 + 2] / amount) * amount;
  7804.       end;
  7805.     end;
  7806.   end;
  7807. var BB1, BB2: TDIB;
  7808. begin
  7809.   BB1 := TDIB.Create;
  7810.   BB1.BitCount := 24;
  7811.   BB1.Assign(Self);
  7812.   BB2 := TDIB.Create;
  7813.   BB2.BitCount := 24;
  7814.   BB2.Assign(BB1);
  7815.   Posterize(BB1, BB2, Amount);
  7816.   Self.Assign(BB2);
  7817.   BB1.Free;
  7818.   BB2.Free;
  7819. end;
  7820.  
  7821. procedure TDIB.DoBrightness(Amount: Integer);
  7822.   procedure Brightness(src, dst: TDIB; level: Integer);
  7823.   const
  7824.     MaxPixelCount = 32768;
  7825.   type
  7826.     pRGBArray = ^TRGBArray;
  7827.     TRGBArray = array[0..MaxPixelCount - 1] of TRGBTriple;
  7828.   var
  7829.     i, j, value: Integer;
  7830.     OrigRow, DestRow: pRGBArray;
  7831.   begin
  7832.     // get brightness increment value
  7833.     value := level;
  7834.     src.BitCount := 24;
  7835.     dst.BitCount := 24;
  7836.     // for each row of pixels
  7837.     for i := 0 to src.Height - 1 do
  7838.     begin
  7839.       OrigRow := src.ScanLine[i];
  7840.       DestRow := dst.ScanLine[i];
  7841.       // for each pixel in row
  7842.       for j := 0 to src.Width - 1 do
  7843.       begin
  7844.         // add brightness value to pixel's RGB values
  7845.         if value > 0 then
  7846.         begin
  7847.           // RGB values must be less than 256
  7848.           DestRow[j].rgbtRed := Min(255, OrigRow[j].rgbtRed + value);
  7849.           DestRow[j].rgbtGreen := Min(255, OrigRow[j].rgbtGreen + value);
  7850.           DestRow[j].rgbtBlue := Min(255, OrigRow[j].rgbtBlue + value);
  7851.         end
  7852.         else
  7853.         begin
  7854.           // RGB values must be greater or equal than 0
  7855.           DestRow[j].rgbtRed := Max(0, OrigRow[j].rgbtRed + value);
  7856.           DestRow[j].rgbtGreen := Max(0, OrigRow[j].rgbtGreen + value);
  7857.           DestRow[j].rgbtBlue := Max(0, OrigRow[j].rgbtBlue + value);
  7858.         end;
  7859.       end;
  7860.     end;
  7861.   end;
  7862. var BB1, BB2: TDIB;
  7863. begin
  7864.   BB1 := TDIB.Create;
  7865.   BB1.BitCount := 24;
  7866.   BB1.Assign(Self);
  7867.   BB2 := TDIB.Create;
  7868.   BB2.BitCount := 24;
  7869.   BB2.Assign(BB1);
  7870.   Brightness(BB1, BB2, Amount);
  7871.   Self.Assign(BB2);
  7872.   BB1.Free;
  7873.   BB2.Free;
  7874. end;
  7875.  
  7876. procedure TDIB.DoResample(AmountX, AmountY: Integer; TypeResample: TFilterTypeResample);
  7877.   procedure Resample(Src, Dst: TDIB; filtertype: TFilterTypeResample; fwidth: single);
  7878.   // -----------------------------------------------------------------------------
  7879.   //
  7880.   //                    Filter functions
  7881.   //
  7882.   // -----------------------------------------------------------------------------
  7883.  
  7884.   // Hermite filter
  7885.     function HermiteFilter(Value: Single): Single; {$IFDEF VER9UP}inline;{$ENDIF}
  7886.     begin
  7887.     // f(t) = 2|t|^3 - 3|t|^2 + 1, -1 <= t <= 1
  7888.       if (Value < 0.0) then
  7889.         Value := -Value;
  7890.       if (Value < 1.0) then
  7891.         Result := (2.0 * Value - 3.0) * Sqr(Value) + 1.0
  7892.       else
  7893.         Result := 0.0;
  7894.     end;
  7895.  
  7896.     // Box filter
  7897.     // a.k.a. "Nearest Neighbour" filter
  7898.     // anme: I have not been able to get acceptable
  7899.     //       results with this filter for subsampling.
  7900.     function BoxFilter(Value: Single): Single; {$IFDEF VER9UP}inline;{$ENDIF}
  7901.     begin
  7902.       if (Value > -0.5) and (Value <= 0.5) then
  7903.         Result := 1.0
  7904.       else
  7905.         Result := 0.0;
  7906.     end;
  7907.  
  7908.     // Triangle filter
  7909.     // a.k.a. "Linear" or "Bilinear" filter
  7910.     function TriangleFilter(Value: Single): Single; {$IFDEF VER9UP}inline;{$ENDIF}
  7911.     begin
  7912.       if (Value < 0.0) then
  7913.         Value := -Value;
  7914.       if (Value < 1.0) then
  7915.         Result := 1.0 - Value
  7916.       else
  7917.         Result := 0.0;
  7918.     end;
  7919.  
  7920.     // Bell filter
  7921.     function BellFilter(Value: Single): Single; {$IFDEF VER9UP}inline;{$ENDIF}
  7922.     begin
  7923.       if (Value < 0.0) then
  7924.         Value := -Value;
  7925.       if (Value < 0.5) then
  7926.         Result := 0.75 - Sqr(Value)
  7927.       else
  7928.         if (Value < 1.5) then
  7929.         begin
  7930.           Value := Value - 1.5;
  7931.           Result := 0.5 * Sqr(Value);
  7932.         end
  7933.         else
  7934.           Result := 0.0;
  7935.     end;
  7936.  
  7937.     // B-spline filter
  7938.     function SplineFilter(Value: Single): Single; {$IFDEF VER9UP}inline;{$ENDIF}
  7939.     var
  7940.       tt: single;
  7941.     begin
  7942.       if (Value < 0.0) then
  7943.         Value := -Value;
  7944.       if (Value < 1.0) then
  7945.       begin
  7946.         tt := Sqr(Value);
  7947.         Result := 0.5 * tt * Value - tt + 2.0 / 3.0;
  7948.       end
  7949.       else
  7950.         if (Value < 2.0) then
  7951.         begin
  7952.           Value := 2.0 - Value;
  7953.           Result := 1.0 / 6.0 * Sqr(Value) * Value;
  7954.         end
  7955.         else
  7956.           Result := 0.0;
  7957.     end;
  7958.  
  7959.     // Lanczos3 filter
  7960.     function Lanczos3Filter(Value: Single): Single;
  7961.       function SinC(Value: Single): Single; {$IFDEF VER9UP}inline;{$ENDIF}
  7962.       begin
  7963.         if (Value <> 0.0) then
  7964.         begin
  7965.           Value := Value * Pi;
  7966.           Result := sin(Value) / Value
  7967.         end
  7968.         else
  7969.           Result := 1.0;
  7970.       end;
  7971.     begin
  7972.       if (Value < 0.0) then
  7973.         Value := -Value;
  7974.       if (Value < 3.0) then
  7975.         Result := SinC(Value) * SinC(Value / 3.0)
  7976.       else
  7977.         Result := 0.0;
  7978.     end;
  7979.  
  7980.     function MitchellFilter(Value: Single): Single; {$IFDEF VER9UP}inline;{$ENDIF}
  7981.     const
  7982.       B = (1.0 / 3.0);
  7983.       C = (1.0 / 3.0);
  7984.     var
  7985.       tt: single;
  7986.     begin
  7987.       if (Value < 0.0) then
  7988.         Value := -Value;
  7989.       tt := Sqr(Value);
  7990.       if (Value < 1.0) then
  7991.       begin
  7992.         Value := (((12.0 - 9.0 * B - 6.0 * C) * (Value * tt))
  7993.           + ((-18.0 + 12.0 * B + 6.0 * C) * tt)
  7994.           + (6.0 - 2 * B));
  7995.         Result := Value / 6.0;
  7996.       end
  7997.       else
  7998.         if (Value < 2.0) then
  7999.         begin
  8000.           Value := (((-1.0 * B - 6.0 * C) * (Value * tt))
  8001.             + ((6.0 * B + 30.0 * C) * tt)
  8002.             + ((-12.0 * B - 48.0 * C) * Value)
  8003.             + (8.0 * B + 24 * C));
  8004.           Result := Value / 6.0;
  8005.         end
  8006.         else
  8007.           Result := 0.0;
  8008.     end;
  8009.  
  8010.   // -----------------------------------------------------------------------------
  8011.   //
  8012.   //                    Interpolator
  8013.   //
  8014.   // -----------------------------------------------------------------------------
  8015.   type
  8016.     // Contributor for a pixel
  8017.     TContributor = packed record
  8018.       pixel: Integer; // Source pixel
  8019.       weight: single; // Pixel weight
  8020.     end;
  8021.  
  8022.     TContributorList = array[0..0] of TContributor;
  8023.     PContributorList = ^TContributorList;
  8024.  
  8025.     // List of source pixels contributing to a destination pixel
  8026.     TCList = packed record
  8027.       n: Integer;
  8028.       p: PContributorList;
  8029.     end;
  8030.  
  8031.     TCListList = array[0..0] of TCList;
  8032.     PCListList = ^TCListList;
  8033.  
  8034.     TRGB = packed record
  8035.       r, g, b: single;
  8036.     end;
  8037.  
  8038.     // Physical bitmap pixel
  8039.     TColorRGB = packed record
  8040.       r, g, b: BYTE;
  8041.     end;
  8042.     PColorRGB = ^TColorRGB;
  8043.  
  8044.     // Physical bitmap scanline (row)
  8045.     TRGBList = packed array[0..0] of TColorRGB;
  8046.     PRGBList = ^TRGBList;
  8047.  
  8048.   var
  8049.     xscale, yscale: single; // Zoom scale factors
  8050.     i, j, k: Integer; // Loop variables
  8051.     center: single; // Filter calculation variables
  8052.     width, fscale, weight: single; // Filter calculation variables
  8053.     left, right: Integer; // Filter calculation variables
  8054.     n: Integer; // Pixel number
  8055.     Work: TDIB;
  8056.     contrib: PCListList;
  8057.     rgb: TRGB;
  8058.     color: TColorRGB;
  8059.   {$IFDEF USE_SCANLINE}
  8060.     SourceLine,
  8061.       DestLine: PRGBList;
  8062.     //SourcePixel,
  8063.       DestPixel: PColorRGB;
  8064.     Delta,
  8065.       DestDelta: Integer;
  8066.   {$ENDIF}
  8067.     SrcWidth,
  8068.       SrcHeight,
  8069.       DstWidth,
  8070.       DstHeight: Integer;
  8071.  
  8072.     function Color2RGB(Color: TColor): TColorRGB; {$IFDEF VER9UP}inline;{$ENDIF}
  8073.     begin
  8074.       Result.r := Color and $000000FF;
  8075.       Result.g := (Color and $0000FF00) shr 8;
  8076.       Result.b := (Color and $00FF0000) shr 16;
  8077.     end;
  8078.  
  8079.     function RGB2Color(Color: TColorRGB): TColor; {$IFDEF VER9UP}inline;{$ENDIF}
  8080.     begin
  8081.       Result := Color.r or (Color.g shl 8) or (Color.b shl 16);
  8082.     end;
  8083.  
  8084.   begin
  8085.     DstWidth := Dst.Width;
  8086.     DstHeight := Dst.Height;
  8087.     SrcWidth := Src.Width;
  8088.     SrcHeight := Src.Height;
  8089.     if (SrcWidth < 1) or (SrcHeight < 1) then
  8090.       raise Exception.Create('Source bitmap too small');
  8091.  
  8092.     // Create intermediate image to hold horizontal zoom
  8093.     Work := TDIB.Create;
  8094.     try
  8095.       Work.Height := SrcHeight;
  8096.       Work.Width := DstWidth;
  8097.       // xscale := DstWidth / SrcWidth;
  8098.       // yscale := DstHeight / SrcHeight;
  8099.       // Improvement suggested by David Ullrich:
  8100.       if (SrcWidth = 1) then
  8101.         xscale := DstWidth / SrcWidth
  8102.       else
  8103.         xscale := (DstWidth - 1) / (SrcWidth - 1);
  8104.       if (SrcHeight = 1) then
  8105.         yscale := DstHeight / SrcHeight
  8106.       else
  8107.         yscale := (DstHeight - 1) / (SrcHeight - 1);
  8108.       // This implementation only works on 24-bit images because it uses
  8109.       // TDIB.Scanline
  8110.      {$IFDEF USE_SCANLINE}
  8111.       //Src.PixelFormat := pf24bit;
  8112.       Src.BitCount := 24;
  8113.       //Dst.PixelFormat := Src.PixelFormat;
  8114.       dst.BitCount := 24;
  8115.       //Work.PixelFormat := Src.PixelFormat;
  8116.       work.BitCount := 24;
  8117.      {$ENDIF}
  8118.  
  8119.       // --------------------------------------------
  8120.       // Pre-calculate filter contributions for a row
  8121.       // -----------------------------------------------
  8122.       GetMem(contrib, DstWidth * sizeof(TCList));
  8123.       // Horizontal sub-sampling
  8124.       // Scales from bigger to smaller width
  8125.       if (xscale < 1.0) then
  8126.       begin
  8127.         width := fwidth / xscale;
  8128.         fscale := 1.0 / xscale;
  8129.         for i := 0 to DstWidth - 1 do
  8130.         begin
  8131.           contrib^[i].n := 0;
  8132.           GetMem(contrib^[i].p, trunc(width * 2.0 + 1) * sizeof(TContributor));
  8133.           center := i / xscale;
  8134.           // Original code:
  8135.           // left := ceil(center - width);
  8136.           // right := floor(center + width);
  8137.           left := floor(center - width);
  8138.           right := ceil(center + width);
  8139.           for j := left to right do
  8140.           begin
  8141.             case filtertype of
  8142.               ftrBox: weight := boxfilter((center - j) / fscale) / fscale;
  8143.               ftrTriangle: weight := trianglefilter((center - j) / fscale) / fscale;
  8144.               ftrHermite: weight := hermitefilter((center - j) / fscale) / fscale;
  8145.               ftrBell: weight := bellfilter((center - j) / fscale) / fscale;
  8146.               ftrBSpline: weight := splinefilter((center - j) / fscale) / fscale;
  8147.               ftrLanczos3: weight := Lanczos3filter((center - j) / fscale) / fscale;
  8148.               ftrMitchell: weight := Mitchellfilter((center - j) / fscale) / fscale;
  8149.             else
  8150.               weight := 0
  8151.             end;
  8152.             if (weight = 0.0) then
  8153.               continue;
  8154.             if (j < 0) then
  8155.               n := -j
  8156.             else if (j >= SrcWidth) then
  8157.               n := SrcWidth - j + SrcWidth - 1
  8158.             else
  8159.               n := j;
  8160.             k := contrib^[i].n;
  8161.             contrib^[i].n := contrib^[i].n + 1;
  8162.             contrib^[i].p^[k].pixel := n;
  8163.             contrib^[i].p^[k].weight := weight;
  8164.           end;
  8165.         end;
  8166.       end
  8167.       else
  8168.       // Horizontal super-sampling
  8169.       // Scales from smaller to bigger width
  8170.       begin
  8171.         for i := 0 to DstWidth - 1 do
  8172.         begin
  8173.           contrib^[i].n := 0;
  8174.           GetMem(contrib^[i].p, trunc(fwidth * 2.0 + 1) * sizeof(TContributor));
  8175.           center := i / xscale;
  8176.           // Original code:
  8177.           // left := ceil(center - fwidth);
  8178.           // right := floor(center + fwidth);
  8179.           left := floor(center - fwidth);
  8180.           right := ceil(center + fwidth);
  8181.           for j := left to right do
  8182.           begin
  8183.             case filtertype of
  8184.               ftrBox: weight := boxfilter(center - j);
  8185.               ftrTriangle: weight := trianglefilter(center - j);
  8186.               ftrHermite: weight := hermitefilter(center - j);
  8187.               ftrBell: weight := bellfilter(center - j);
  8188.               ftrBSpline: weight := splinefilter(center - j);
  8189.               ftrLanczos3: weight := Lanczos3filter(center - j);
  8190.               ftrMitchell: weight := Mitchellfilter(center - j);
  8191.             else
  8192.               weight := 0
  8193.             end;
  8194.             if (weight = 0.0) then
  8195.               continue;
  8196.             if (j < 0) then
  8197.               n := -j
  8198.             else if (j >= SrcWidth) then
  8199.               n := SrcWidth - j + SrcWidth - 1
  8200.             else
  8201.               n := j;
  8202.             k := contrib^[i].n;
  8203.             contrib^[i].n := contrib^[i].n + 1;
  8204.             contrib^[i].p^[k].pixel := n;
  8205.             contrib^[i].p^[k].weight := weight;
  8206.           end;
  8207.         end;
  8208.       end;
  8209.  
  8210.       // ----------------------------------------------------
  8211.       // Apply filter to sample horizontally from Src to Work
  8212.       // ----------------------------------------------------
  8213.       for k := 0 to SrcHeight - 1 do
  8214.       begin
  8215.        {$IFDEF USE_SCANLINE}
  8216.         SourceLine := Src.ScanLine[k];
  8217.         DestPixel := Work.ScanLine[k];
  8218.        {$ENDIF}
  8219.         for i := 0 to DstWidth - 1 do
  8220.         begin
  8221.           rgb.r := 0.0;
  8222.           rgb.g := 0.0;
  8223.           rgb.b := 0.0;
  8224.           for j := 0 to contrib^[i].n - 1 do
  8225.           begin
  8226.            {$IFDEF USE_SCANLINE}
  8227.             color := SourceLine^[contrib^[i].p^[j].pixel];
  8228.            {$ELSE}
  8229.             color := Color2RGB(Src.Canvas.Pixels[contrib^[i].p^[j].pixel, k]);
  8230.            {$ENDIF}
  8231.             weight := contrib^[i].p^[j].weight;
  8232.             if (weight = 0.0) then
  8233.               continue;
  8234.             rgb.r := rgb.r + color.r * weight;
  8235.             rgb.g := rgb.g + color.g * weight;
  8236.             rgb.b := rgb.b + color.b * weight;
  8237.           end;
  8238.           if (rgb.r > 255.0) then
  8239.             color.r := 255
  8240.           else if (rgb.r < 0.0) then
  8241.             color.r := 0
  8242.           else
  8243.             color.r := round(rgb.r);
  8244.           if (rgb.g > 255.0) then
  8245.             color.g := 255
  8246.           else if (rgb.g < 0.0) then
  8247.             color.g := 0
  8248.           else
  8249.             color.g := round(rgb.g);
  8250.           if (rgb.b > 255.0) then
  8251.             color.b := 255
  8252.           else if (rgb.b < 0.0) then
  8253.             color.b := 0
  8254.           else
  8255.             color.b := round(rgb.b);
  8256.          {$IFDEF USE_SCANLINE}
  8257.           // Set new pixel value
  8258.           DestPixel^ := color;
  8259.           // Move on to next column
  8260.           inc(DestPixel);
  8261.          {$ELSE}
  8262.           Work.Canvas.Pixels[i, k] := RGB2Color(color);
  8263.          {$ENDIF}
  8264.         end;
  8265.       end;
  8266.  
  8267.       // Free the memory allocated for horizontal filter weights
  8268.       for i := 0 to DstWidth - 1 do
  8269.         FreeMem(contrib^[i].p);
  8270.  
  8271.       FreeMem(contrib);
  8272.  
  8273.       // -----------------------------------------------
  8274.       // Pre-calculate filter contributions for a column
  8275.       // -----------------------------------------------
  8276.       GetMem(contrib, DstHeight * sizeof(TCList));
  8277.       // Vertical sub-sampling
  8278.       // Scales from bigger to smaller height
  8279.       if (yscale < 1.0) then
  8280.       begin
  8281.         width := fwidth / yscale;
  8282.         fscale := 1.0 / yscale;
  8283.         for i := 0 to DstHeight - 1 do
  8284.         begin
  8285.           contrib^[i].n := 0;
  8286.           GetMem(contrib^[i].p, trunc(width * 2.0 + 1) * sizeof(TContributor));
  8287.           center := i / yscale;
  8288.           // Original code:
  8289.           // left := ceil(center - width);
  8290.           // right := floor(center + width);
  8291.           left := floor(center - width);
  8292.           right := ceil(center + width);
  8293.           for j := left to right do
  8294.           begin
  8295.             case filtertype of
  8296.               ftrBox: weight := boxfilter((center - j) / fscale) / fscale;
  8297.               ftrTriangle: weight := trianglefilter((center - j) / fscale) / fscale;
  8298.               ftrHermite: weight := hermitefilter((center - j) / fscale) / fscale;
  8299.               ftrBell: weight := bellfilter((center - j) / fscale) / fscale;
  8300.               ftrBSpline: weight := splinefilter((center - j) / fscale) / fscale;
  8301.               ftrLanczos3: weight := Lanczos3filter((center - j) / fscale) / fscale;
  8302.               ftrMitchell: weight := Mitchellfilter((center - j) / fscale) / fscale;
  8303.             else
  8304.               weight := 0
  8305.             end;
  8306.             if (weight = 0.0) then
  8307.               continue;
  8308.             if (j < 0) then
  8309.               n := -j
  8310.             else if (j >= SrcHeight) then
  8311.               n := SrcHeight - j + SrcHeight - 1
  8312.             else
  8313.               n := j;
  8314.             k := contrib^[i].n;
  8315.             contrib^[i].n := contrib^[i].n + 1;
  8316.             contrib^[i].p^[k].pixel := n;
  8317.             contrib^[i].p^[k].weight := weight;
  8318.           end;
  8319.         end
  8320.       end
  8321.       else
  8322.       // Vertical super-sampling
  8323.       // Scales from smaller to bigger height
  8324.       begin
  8325.         for i := 0 to DstHeight - 1 do
  8326.         begin
  8327.           contrib^[i].n := 0;
  8328.           GetMem(contrib^[i].p, trunc(fwidth * 2.0 + 1) * sizeof(TContributor));
  8329.           center := i / yscale;
  8330.           // Original code:
  8331.           // left := ceil(center - fwidth);
  8332.           // right := floor(center + fwidth);
  8333.           left := floor(center - fwidth);
  8334.           right := ceil(center + fwidth);
  8335.           for j := left to right do
  8336.           begin
  8337.             case filtertype of
  8338.               ftrBox: weight := boxfilter(center - j);
  8339.               ftrTriangle: weight := trianglefilter(center - j);
  8340.               ftrHermite: weight := hermitefilter(center - j);
  8341.               ftrBell: weight := bellfilter(center - j);
  8342.               ftrBSpline: weight := splinefilter(center - j);
  8343.               ftrLanczos3: weight := Lanczos3filter(center - j);
  8344.               ftrMitchell: weight := Mitchellfilter(center - j);
  8345.             else
  8346.               weight := 0
  8347.             end;
  8348.             if (weight = 0.0) then
  8349.               continue;
  8350.             if (j < 0) then
  8351.               n := -j
  8352.             else if (j >= SrcHeight) then
  8353.               n := SrcHeight - j + SrcHeight - 1
  8354.             else
  8355.               n := j;
  8356.             k := contrib^[i].n;
  8357.             contrib^[i].n := contrib^[i].n + 1;
  8358.             contrib^[i].p^[k].pixel := n;
  8359.             contrib^[i].p^[k].weight := weight;
  8360.           end;
  8361.         end;
  8362.       end;
  8363.  
  8364.       // --------------------------------------------------
  8365.       // Apply filter to sample vertically from Work to Dst
  8366.       // --------------------------------------------------
  8367.      {$IFDEF USE_SCANLINE}
  8368.       SourceLine := Work.ScanLine[0];
  8369.       Delta := Integer(Work.ScanLine[1]) - Integer(SourceLine);
  8370.       DestLine := Dst.ScanLine[0];
  8371.       DestDelta := Integer(Dst.ScanLine[1]) - Integer(DestLine);
  8372.      {$ENDIF}
  8373.       for k := 0 to DstWidth - 1 do
  8374.       begin
  8375.        {$IFDEF USE_SCANLINE}
  8376.         DestPixel := pointer(DestLine);
  8377.        {$ENDIF}
  8378.         for i := 0 to DstHeight - 1 do
  8379.         begin
  8380.           rgb.r := 0;
  8381.           rgb.g := 0;
  8382.           rgb.b := 0;
  8383.           // weight := 0.0;
  8384.           for j := 0 to contrib^[i].n - 1 do
  8385.           begin
  8386.            {$IFDEF USE_SCANLINE}
  8387.             //color := PColorRGB(PByte(SourceLine) + contrib^[i].p^[j].pixel * Delta)^;
  8388.             Move(Pointer(Integer(SourceLine) + contrib^[i].p^[j].pixel * Delta)^, Color, SizeOf(Color));
  8389.            {$ELSE}
  8390.             color := Color2RGB(Work.Canvas.Pixels[k, contrib^[i].p^[j].pixel]);
  8391.            {$ENDIF}
  8392.             weight := contrib^[i].p^[j].weight;
  8393.             if (weight = 0.0) then
  8394.               continue;
  8395.             rgb.r := rgb.r + color.r * weight;
  8396.             rgb.g := rgb.g + color.g * weight;
  8397.             rgb.b := rgb.b + color.b * weight;
  8398.           end;
  8399.           if (rgb.r > 255.0) then
  8400.             color.r := 255
  8401.           else if (rgb.r < 0.0) then
  8402.             color.r := 0
  8403.           else
  8404.             color.r := round(rgb.r);
  8405.           if (rgb.g > 255.0) then
  8406.             color.g := 255
  8407.           else if (rgb.g < 0.0) then
  8408.             color.g := 0
  8409.           else
  8410.             color.g := round(rgb.g);
  8411.           if (rgb.b > 255.0) then
  8412.             color.b := 255
  8413.           else if (rgb.b < 0.0) then
  8414.             color.b := 0
  8415.           else
  8416.             color.b := round(rgb.b);
  8417.          {$IFDEF USE_SCANLINE}
  8418.           DestPixel^ := color;
  8419.           {$IFDEF WIN64}
  8420.           inc(PByte(DestPixel), DestDelta);
  8421.           {$ELSE}
  8422.           inc(Integer(DestPixel), DestDelta);
  8423.           {$ENDIF}
  8424.          {$ELSE}
  8425.           Dst.Canvas.Pixels[k, i] := RGB2Color(color);
  8426.          {$ENDIF}
  8427.         end;
  8428.        {$IFDEF USE_SCANLINE}
  8429.         Inc(SourceLine, 1);
  8430.         Inc(DestLine, 1);
  8431.        {$ENDIF}
  8432.       end;
  8433.  
  8434.       // Free the memory allocated for vertical filter weights
  8435.       for i := 0 to DstHeight - 1 do
  8436.         FreeMem(contrib^[i].p);
  8437.  
  8438.       FreeMem(contrib);
  8439.  
  8440.     finally
  8441.       Work.Free;
  8442.     end;
  8443.   end;
  8444. var BB1, BB2: TDIB;
  8445. begin
  8446.   BB1 := TDIB.Create;
  8447.   BB1.BitCount := 24;
  8448.   BB1.Assign(Self);
  8449.   BB2 := TDIB.Create;
  8450.   BB2.SetSize(AmountX, AmountY, 24);
  8451.   Resample(BB1, BB2, TypeResample, DefaultFilterRadius[TypeResample]);
  8452.   Self.Assign(BB2);
  8453.   BB1.Free;
  8454.   BB2.Free;
  8455. end;
  8456.  
  8457. procedure TDIB.DoColorize(ForeColor, BackColor: TColor);
  8458.   procedure Colorize(src, dst: TDIB; iForeColor, iBackColor: TColor; iDither: Boolean{$IFDEF VER4UP} = False{$ENDIF});
  8459.   {for monochromatic picture change colors}
  8460.     procedure InvertBitmap(Bmp: TDIB);
  8461.     begin
  8462.       Bmp.Canvas.CopyMode := cmDstInvert;
  8463.       Bmp.Canvas.CopyRect(rect(0, 0, Bmp.Width, Bmp.Height),
  8464.         Bmp.Canvas, rect(0, 0, Bmp.Width, Bmp.Height));
  8465.     end;
  8466.   var
  8467.     fForeColor: TColor;
  8468.     fForeDither: Boolean;
  8469.     lTempBitmap: TDIB;
  8470.     lTempBitmap2: TDIB;
  8471.     lDitherBitmap: TDIB;
  8472.     lCRect: TRect;
  8473.     x, y, w, h: Integer;
  8474.   begin
  8475.     {--}
  8476.     //fColor := iBackColor; ;
  8477.     fForeColor := iForeColor;
  8478.     fForeDither := iDither;
  8479.     w := src.Width;
  8480.     h := src.Height;
  8481.     lDitherBitmap := nil;
  8482.     lTempBitmap := TDIB.Create;
  8483.     lTempBitmap.SetSize(w, h, 24);
  8484.     lTempBitmap2 := TDIB.Create;
  8485.     lTempBitmap2.SetSize(w, h, 24);
  8486.     lCRect := rect(0, 0, w, h);
  8487.     with lTempBitmap.Canvas do
  8488.     begin
  8489.       Brush.Style := bsSolid;
  8490.       Brush.Color := iBackColor;
  8491.       FillRect(lCRect);
  8492.       CopyMode := cmSrcInvert;
  8493.       CopyRect(lCRect, src.Canvas, lCRect);
  8494.       InvertBitmap(src);
  8495.       CopyMode := cmSrcPaint;
  8496.       CopyRect(lCRect, src.Canvas, lCRect);
  8497.       InvertBitmap(lTempBitmap);
  8498.       CopyMode := cmSrcInvert;
  8499.       CopyRect(lCRect, src.Canvas, lCRect);
  8500.       InvertBitmap(src);
  8501.     end;
  8502.     with lTempBitmap2.Canvas do
  8503.     begin
  8504.       Brush.Style := bsSolid;
  8505.       Brush.Color := clBlack;
  8506.       FillRect(lCRect);
  8507.       if fForeDither then
  8508.       begin
  8509.         InvertBitmap(src);
  8510.         lDitherBitmap := TDIB.Create;
  8511.         lDitherBitmap.SetSize(8, 8, 24);
  8512.         with lDitherBitmap.Canvas do
  8513.         begin
  8514.           for x := 0 to 7 do
  8515.             for y := 0 to 7 do
  8516.               if ((x mod 2 = 0) and (y mod 2 > 0)) or ((x mod 2 > 0) and (y mod 2 = 0)) then
  8517.                 pixels[x, y] := fForeColor
  8518.               else
  8519.                 pixels[x, y] := iBackColor;
  8520.         end;
  8521.         Brush.Bitmap.Assign(lDitherBitmap);
  8522.       end
  8523.       else
  8524.       begin
  8525.         Brush.Style := bsSolid;
  8526.         Brush.Color := fForeColor;
  8527.       end;
  8528.       if not fForeDither then
  8529.         InvertBitmap(src);
  8530.       CopyMode := cmPatPaint;
  8531.       CopyRect(lCRect, src.Canvas, lCRect);
  8532.       if fForeDither then
  8533.         if Assigned(lDitherBitmap) then
  8534.           lDitherBitmap.Free;
  8535.       CopyMode := cmSrcInvert;
  8536.       CopyRect(lCRect, src.Canvas, lCRect);
  8537.     end;
  8538.     lTempBitmap.Canvas.CopyMode := cmSrcInvert;
  8539.     lTempBitmap.Canvas.Copyrect(lCRect, lTempBitmap2.Canvas, lCRect);
  8540.     InvertBitmap(src);
  8541.     lTempBitmap.Canvas.CopyMode := cmSrcErase;
  8542.     lTempBitmap.Canvas.Copyrect(lCRect, src.Canvas, lCRect);
  8543.     InvertBitmap(src);
  8544.     lTempBitmap.Canvas.CopyMode := cmSrcInvert;
  8545.     lTempBitmap.Canvas.Copyrect(lCRect, lTempBitmap2.Canvas, lCRect);
  8546.     InvertBitmap(lTempBitmap);
  8547.     InvertBitmap(src);
  8548.     dst.Assign(lTempBitmap);
  8549.     lTempBitmap.Free;
  8550.   end;
  8551. var BB1, BB2: TDIB;
  8552. begin
  8553.   BB1 := TDIB.Create;
  8554.   BB1.BitCount := 24;
  8555.   BB1.Assign(Self);
  8556.   BB2 := TDIB.Create;
  8557.   Colorize(BB1, BB2, ForeColor, BackColor{$IFNDEF VER4UP}, False{$ENDIF});
  8558.   Self.Assign(BB2);
  8559.   BB1.Free;
  8560.   BB2.Free;
  8561. end;
  8562.  
  8563. { procedure for special purpose }
  8564. (*
  8565. procedure TDIB.FadeOut(DIB2: TDIB; Step: Byte);
  8566. var
  8567.   P1, P2: PByteArray;
  8568.   W, H: Integer;
  8569. begin
  8570.   P1 := ScanLine[DIB2.Height - 1];
  8571.   P2 := DIB2.ScanLine[DIB2.Height - 1];
  8572.   W := WidthBytes;
  8573.   H := Height;
  8574.   asm
  8575.     PUSH ESI
  8576.     PUSH EDI
  8577.     MOV ESI, P1
  8578.     MOV EDI, P2
  8579.     MOV EDX, W
  8580.     MOV EAX, H
  8581.     IMUL EDX
  8582.     MOV ECX, EAX
  8583.     @@1:
  8584.     MOV AL, Step
  8585.     MOV AH, [ESI]
  8586.     CMP AL, AH
  8587.     JA @@2
  8588.     MOV AL, AH
  8589. @@2:
  8590.     MOV [EDI], AL
  8591.     INC ESI
  8592.     INC EDI
  8593.     DEC ECX
  8594.     JNZ @@1
  8595.     POP EDI
  8596.     POP ESI
  8597.   end;
  8598. end;
  8599. *)
  8600. procedure TDIB.FadeOut(DIB2: TDIB; Step: Byte);
  8601. var
  8602.   P1, P2: PByteArray;
  8603.   W, H, i: Integer;
  8604. begin
  8605.   P1 := ScanLine[DIB2.Height - 1];
  8606.   P2 := DIB2.ScanLine[DIB2.Height - 1];
  8607.   W := WidthBytes;
  8608.   H := Height;
  8609.   for i := 0 to W * H - 1 do
  8610.   begin
  8611.     if P1[i] < Step then P2[i] := P1[i]
  8612.     else P2[i] := Step;
  8613.   end;
  8614. end;
  8615.  
  8616. procedure TDIB.DoZoom(DIB2: TDIB; ZoomRatio: Real);
  8617. var
  8618.   P1, P2: PByteArray;
  8619.   W, H: Integer;
  8620.   x, y: Integer;
  8621.   xr, yr, xstep, ystep: real;
  8622.   xstart: real;
  8623. begin
  8624.   W := WidthBytes;
  8625.   H := Height;
  8626.   xstart := (W - (W * ZoomRatio)) / 2;
  8627.  
  8628.   xr := xstart;
  8629.   yr := (H - (H * ZoomRatio)) / 2;
  8630.   xstep := ZoomRatio;
  8631.   ystep := ZoomRatio;
  8632.  
  8633.   for y := 1 to Height - 1 do
  8634.   begin
  8635.     P2 := DIB2.ScanLine[y];
  8636.     if (yr >= 0) and (yr <= H) then
  8637.     begin
  8638.       P1 := ScanLine[Trunc(yr)];
  8639.       for x := 1 to Width - 1 do
  8640.       begin
  8641.         if (xr >= 0) and (xr <= W) then
  8642.         begin
  8643.           P2[x] := P1[Trunc(xr)];
  8644.         end
  8645.         else
  8646.         begin
  8647.           P2[x] := 0;
  8648.         end;
  8649.         xr := xr + xstep;
  8650.       end;
  8651.     end
  8652.     else
  8653.     begin
  8654.       for x := 1 to Width - 1 do
  8655.       begin
  8656.         P2[x] := 0;
  8657.       end;
  8658.     end;
  8659.     xr := xstart;
  8660.     yr := yr + ystep;
  8661.   end;
  8662. end;
  8663.  
  8664. procedure TDIB.DoBlur(DIB2: TDIB);
  8665. var
  8666.   P1, P2: PByteArray;
  8667.   W: Integer;
  8668.   x, y: Integer;
  8669. begin
  8670.   W := WidthBytes;
  8671.   for y := 1 to Height - 1 do
  8672.   begin
  8673.     P1 := ScanLine[y];
  8674.     P2 := DIB2.ScanLine[y];
  8675.     for x := 1 to Width - 1 do
  8676.     begin
  8677.       P2[x] := (P1[x] + P1[x - 1] + P1[x + 1] + P1[x + W] + P1[x - W]) div 5;
  8678.     end;
  8679.   end;
  8680. end;
  8681. (*
  8682. procedure TDIB.FadeIn(DIB2: TDIB; Step: Byte);
  8683. var
  8684.   P1, P2: PByteArray;
  8685.   W, H: Integer;
  8686. begin
  8687.   P1 := ScanLine[DIB2.Height - 1];
  8688.   P2 := DIB2.ScanLine[DIB2.Height - 1];
  8689.   W := WidthBytes;
  8690.   H := Height;
  8691.   asm
  8692.     PUSH ESI
  8693.     PUSH EDI
  8694.     MOV ESI, P1
  8695.     MOV EDI, P2
  8696.     MOV EDX, W
  8697.     MOV EAX, H
  8698.     IMUL EDX
  8699.     MOV ECX, EAX
  8700.     @@1:
  8701.     MOV AL, Step
  8702.     MOV AH, [ESI]
  8703.     CMP AL, AH
  8704.     JB @@2
  8705.     MOV AL, AH
  8706. @@2:
  8707.     MOV [EDI], AL
  8708.     INC ESI
  8709.     INC EDI
  8710.     DEC ECX
  8711.     JNZ @@1
  8712.     POP EDI
  8713.     POP ESI
  8714.   end;
  8715. end;
  8716. *)
  8717. procedure TDIB.FadeIn(DIB2: TDIB; Step: Byte);
  8718. var
  8719.   P1, P2: PByteArray;
  8720.   W, H, i: Integer;
  8721. begin
  8722.   P1 := ScanLine[DIB2.Height - 1];
  8723.   P2 := DIB2.ScanLine[DIB2.Height - 1];
  8724.   W := WidthBytes;
  8725.   H := Height;
  8726.   for i := 0 to W * H - 1 do
  8727.   begin
  8728.     if P1[i] > Step then P2[i] := P1[i]
  8729.     else P2[i] := Step;
  8730.   end;
  8731. end;
  8732.  
  8733. (*
  8734. procedure TDIB.FillDIB8(Color: Byte);
  8735. var
  8736.   P: PByteArray;
  8737.   W, H: Integer;
  8738. begin
  8739.   P := ScanLine[Height - 1];
  8740.   W := WidthBytes;
  8741.   H := Height;
  8742.   asm
  8743.     PUSH ESI
  8744.     MOV ESI, P
  8745.     MOV EDX, W
  8746.     MOV EAX, H
  8747.     IMUL EDX
  8748.     MOV ECX, EAX
  8749.     MOV AL, Color
  8750.     @@1:
  8751.     MOV [ESI], AL
  8752.     INC ESI
  8753.     DEC ECX
  8754.     JNZ @@1
  8755.     POP ESI
  8756.   end;
  8757. end;
  8758. *)
  8759.  
  8760. procedure TDIB.FillDIB8(Color: Byte);
  8761. var
  8762.   P: PByteArray;
  8763.   W, H, I: Integer;
  8764. begin
  8765.   P := ScanLine[Height - 1];
  8766.   W := WidthBytes;
  8767.   H := Height;
  8768.   for I := 0 to W * H - 1 do
  8769.     P[I] := Color;
  8770. end;
  8771.  
  8772.  
  8773. procedure TDIB.DoRotate(DIB1: TDIB; cX, cY, Angle: Integer);
  8774. type
  8775.   T3Byte = array[0..2] of Byte;
  8776.   P3ByteArray = ^T3ByteArray;
  8777.   T3ByteArray = array[0..32767] of T3Byte;
  8778.   PLongArray = ^TLongArray;
  8779.   TLongArray = array[0..32767] of LongInt;
  8780. var
  8781.   p, p2: PByteArray;
  8782.   x, y, x2, y2, angled: Integer;
  8783.   cosy, siny: real;
  8784. begin
  8785.   angled := 384 + Angle;
  8786.   for y := 0 to Height - 1 do
  8787.   begin
  8788.     p := DIB1.ScanLine[y];
  8789.     cosy := (y - cY) * dcos(angled and $1FF);
  8790.     siny := (y - cY) * dsin(angled and $1FF);
  8791.     for x := 0 to Width - 1 do
  8792.     begin
  8793.       x2 := Trunc((x - cX) * dsin(angled and $1FF) + cosy) + cX;
  8794.       y2 := Trunc((x - cX) * dcos(angled and $1FF) - siny) + cY;
  8795.       case bitcount of
  8796.         8:
  8797.           begin
  8798.             if (y2 >= 0) and (y2 < Height) and (x2 >= 0) and (x2 < Width) then
  8799.             begin
  8800.               p2 := ScanLine[y2];
  8801.               p[x] := p2[Width - x2];
  8802.             end
  8803.             else
  8804.             begin
  8805.               if p[x] > 4 then
  8806.                 p[x] := p[x] - 4
  8807.               else
  8808.                 p[x] := 0;
  8809.             end;
  8810.           end;
  8811.         16:
  8812.           begin
  8813.             if (y2 >= 0) and (y2 < Height) and (x2 >= 0) and (x2 < Width) then
  8814.             begin
  8815.               PWordArray(p2) := ScanLine[y2];
  8816.               PWordArray(p)[x] := PWordArray(p2)[Width - x2];
  8817.             end
  8818.             else
  8819.             begin
  8820.               if PWordArray(p)[x] > 4 then
  8821.                 PWordArray(p)[x] := PWordArray(p)[x] - 4
  8822.               else
  8823.                 PWordArray(p)[x] := 0;
  8824.             end;
  8825.           end;
  8826.         24:
  8827.           begin
  8828.             if (y2 >= 0) and (y2 < Height) and (x2 >= 0) and (x2 < Width) then
  8829.             begin
  8830.               P3ByteArray(p2) := ScanLine[y2];
  8831.               P3ByteArray(p)[x] := P3ByteArray(p2)[Width - x2];
  8832.             end
  8833.             else
  8834.             begin
  8835.               if P3ByteArray(p)[x][0] > 4 then
  8836.                 P3ByteArray(p)[x][0] := P3ByteArray(p)[x][0] - 4
  8837.               else if P3ByteArray(p)[x][1] > 4 then
  8838.                 P3ByteArray(p)[x][1] := P3ByteArray(p)[x][1] - 4
  8839.               else if P3ByteArray(p)[x][2] > 4 then
  8840.                 P3ByteArray(p)[x][2] := P3ByteArray(p)[x][2] - 4
  8841.               else
  8842.               begin
  8843.                 P3ByteArray(p)[x][0] := 0;
  8844.                 P3ByteArray(p)[x][1] := 0;
  8845.                 P3ByteArray(p)[x][2] := 0;
  8846.               end;
  8847.             end;
  8848.           end;
  8849.         32: begin
  8850.             if (y2 >= 0) and (y2 < Height) and (x2 >= 0) and (x2 < Width) then
  8851.             begin
  8852.               plongarray(p2) := ScanLine[y2];
  8853.               plongarray(p)[x] := plongarray(p2)[Width - x2];
  8854.             end
  8855.             else
  8856.             begin
  8857.               if plongarray(p)[x] > 4 then
  8858.                 plongarray(p)[x] := plongarray(p)[x] - 4
  8859.               else
  8860.                 plongarray(p)[x] := 0;
  8861.             end;
  8862.           end;
  8863.       end
  8864.     end;
  8865.   end;
  8866. end;
  8867.  
  8868. function TDIB.Ink(DIB: TDIB; const SprayInit: Boolean; const AmountSpray: Integer): Boolean;
  8869. type
  8870.   T3Byte = array[0..2] of Byte;
  8871.   P3ByteArray = ^T3ByteArray;
  8872.   T3ByteArray = array[0..32767] of T3Byte;
  8873.   PLongArray = ^TLongArray;
  8874.   TLongArray = array[0..32767] of LongInt;
  8875.   function ColorToRGBTriple(const Color: TColor): TRGBTriple;
  8876.   begin
  8877.     with RESULT do
  8878.     begin
  8879.       rgbtRed := GetRValue(Color);
  8880.       rgbtGreen := GetGValue(Color);
  8881.       rgbtBlue := GetBValue(Color)
  8882.     end
  8883.   end {ColorToRGBTriple};
  8884.  
  8885.   function TestQuad(T: T3Byte; Color: Integer): Boolean;
  8886.   begin
  8887.     Result := (T[0] > GetRValue(Color)) and
  8888.       (T[1] > GetGValue(Color)) and
  8889.       (T[2] > GetBValue(Color))
  8890.   end;
  8891. var
  8892.   p0, p, p2: PByteArray;
  8893.   x, y, c: Integer;
  8894.   z: Integer;
  8895. begin
  8896.   if SprayInit then
  8897.   begin
  8898.     DIB.Assign(Self);
  8899.     { Spray seeds }
  8900.     for c := 0 to AmountSpray do
  8901.     begin
  8902.       DIB.Pixels[Random(Width - 1), Random(Height - 1)] := 0;
  8903.     end;
  8904.   end;
  8905.   Result := True; {all is black}
  8906.   for y := 0 to DIB.Height - 1 do
  8907.   begin
  8908.     p := DIB.ScanLine[y];
  8909.     for x := 0 to DIB.Width - 1 do
  8910.     begin
  8911.       case bitcount of
  8912.         8:
  8913.           begin
  8914.             if p[x] < 16 then
  8915.             begin
  8916.               if p[x] > 0 then Result := False;
  8917.               if y > 0 then
  8918.               begin
  8919.                 p0 := DIB.ScanLine[y - 1];
  8920.                 if p0[x] > 4 then
  8921.                   p0[x] := p0[x] - 4
  8922.                 else
  8923.                   p0[x] := 0;
  8924.                 if x > 0 then
  8925.                   if p0[x - 1] > 2 then
  8926.                     p0[x - 1] := p0[x - 1] - 2
  8927.                   else
  8928.                     p0[x - 1] := 0;
  8929.                 if x < (DIB.Width - 1) then
  8930.                   if p0[x + 1] > 2 then
  8931.                     p0[x + 1] := p0[x + 1] - 2
  8932.                   else
  8933.                     p0[x + 1] := 0;
  8934.               end;
  8935.               if y < (DIB.Height - 1) then
  8936.               begin
  8937.                 p2 := DIB.ScanLine[y + 1];
  8938.                 if p2[x] > 4 then
  8939.                   p2[x] := p2[x] - 4
  8940.                 else
  8941.                   p2[x] := 0;
  8942.                 if x > 0 then
  8943.                   if p2[x - 1] > 2 then
  8944.                     p2[x - 1] := p2[x - 1] - 2
  8945.                   else
  8946.                     p2[x - 1] := 0;
  8947.                 if x < (DIB.Width - 1) then
  8948.                   if p2[x + 1] > 2 then
  8949.                     p2[x + 1] := p2[x + 1] - 2
  8950.                   else
  8951.                     p2[x + 1] := 0;
  8952.               end;
  8953.               if p[x] > 8 then
  8954.                 p[x] := p[x] - 8
  8955.               else
  8956.                 p[x] := 0;
  8957.               if x > 0 then
  8958.                 if p[x - 1] > 4 then
  8959.                   p[x - 1] := p[x - 1] - 4
  8960.                 else
  8961.                   p[x - 1] := 0;
  8962.               if x < (DIB.Width - 1) then
  8963.                 if p[x + 1] > 4 then
  8964.                   p[x + 1] := p[x + 1] - 4
  8965.                 else
  8966.                   p[x + 1] := 0;
  8967.             end;
  8968.           end;
  8969.         16:
  8970.           begin
  8971.             if pwordarray(p)[x] < 16 then
  8972.             begin
  8973.               if pwordarray(p)[x] > 0 then Result := False;
  8974.               if y > 0 then
  8975.               begin
  8976.                 pwordarray(p0) := DIB.ScanLine[y - 1];
  8977.                 if pwordarray(p0)[x] > 4 then
  8978.                   pwordarray(p0)[x] := pwordarray(p0)[x] - 4
  8979.                 else
  8980.                   pwordarray(p0)[x] := 0;
  8981.                 if x > 0 then
  8982.                   if pwordarray(p0)[x - 1] > 2 then
  8983.                     pwordarray(p0)[x - 1] := pwordarray(p0)[x - 1] - 2
  8984.                   else
  8985.                     pwordarray(p0)[x - 1] := 0;
  8986.                 if x < (DIB.Width - 1) then
  8987.                   if pwordarray(p0)[x + 1] > 2 then
  8988.                     pwordarray(p0)[x + 1] := pwordarray(p0)[x + 1] - 2
  8989.                   else
  8990.                     pwordarray(p0)[x + 1] := 0;
  8991.               end;
  8992.               if y < (DIB.Height - 1) then
  8993.               begin
  8994.                 pwordarray(p2) := DIB.ScanLine[y + 1];
  8995.                 if pwordarray(p2)[x] > 4 then
  8996.                   pwordarray(p2)[x] := pwordarray(p2)[x] - 4
  8997.                 else
  8998.                   pwordarray(p2)[x] := 0;
  8999.                 if x > 0 then
  9000.                   if pwordarray(p2)[x - 1] > 2 then
  9001.                     pwordarray(p2)[x - 1] := pwordarray(p2)[x - 1] - 2
  9002.                   else
  9003.                     pwordarray(p2)[x - 1] := 0;
  9004.                 if x < (DIB.Width - 1) then
  9005.                   if pwordarray(p2)[x + 1] > 2 then
  9006.                     pwordarray(p2)[x + 1] := pwordarray(p2)[x + 1] - 2
  9007.                   else
  9008.                     pwordarray(p2)[x + 1] := 0;
  9009.               end;
  9010.               if pwordarray(p)[x] > 8 then
  9011.                 pwordarray(p)[x] := pwordarray(p)[x] - 8
  9012.               else
  9013.                 pwordarray(p)[x] := 0;
  9014.               if x > 0 then
  9015.                 if pwordarray(p)[x - 1] > 4 then
  9016.                   pwordarray(p)[x - 1] := pwordarray(p)[x - 1] - 4
  9017.                 else
  9018.                   pwordarray(p)[x - 1] := 0;
  9019.               if x < (DIB.Width - 1) then
  9020.                 if pwordarray(p)[x + 1] > 4 then
  9021.                   pwordarray(p)[x + 1] := pwordarray(p)[x + 1] - 4
  9022.                 else
  9023.                   pwordarray(p)[x + 1] := 0;
  9024.             end;
  9025.           end;
  9026.         24:
  9027.           begin
  9028.             if not TestQuad(P3ByteArray(p)[x], 16) then
  9029.             begin
  9030.               if TestQuad(P3ByteArray(p)[x], 0) then Result := False;
  9031.               if y > 0 then
  9032.               begin
  9033.                 P3ByteArray(p0) := DIB.ScanLine[y - 1];
  9034.                 if TestQuad(P3ByteArray(p0)[x], 4) then
  9035.                 begin
  9036.                   for z := 0 to 2 do
  9037.                     if P3ByteArray(p0)[x][z] > 4 then
  9038.                       P3ByteArray(p0)[x][z] := P3ByteArray(p0)[x][z] - 4
  9039.                 end
  9040.                 else
  9041.                   for z := 0 to 2 do
  9042.                     P3ByteArray(p0)[x][z] := 0;
  9043.                 if x > 0 then
  9044.                   if TestQuad(P3ByteArray(p0)[x - 1], 2) then
  9045.                   begin
  9046.                     for z := 0 to 2 do
  9047.                       if P3ByteArray(p0)[x - 1][z] > 2 then
  9048.                         P3ByteArray(p0)[x - 1][z] := P3ByteArray(p0)[x - 1][z] - 2
  9049.                   end
  9050.                   else
  9051.                     for z := 0 to 2 do
  9052.                       P3ByteArray(p0)[x - 1][z] := 0;
  9053.                 if x < (DIB.Width - 1) then
  9054.                   if TestQuad(P3ByteArray(p0)[x + 1], 2) then
  9055.                   begin
  9056.                     for z := 0 to 2 do
  9057.                       if P3ByteArray(p0)[x + 1][z] > 2 then
  9058.                         P3ByteArray(p0)[x + 1][z] := P3ByteArray(p0)[x + 1][z] - 2
  9059.                   end
  9060.                   else
  9061.                     for z := 0 to 2 do
  9062.                       P3ByteArray(p0)[x + 1][z] := 0;
  9063.               end;
  9064.               if y < (DIB.Height - 1) then
  9065.               begin
  9066.                 P3ByteArray(p2) := DIB.ScanLine[y + 1];
  9067.                 if TestQuad(P3ByteArray(p2)[x], 4) then
  9068.                 begin
  9069.                   for z := 0 to 2 do
  9070.                     if P3ByteArray(p2)[x][z] > 4 then
  9071.                       P3ByteArray(p2)[x][z] := P3ByteArray(p2)[x][z] - 4
  9072.                 end
  9073.                 else
  9074.                   for z := 0 to 2 do
  9075.                     P3ByteArray(p2)[x][z] := 0;
  9076.                 if x > 0 then
  9077.                   if TestQuad(P3ByteArray(p2)[x - 1], 2) then
  9078.                   begin
  9079.                     for z := 0 to 2 do
  9080.                       if P3ByteArray(p2)[x - 1][z] > 2 then
  9081.                         P3ByteArray(p2)[x - 1][z] := P3ByteArray(p2)[x - 1][z] - 2
  9082.                   end
  9083.                   else
  9084.                     for z := 0 to 2 do
  9085.                       P3ByteArray(p2)[x - 1][z] := 0;
  9086.                 if x < (DIB.Width - 1) then
  9087.                   if TestQuad(P3ByteArray(p2)[x + 1], 2) then
  9088.                   begin
  9089.                     for z := 0 to 2 do
  9090.                       if P3ByteArray(p2)[x + 1][z] > 2 then
  9091.                         P3ByteArray(p2)[x + 1][z] := P3ByteArray(p2)[x + 1][z] - 2
  9092.                   end
  9093.                   else
  9094.                     for z := 0 to 2 do
  9095.                       P3ByteArray(p2)[x + 1][z] := 0;
  9096.               end;
  9097.               if TestQuad(P3ByteArray(p)[x], 8) then
  9098.               begin
  9099.                 for z := 0 to 2 do
  9100.                   if P3ByteArray(p)[x][z] > 8 then
  9101.                     P3ByteArray(p)[x][z] := P3ByteArray(p)[x][z] - 8
  9102.               end
  9103.               else
  9104.                 for z := 0 to 2 do
  9105.                   P3ByteArray(p)[x][z] := 0;
  9106.               if x > 0 then
  9107.                 if TestQuad(P3ByteArray(p)[x - 1], 4) then
  9108.                 begin
  9109.                   for z := 0 to 2 do
  9110.                     if P3ByteArray(p)[x - 1][z] > 4 then
  9111.                       P3ByteArray(p)[x - 1][z] := P3ByteArray(p)[x - 1][z] - 4
  9112.                 end
  9113.                 else
  9114.                   for z := 0 to 2 do
  9115.                     P3ByteArray(p)[x - 1][z] := 0;
  9116.               if x < (DIB.Width - 1) then
  9117.                 if TestQuad(P3ByteArray(p)[x + 1], 4) then
  9118.                 begin
  9119.                   for z := 0 to 2 do
  9120.                     if P3ByteArray(p)[x + 1][z] > 4 then
  9121.                       P3ByteArray(p)[x + 1][z] := P3ByteArray(p)[x + 1][z] - 4
  9122.                 end
  9123.                 else
  9124.                   for z := 0 to 2 do
  9125.                     P3ByteArray(p)[x + 1][z] := 0;
  9126.             end;
  9127.           end;
  9128.         32:
  9129.           begin
  9130.             if plongarray(p)[x] < 16 then
  9131.             begin
  9132.               if plongarray(p)[x] > 0 then Result := False;
  9133.               if y > 0 then
  9134.               begin
  9135.                 plongarray(p0) := DIB.ScanLine[y - 1];
  9136.                 if plongarray(p0)[x] > 4 then
  9137.                   plongarray(p0)[x] := plongarray(p0)[x] - 4
  9138.                 else
  9139.                   plongarray(p0)[x] := 0;
  9140.                 if x > 0 then
  9141.                   if plongarray(p0)[x - 1] > 2 then
  9142.                     plongarray(p0)[x - 1] := plongarray(p0)[x - 1] - 2
  9143.                   else
  9144.                     plongarray(p0)[x - 1] := 0;
  9145.                 if x < (DIB.Width - 1) then
  9146.                   if plongarray(p0)[x + 1] > 2 then
  9147.                     plongarray(p0)[x + 1] := plongarray(p0)[x + 1] - 2
  9148.                   else
  9149.                     plongarray(p0)[x + 1] := 0;
  9150.               end;
  9151.               if y < (DIB.Height - 1) then
  9152.               begin
  9153.                 plongarray(p2) := DIB.ScanLine[y + 1];
  9154.                 if plongarray(p2)[x] > 4 then
  9155.                   plongarray(p2)[x] := plongarray(p2)[x] - 4
  9156.                 else
  9157.                   plongarray(p2)[x] := 0;
  9158.                 if x > 0 then
  9159.                   if plongarray(p2)[x - 1] > 2 then
  9160.                     plongarray(p2)[x - 1] := plongarray(p2)[x - 1] - 2
  9161.                   else
  9162.                     plongarray(p2)[x - 1] := 0;
  9163.                 if x < (DIB.Width - 1) then
  9164.                   if plongarray(p2)[x + 1] > 2 then
  9165.                     plongarray(p2)[x + 1] := plongarray(p2)[x + 1] - 2
  9166.                   else
  9167.                     plongarray(p2)[x + 1] := 0;
  9168.               end;
  9169.               if plongarray(p)[x] > 8 then
  9170.                 plongarray(p)[x] := plongarray(p)[x] - 8
  9171.               else
  9172.                 plongarray(p)[x] := 0;
  9173.               if x > 0 then
  9174.                 if plongarray(p)[x - 1] > 4 then
  9175.                   plongarray(p)[x - 1] := plongarray(p)[x - 1] - 4
  9176.                 else
  9177.                   plongarray(p)[x - 1] := 0;
  9178.               if x < (DIB.Width - 1) then
  9179.                 if plongarray(p)[x + 1] > 4 then
  9180.                   plongarray(p)[x + 1] := plongarray(p)[x + 1] - 4
  9181.                 else
  9182.                   plongarray(p)[x + 1] := 0;
  9183.             end;
  9184.           end;
  9185.       end {case};
  9186.     end;
  9187.   end;
  9188. end;
  9189.  
  9190. procedure TDIB.Distort(DIB1: TDIB; dt: TDistortType; cX, cY, Angle: Integer; Factor: Real);
  9191. type
  9192.   T3Byte = array[0..2] of Byte;
  9193.   P3ByteArray = ^T3ByteArray;
  9194.   T3ByteArray = array[0..32767] of T3Byte;
  9195.   PLongArray = ^TLongArray;
  9196.   TLongArray = array[0..32767] of LongInt;
  9197. var
  9198.   p, p2: PByteArray;
  9199.   x, y, x2, y2, angled, ysqr: Integer;
  9200.   actdist, dist, cosy, siny: real;
  9201. begin
  9202.   dist := Factor * sqrt(sqr(cX) + sqr(cY));
  9203.   for y := 0 to DIB1.Height - 1 do
  9204.   begin
  9205.     p := DIB1.ScanLine[y];
  9206.     ysqr := sqr(y - cY);
  9207.     for x := 0 to (DIB1.Width) - 1 do
  9208.     begin
  9209.       actdist := (sqrt((sqr(x - cX) + ysqr)) / dist);
  9210.       if dt = dtSlow then
  9211.         actdist := dsin((Trunc(actdist * 1024)) and $1FF);
  9212.       angled := 384 + Trunc((actdist) * Angle);
  9213.  
  9214.       cosy := (y - cY) * dcos(angled and $1FF);
  9215.       siny := (y - cY) * dsin(angled and $1FF);
  9216.  
  9217.       x2 := Trunc((x - cX) * dsin(angled and $1FF) + cosy) + cX;
  9218.       y2 := Trunc((x - cX) * dcos(angled and $1FF) - siny) + cY;
  9219.       case bitcount of
  9220.         8:
  9221.           begin
  9222.             if (y2 >= 0) and (y2 < Height) and (x2 >= 0) and (x2 < Width) then
  9223.             begin
  9224.               p2 := ScanLine[y2];
  9225.               p[x] := p2[Width - x2];
  9226.             end
  9227.             else
  9228.             begin
  9229.               if p[x] > 2 then
  9230.                 p[x] := p[x] - 2
  9231.               else
  9232.                 p[x] := 0;
  9233.             end;
  9234.           end;
  9235.         16:
  9236.           begin
  9237.             if (y2 >= 0) and (y2 < Height) and (x2 >= 0) and (x2 < Width) then
  9238.             begin
  9239.               pwordarray(p2) := ScanLine[y2];
  9240.               pwordarray(p)[x] := pwordarray(p2)[Width - x2];
  9241.             end
  9242.             else
  9243.             begin
  9244.               if pwordarray(p)[x] > 2 then
  9245.                 pwordarray(p)[x] := pwordarray(p)[x] - 2
  9246.               else
  9247.                 pwordarray(p)[x] := 0;
  9248.             end;
  9249.           end;
  9250.         24:
  9251.           begin
  9252.             if (y2 >= 0) and (y2 < Height) and (x2 >= 0) and (x2 < Width) then
  9253.             begin
  9254.               P3ByteArray(p2) := ScanLine[y2];
  9255.               P3ByteArray(p)[x] := P3ByteArray(p2)[Width - x2];
  9256.             end
  9257.             else
  9258.             begin
  9259.               if P3ByteArray(p)[x][0] > 2 then
  9260.                 P3ByteArray(p)[x][0] := P3ByteArray(p)[x][0] - 2
  9261.               else if P3ByteArray(p)[x][1] > 2 then
  9262.                 P3ByteArray(p)[x][1] := P3ByteArray(p)[x][1] - 2
  9263.               else if P3ByteArray(p)[x][2] > 2 then
  9264.                 P3ByteArray(p)[x][2] := P3ByteArray(p)[x][2] - 2
  9265.               else
  9266.               begin
  9267.                 P3ByteArray(p)[x][0] := 0;
  9268.                 P3ByteArray(p)[x][1] := 0;
  9269.                 P3ByteArray(p)[x][2] := 0;
  9270.               end;
  9271.             end;
  9272.           end;
  9273.         32:
  9274.           begin
  9275.             if (y2 >= 0) and (y2 < Height) and (x2 >= 0) and (x2 < Width) then
  9276.             begin
  9277.               plongarray(p2) := ScanLine[y2];
  9278.               plongarray(p)[x] := plongarray(p2)[Width - x2];
  9279.             end
  9280.             else
  9281.             begin
  9282.               if p[x] > 2 then
  9283.                 plongarray(p)[x] := plongarray(p)[x] - 2
  9284.               else
  9285.                 plongarray(p)[x] := 0;
  9286.             end;
  9287.           end;
  9288.       end {case}
  9289.     end;
  9290.   end;
  9291. end;
  9292.  
  9293. procedure TDIB.AntialiasedLine(x1, y1, x2, y2: Integer; color: TColor);
  9294. //anti-aliased line using the Wu algorithm by Peter Bone
  9295. var
  9296.   dX, dY, X, Y, start, finish: Integer;
  9297.   LM, LR: Integer;
  9298.   dxi, dyi, dydxi: Integer;
  9299.   P: PLines;
  9300.   R, G, B: byte;
  9301. begin
  9302.   R := GetRValue(Color);
  9303.   G := GetGValue(Color);
  9304.   B := GetBValue(Color);
  9305.   dX := abs(x2 - x1); // Calculate deltax and deltay for initialisation
  9306.   dY := abs(y2 - y1);
  9307.   if (dX = 0) or (dY = 0) then
  9308.   begin
  9309.     Canvas.Pen.Color := (B shl 16) + (G shl 8) + R;
  9310.     Canvas.MoveTo(x1, y1);
  9311.     Canvas.LineTo(x2, y2);
  9312.     exit;
  9313.   end;
  9314.   if dX > dY then
  9315.   begin // horizontal or vertical
  9316.     if y2 > y1 then // determine rise and run
  9317.       dydxi := -dY shl 16 div dX
  9318.     else
  9319.       dydxi := dY shl 16 div dX;
  9320.     if x2 < x1 then
  9321.     begin
  9322.       start := x2; // right to left
  9323.       finish := x1;
  9324.       dyi := y2 shl 16;
  9325.     end
  9326.     else
  9327.     begin
  9328.       start := x1; // left to right
  9329.       finish := x2;
  9330.       dyi := y1 shl 16;
  9331.       dydxi := -dydxi; // inverse slope
  9332.     end;
  9333.     if finish >= Width then finish := Width - 1;
  9334.     for X := start to finish do
  9335.     begin
  9336.       Y := dyi shr 16;
  9337.       if (X < 0) or (Y < 0) or (Y > Height - 2) then
  9338.       begin
  9339.         Inc(dyi, dydxi);
  9340.         Continue;
  9341.       end;
  9342.       LM := dyi - Y shl 16; // fractional part of dyi - in fixed-point
  9343.       LR := 65536 - LM;
  9344.       P := Scanline[Y];
  9345.       P^[X].B := (B * LR + P^[X].B * LM) shr 16;
  9346.       P^[X].G := (G * LR + P^[X].G * LM) shr 16;
  9347.       P^[X].R := (R * LR + P^[X].R * LM) shr 16;
  9348.       //Inc(Y);
  9349.       P^[X].B := (B * LM + P^[X].B * LR) shr 16;
  9350.       P^[X].G := (G * LM + P^[X].G * LR) shr 16;
  9351.       P^[X].R := (R * LM + P^[X].R * LR) shr 16;
  9352.       Inc(dyi, dydxi); // next point
  9353.     end;
  9354.   end
  9355.   else
  9356.   begin
  9357.     if x2 > x1 then // determine rise and run
  9358.       dydxi := -dX shl 16 div dY
  9359.     else
  9360.       dydxi := dX shl 16 div dY;
  9361.     if y2 < y1 then
  9362.     begin
  9363.       start := y2; // right to left
  9364.       finish := y1;
  9365.       dxi := x2 shl 16;
  9366.     end
  9367.     else
  9368.     begin
  9369.       start := y1; // left to right
  9370.       finish := y2;
  9371.       dxi := x1 shl 16;
  9372.       dydxi := -dydxi; // inverse slope
  9373.     end;
  9374.     if finish >= Height then finish := Height - 1;
  9375.     for Y := start to finish do
  9376.     begin
  9377.       X := dxi shr 16;
  9378.       if (Y < 0) or (X < 0) or (X > Width - 2) then
  9379.       begin
  9380.         Inc(dxi, dydxi);
  9381.         Continue;
  9382.       end;
  9383.       LM := dxi - X shl 16;
  9384.       LR := 65536 - LM;
  9385.       P := Scanline[Y];
  9386.       P^[X].B := (B * LR + P^[X].B * LM) shr 16;
  9387.       P^[X].G := (G * LR + P^[X].G * LM) shr 16;
  9388.       P^[X].R := (R * LR + P^[X].R * LM) shr 16;
  9389.       Inc(X);
  9390.       P^[X].B := (B * LM + P^[X].B * LR) shr 16;
  9391.       P^[X].G := (G * LM + P^[X].G * LR) shr 16;
  9392.       P^[X].R := (R * LM + P^[X].R * LR) shr 16;
  9393.       Inc(dxi, dydxi); // next point
  9394.     end;
  9395.   end;
  9396. end;
  9397. (*
  9398. function TDIB.GetColorBetween(StartColor, EndColor: TColor; Pointvalue,
  9399.   FromPoint, ToPoint: Extended): TColor;
  9400. var F: Extended; r1, r2, r3, g1, g2, g3, b1, b2, b3: Byte;
  9401.   function CalcColorBytes(fb1, fb2: Byte): Byte;
  9402.   begin
  9403.     result := fb1;
  9404.     if fb1 < fb2 then Result := FB1 + Trunc(F * (fb2 - fb1));
  9405.     if fb1 > fb2 then Result := FB1 - Trunc(F * (fb1 - fb2));
  9406.   end;
  9407. begin
  9408.   if Pointvalue <= FromPoint then
  9409.   begin
  9410.     result := StartColor;
  9411.     exit;
  9412.   end;
  9413.   if Pointvalue >= ToPoint then
  9414.   begin
  9415.     result := EndColor;
  9416.     exit;
  9417.   end;
  9418.   F := (Pointvalue - FromPoint) / (ToPoint - FromPoint);
  9419.   asm
  9420.     mov EAX, Startcolor
  9421.     cmp EAX, EndColor
  9422.     je @@exit  //when equal then exit
  9423.     mov r1, AL
  9424.     shr EAX,8
  9425.     mov g1, AL
  9426.     shr EAX,8
  9427.     mov b1, AL
  9428.     mov EAX, Endcolor
  9429.     mov r2, AL
  9430.     shr EAX,8
  9431.     mov g2, AL
  9432.     shr EAX,8
  9433.     mov b2, AL
  9434.     push ebp
  9435.     mov AL, r1
  9436.     mov DL, r2
  9437.     call CalcColorBytes
  9438.     pop ECX
  9439.     push EBP
  9440.     Mov r3, AL
  9441.     mov DL, g2
  9442.     mov AL, g1
  9443.     call CalcColorBytes
  9444.     pop ECX
  9445.     push EBP
  9446.     mov g3, Al
  9447.     mov DL, B2
  9448.     mov Al, B1
  9449.     call CalcColorBytes
  9450.     pop ECX
  9451.     mov b3, AL
  9452.     XOR EAX,EAX
  9453.     mov AL, B3
  9454.     shl EAX,8
  9455.     mov AL, G3
  9456.     shl EAX,8
  9457.     mov AL, R3
  9458.   @@Exit:
  9459.     mov @result, EAX
  9460.   end;
  9461. end;
  9462. *)
  9463. function TDIB.GetColorBetween(StartColor, EndColor: TColor; Pointvalue, FromPoint, ToPoint: Extended): TColor;
  9464. var
  9465.   F: Extended;
  9466.   r1, g1, b1, r2, g2, b2, r3, g3, b3: Byte;
  9467.  
  9468.   function CalcColorBytes(const factor: Extended; const fb1, fb2: Byte): Byte; {$IFDEF VER9UP}inline;{$ENDIF}
  9469.   begin
  9470.     Result := fb1;
  9471.     if fb1 < fb2 then Result := fb1 + Trunc(factor * (fb2 - fb1));
  9472.     if fb1 > fb2 then Result := fb1 - Trunc(factor * (fb1 - fb2));
  9473.   end;
  9474.  
  9475.   procedure GetRGB(const AColor: TColor; var R, G, B: Byte); {$IFDEF VER9UP}inline;{$ENDIF}
  9476.   begin
  9477.     R := AColor and $FF;
  9478.     G := (AColor shr 8) and $FF;
  9479.     B := (AColor shr 16) and $FF;
  9480.   end;
  9481.  
  9482. begin
  9483.   if Pointvalue <= FromPoint then
  9484.   begin
  9485.     Result := StartColor;
  9486.     Exit;
  9487.   end;
  9488.   if Pointvalue >= ToPoint then
  9489.   begin
  9490.     Result := EndColor;
  9491.     Exit;
  9492.   end;
  9493.  
  9494.   F := (Pointvalue - FromPoint) / (ToPoint - FromPoint);
  9495.  
  9496.   GetRGB(StartColor, r1, g1, b1);
  9497. //  r1 := StartColor and $FF;
  9498. //  g1 := (StartColor shr 8) and $FF;
  9499. //  b1 := (StartColor shr 16) and $FF;
  9500.   GetRGB(StartColor, r2, g2, b2);
  9501. //  r2 := EndColor and $FF;
  9502. //  g2 := (EndColor shr 8) and $FF;
  9503. //  b2 := (EndColor shr 16) and $FF;
  9504.  
  9505.   r3 := CalcColorBytes(F, r1, r2);
  9506.   g3 := CalcColorBytes(F, g1, g2);
  9507.   b3 := CalcColorBytes(F, b1, b2);
  9508.  
  9509.   Result := (b3 shl 16) or (g3 shl 8) or r3;
  9510. end;
  9511.  
  9512. procedure TDIB.ColoredLine(const iStart, iEnd: TPoint; iColorStyle: TColorLineStyle;
  9513.   iGradientFrom, iGradientTo: TColor; iPixelGeometry: TColorLinePixelGeometry; iRadius: Word);
  9514. var
  9515.   tempColor: TColor;
  9516. const
  9517.   WavelengthMinimum = 380;
  9518.   WavelengthMaximum = 780;
  9519.  
  9520.   procedure SetColor(Color: TColor);
  9521.   begin
  9522.     Canvas.Pen.Color := Color;
  9523.     Canvas.Brush.Color := Color;
  9524.     tempColor := Color
  9525.   end {SetColor};
  9526.  
  9527.   function WL2RGB(const Wavelength: Double): TColor; {$IFDEF VER9UP}inline;{$ENDIF}
  9528.   const
  9529.     Gamma = 0.80;
  9530.     IntensityMax = 255;
  9531.   var
  9532.     Red, Blue, Green, Factor: Double;
  9533.  
  9534.     function Adjust(const Color, Factor: Double): Integer; {$IFDEF VER9UP}inline;{$ENDIF}
  9535.     begin
  9536.       if Color = 0.0 then Result := 0
  9537.       else Result := Round(IntensityMax * Power(Color * Factor, Gamma))
  9538.     end {Adjust};
  9539.   begin
  9540.     case Trunc(Wavelength) of
  9541.       380..439:
  9542.         begin
  9543.           Red := -(Wavelength - 440) / (440 - 380);
  9544.           Green := 0.0;
  9545.           Blue := 1.0
  9546.         end;
  9547.       440..489:
  9548.         begin
  9549.           Red := 0.0;
  9550.           Green := (Wavelength - 440) / (490 - 440);
  9551.           Blue := 1.0
  9552.         end;
  9553.       490..509:
  9554.         begin
  9555.           Red := 0.0;
  9556.           Green := 1.0;
  9557.           Blue := -(Wavelength - 510) / (510 - 490)
  9558.         end;
  9559.       510..579:
  9560.         begin
  9561.           Red := (Wavelength - 510) / (580 - 510);
  9562.           Green := 1.0;
  9563.           Blue := 0.0
  9564.         end;
  9565.       580..644:
  9566.         begin
  9567.           Red := 1.0;
  9568.           Green := -(Wavelength - 645) / (645 - 580);
  9569.           Blue := 0.0
  9570.         end;
  9571.       645..780:
  9572.         begin
  9573.           Red := 1.0;
  9574.           Green := 0.0;
  9575.           Blue := 0.0
  9576.         end;
  9577.     else
  9578.       Red := 0.0;
  9579.       Green := 0.0;
  9580.       Blue := 0.0
  9581.     end;
  9582.     case Trunc(Wavelength) of
  9583.       380..419: factor := 0.3 + 0.7 * (Wavelength - 380) / (420 - 380);
  9584.       420..700: factor := 1.0;
  9585.       701..780: factor := 0.3 + 0.7 * (780 - Wavelength) / (780 - 700)
  9586.     else
  9587.       factor := 0.0
  9588.     end;
  9589.     Result := RGB(Adjust(Red, Factor), Adjust(Green, Factor), Adjust(Blue, Factor));
  9590.   end;
  9591.  
  9592.   function Rainbow(const fraction: Double): TColor; {$IFDEF VER9UP}inline;{$ENDIF}
  9593.   begin
  9594.     if (fraction < 0.0) or (fraction > 1.0) then Result := clBlack
  9595.     else
  9596.       Result := WL2RGB(WavelengthMinimum + Fraction * (WavelengthMaximum - WavelengthMinimum))
  9597.   end {Raindbow};
  9598.  
  9599.   function ColorInterpolate(const fraction: Double; const Color1, Color2: TColor): TColor; {$IFDEF VER9UP}inline;{$ENDIF}
  9600.   var
  9601.     complement: Double;
  9602.     R1, R2, G1, G2, B1, B2: BYTE;
  9603.   begin
  9604.     if fraction <= 0 then Result := Color1
  9605.     else
  9606.       if fraction >= 1.0 then Result := Color2
  9607.       else
  9608.       begin
  9609.         R1 := GetRValue(Color1);
  9610.         G1 := GetGValue(Color1);
  9611.         B1 := GetBValue(Color1);
  9612.         R2 := GetRValue(Color2);
  9613.         G2 := GetGValue(Color2);
  9614.         B2 := GetBValue(Color2);
  9615.         complement := 1.0 - fraction;
  9616.         Result := RGB(Round(complement * R1 + fraction * R2),
  9617.           Round(complement * G1 + fraction * G2),
  9618.           Round(complement * B1 + fraction * B2))
  9619.       end
  9620.   end {ColorInterpolate};
  9621.  
  9622.   // Conversion utility routines
  9623.   function ColorToRGBTriple(const Color: TColor): TRGBTriple; {$IFDEF VER9UP}inline;{$ENDIF}
  9624.   begin
  9625.     with Result do
  9626.     begin
  9627.       rgbtRed := GetRValue(Color);
  9628.       rgbtGreen := GetGValue(Color);
  9629.       rgbtBlue := GetBValue(Color)
  9630.     end
  9631.   end {ColorToRGBTriple};
  9632.  
  9633.   function RGBTripleToColor(const Triple: TRGBTriple): TColor; {$IFDEF VER9UP}inline;{$ENDIF}
  9634.   begin
  9635.     Result := RGB(Triple.rgbtRed, Triple.rgbtGreen, Triple.rgbtBlue)
  9636.   end {RGBTripleToColor};
  9637. // Bresenham's Line Algorithm.  Byte, March 1988, pp. 249-253.
  9638. var
  9639.   a, b, d, diag_inc, dXdg, dXndg, dYdg, dYndg, i, nDginc, nDswap, x, y: Integer;
  9640. begin {DrawLine}
  9641.   x := iStart.X;
  9642.   y := iStart.Y;
  9643.   a := iEnd.X - iStart.X;
  9644.   b := iEnd.Y - iStart.Y;
  9645.   if a < 0 then
  9646.   begin
  9647.     a := -a;
  9648.     dXdg := -1
  9649.   end
  9650.   else dXdg := 1;
  9651.   if b < 0 then
  9652.   begin
  9653.     b := -b;
  9654.     dYdg := -1
  9655.   end
  9656.   else dYdg := 1;
  9657.   if a < b then
  9658.   begin
  9659.     nDswap := a;
  9660.     a := b;
  9661.     b := nDswap;
  9662.     dXndg := 0;
  9663.     dYndg := dYdg
  9664.   end
  9665.   else
  9666.   begin
  9667.     dXndg := dXdg;
  9668.     dYndg := 0
  9669.   end;
  9670.   d := b + b - a;
  9671.   nDginc := b + b;
  9672.   diag_inc := b + b - a - a;
  9673.   for i := 0 to a do
  9674.   begin
  9675.     case iPixelGeometry of
  9676.       pgPoint:
  9677.         case iColorStyle of
  9678.           csSolid:
  9679.             Canvas.Pixels[x, y] := tempColor;
  9680.           csGradient:
  9681.             Canvas.Pixels[x, y] := ColorInterpolate(i / a, iGradientFrom, iGradientTo);
  9682.           csRainbow:
  9683.             Canvas.Pixels[x, y] := Rainbow(i / a)
  9684.         end;
  9685.       pgCircular:
  9686.         begin
  9687.           case iColorStyle of
  9688.             csSolid: ;
  9689.             csGradient: SetColor(ColorInterpolate(i / a, iGradientFrom, iGradientTo));
  9690.             csRainbow: SetColor(Rainbow(i / a))
  9691.           end;
  9692.           Canvas.Ellipse(x - iRadius, y - iRadius, x + iRadius, y + iRadius)
  9693.         end;
  9694.       pgRectangular:
  9695.         begin
  9696.           case iColorStyle of
  9697.             csSolid: ;
  9698.             csGradient: SetColor(ColorInterpolate(i / a, iGradientFrom, iGradientTo));
  9699.             csRainbow: SetColor(Rainbow(i / a))
  9700.           end;
  9701.           Canvas.Rectangle(x - iRadius, y - iRadius, x + iRadius, y + iRadius)
  9702.         end
  9703.     end;
  9704.     if d < 0 then
  9705.     begin
  9706.       Inc(x, dXndg);
  9707.       Inc(y, dYndg);
  9708.       Inc(d, nDginc);
  9709.     end
  9710.     else
  9711.     begin
  9712.       Inc(x, dXdg);
  9713.       Inc(y, dYdg);
  9714.       Inc(d, diag_inc);
  9715.     end
  9716.   end
  9717. end {Line};
  9718.  
  9719. procedure TDIB.DoNovaEffect(const sr, sg, sb, cx, cy, radius,
  9720.   nspokes, randomhue, randomspok, randgauss: Integer; onProgress: TProgressEvent);
  9721. // Copyright (c) 2000 by Keith Murray (kmurray@hotfreeware.com)
  9722. // All rights reserved.
  9723. // Adapted for DIB by JB.
  9724. type
  9725.   PByteArray = ^TByteArray;
  9726.   TByteArray = array[0..32767] of Byte;
  9727.   PDoubleArray = ^TDoubleArray;
  9728.   TDoubleArray = array[0..0] of Double;
  9729.   PIntegerArray = ^TIntegerArray;
  9730.   TIntegerArray = array[0..0] of Integer;
  9731. type
  9732.   TProgressEvent = procedure(progress: Integer; message: string;
  9733.     var cancel: Boolean) of object;
  9734. const
  9735.   M_PI = 3.14159265358979323846;
  9736.   RAND_MAX = 2147483647;
  9737.  
  9738.   function Gauss(const randgauss: Integer): double; {$IFDEF VER9UP}inline;{$ENDIF}
  9739.   const magnitude = 6;
  9740.   var
  9741.     sum: double;
  9742.     i: Integer;
  9743.   begin
  9744.     sum := 0;
  9745.     for i := 1 to magnitude do
  9746.       sum := sum + (randgauss / 2147483647);
  9747.     result := sum / magnitude;
  9748.   end;
  9749.  
  9750.   function Clamp(const i, l, h: double): double; {$IFDEF VER9UP}inline;{$ENDIF}
  9751.   begin
  9752.     if i < l then
  9753.       result := l
  9754.     else
  9755.       if i > h then
  9756.         result := h
  9757.       else
  9758.         result := i;
  9759.   end;
  9760.  
  9761.   function IClamp(const i, l, h: Integer): Integer; {$IFDEF VER9UP}inline;{$ENDIF}
  9762.   begin
  9763.     if i < l then
  9764.       result := l
  9765.     else if i > h then
  9766.       result := h
  9767.     else result := i;
  9768.   end;
  9769.   {$IFNDEF VER9UP}
  9770.   procedure rgb_to_hsl(const r, g, b: Double; var h, s, l: Double); {$IFDEF VER9UP}inline;{$ENDIF}
  9771.   {$IFNDEF VER4UP}
  9772.     function Max(a, b: Double): Double;
  9773.     begin
  9774.       Result := a; if b > a then Result := b;
  9775.     end;
  9776.     function Min(a, b: Double): Double;
  9777.     begin
  9778.       Result := a; if b < a then Result := b;
  9779.     end;
  9780.   {$ENDIF}
  9781.   var
  9782.     v, m, vm: Double;
  9783.     r2, g2, b2: Double;
  9784.   begin
  9785.     h := 0;
  9786.     s := 0;
  9787.     l := 0;
  9788.     v := Max(r, g);
  9789.     v := Max(v, b);
  9790.     m := Min(r, g);
  9791.     m := Min(m, b);
  9792.     l := (m + v) / 2.0;
  9793.     if l <= 0.0 then
  9794.       exit;
  9795.     vm := v - m;
  9796.     s := vm;
  9797.     if s > 0.0 then
  9798.     begin
  9799.       if l <= 0.5 then
  9800.         s := s / (v + m)
  9801.       else s := s / (2.0 - v - m);
  9802.     end
  9803.     else exit;
  9804.     r2 := (v - 4) / vm;
  9805.     g2 := (v - g) / vm;
  9806.     b2 := (v - b) / vm;
  9807.     if r = v then
  9808.     begin
  9809.       if g = m then
  9810.         h := b2 + 5.0
  9811.       else h := 1.0 - g2;
  9812.     end
  9813.     else if g = v then
  9814.     begin
  9815.       if b = m then
  9816.         h := 1.0 + r2
  9817.       else h := 3.0 - b2;
  9818.     end
  9819.     else
  9820.     begin
  9821.       if r = m then
  9822.         h := 3.0 + g2
  9823.       else h := 5.0 - r2;
  9824.     end;
  9825.     h := h / 6;
  9826.   end;
  9827.  
  9828.   procedure hsl_to_rgb(h, sl, l: Double; var r, g, b: Double); {$IFDEF VER9UP}inline;{$ENDIF}
  9829.   var
  9830.     v: Double;
  9831.     m, sv: Double;
  9832.     sextant: Integer;
  9833.     fract, vsf, mid1, mid2: Double;
  9834.   begin
  9835.     if l <= 0.5 then
  9836.       v := l * (1.0 + sl)
  9837.     else v := l + sl - l * sl;
  9838.     if v <= 0 then
  9839.     begin
  9840.       r := 0.0;
  9841.       g := 0.0;
  9842.       b := 0.0;
  9843.     end
  9844.     else
  9845.     begin
  9846.       m := l + l - v;
  9847.       sv := (v - m) / v;
  9848.       h := h * 6.0;
  9849.       sextant := Trunc(h);
  9850.       fract := h - sextant;
  9851.       vsf := v * sv * fract;
  9852.       mid1 := m + vsf;
  9853.       mid2 := v - vsf;
  9854.       case sextant of
  9855.         0:
  9856.           begin
  9857.             r := v; g := mid1; b := m;
  9858.           end;
  9859.         1:
  9860.           begin
  9861.             r := mid2; g := v; b := m;
  9862.           end;
  9863.         2:
  9864.           begin
  9865.             r := m; g := v; b := mid1;
  9866.           end;
  9867.         3:
  9868.           begin
  9869.             r := m; g := mid2; b := v;
  9870.           end;
  9871.         4:
  9872.           begin
  9873.             r := mid1; g := m; b := v;
  9874.           end;
  9875.         5:
  9876.           begin
  9877.             r := v; g := m; b := mid2;
  9878.           end;
  9879.       end;
  9880.     end;
  9881.   end;
  9882.   {$ELSE}
  9883.   procedure rgb_to_hsl(const r, g, b: Double; var h, s, l: Double); {$IFDEF VER9UP}inline;{$ENDIF}
  9884.   var
  9885.     h0, s0, l0: Word;
  9886.   begin  //procedure ColorRGBToHLS(clrRGB: TColorRef; var Hue, Luminance, Saturation: Word);
  9887.     GraphUtil.ColorRGBToHLS(RGB(Trunc(r),Trunc(g),Trunc(b)), h0, s0, l0);
  9888.     h := h0;
  9889.     s := s0;
  9890.     l := l0;
  9891.   end;
  9892.  
  9893.   procedure hsl_to_rgb(h, sl, l: Double; var r, g, b: Double); {$IFDEF VER9UP}inline;{$ENDIF}
  9894.   var X: TColorRef;
  9895.   begin //function ColorHLSToRGB(Hue, Luminance, Saturation: Word): TColorRef;
  9896.     X := GraphUtil.ColorHLSToRGB(Trunc(h), Trunc(l), Trunc(sl));
  9897.     r := GetRValue(X);
  9898.     g := GetGValue(X);
  9899.     b := GetBValue(X);
  9900.   end;
  9901.   {$ENDIF}
  9902.  
  9903. var
  9904.   src_row, dest_row: PByte;
  9905.   src, dest: PByteArray;
  9906.   color, colors: array[0..3] of Integer;
  9907.   SpokeColor: PIntegerArray;
  9908.   spoke: PDoubleArray;
  9909.   x2, row, col, x, y, alpha, has_alpha, bpp, xc, yc, i, j: Integer;
  9910.   u, v, l, l0, w, w1, c, nova_alpha, new_alpha, compl_ratio, ratio, r, g, b, h, s, lu, SpokeCol: Double;
  9911.   dstDIB: TDIB;
  9912. begin
  9913.   colors[0] := sr;
  9914.   colors[1] := sg;
  9915.   colors[2] := sb;
  9916.   new_alpha := 0;
  9917.  
  9918.   GetMem(spoke, NSpokes * sizeof(Double));
  9919.   GetMem(spokecolor, NSpokes * sizeof(Integer) * 3);
  9920.   dstDIB := TDIB.Create;
  9921.   try
  9922.     dstDIB.Assign(Self);
  9923.     dstDIB.Canvas.Brush.Color := clBlack;
  9924.     dstDIB.Canvas.FillRect(dstDIB.Canvas.ClipRect);
  9925.     //         R                  G                  B
  9926.     rgb_to_hsl(colors[0] / 255.0, colors[1] / 255.0, colors[2] / 255.0, h, s, lu);
  9927.  
  9928.     for i := 0 to NSpokes - 1 do
  9929.     begin
  9930.       spoke[i] := gauss(randgauss);
  9931.       h := h + randomhue / 360.0 * ({Random(RAND_MAX)}RandomSpok / RAND_MAX - 0.5);
  9932.       if h < 0 then
  9933.         h := h + 1.0
  9934.       else if h > 1.0 then
  9935.         h := h - 1.0;
  9936.       hsl_to_rgb(h, s, lu, r, g, b);
  9937.       spokecolor[3 * i + 0] := Trunc(255 * r);
  9938.       spokecolor[3 * i + 1] := Trunc(255 * g);
  9939.       spokecolor[3 * i + 2] := Trunc(255 * b);
  9940.     end;
  9941.  
  9942.     xc := cx;
  9943.     yc := cy;
  9944.     l0 := (x2 - xc) / 4 + 1;
  9945.     bpp := Self.BitCount div 8;
  9946.     has_alpha := 0;
  9947.     alpha := bpp;
  9948.     y := 0;
  9949.     for row := 0 to Self.Height - 1 do
  9950.     begin
  9951.       src_row := Self.ScanLine[row];
  9952.       dest_row := dstDIB.ScanLine[row];
  9953.       src := Pointer(src_row);
  9954.       dest := Pointer(dest_row);
  9955.       x := 0;
  9956.       for col := 0 to Self.Width - 1 do
  9957.       begin
  9958.         u := (x - xc) / radius;
  9959.         v := (y - yc) / radius;
  9960.         l := sqrt(sqr(u) + sqr(v));
  9961.         c := (arctan2(u, v) / (2 * M_PI) + 0.51) * NSpokes;
  9962.         i := floor(c);
  9963.         c := c - i;
  9964.         i := i mod NSpokes;
  9965.         w1 := spoke[i] * (1 - c) + spoke[(i + 1) mod NSpokes] * c;
  9966.         w1 := w1 * w1;
  9967.         w := 1 / (l + 0.001) * 0.9;
  9968.         nova_alpha := Clamp(w, 0.0, 1.0);
  9969.         ratio := nova_alpha;
  9970.         compl_ratio := 1.0 - ratio;
  9971.         for j := 0 to alpha - 1 do
  9972.         begin
  9973.           spokecol := spokecolor[3 * i + j] * (1.0 - c) + spokecolor[3 * ((i + 1) mod nspokes) + j] * c;
  9974.           if w > 1.0 then
  9975.             color[j] := IClamp(Trunc(spokecol * w), 0, 255)
  9976.           else
  9977.             color[j] := Trunc(src[j] * compl_ratio + spokecol * ratio);
  9978.           color[j] := Trunc(color[j] + 255 * Clamp(w1 * w, 0.0, 1.0));
  9979.           dest[j] := IClamp(color[j], 0, 255);
  9980.         end;
  9981.         {$IFDEF WIN64}
  9982.         Inc(PByte(src), bpp);
  9983.         Inc(PBYTE(dest), bpp);
  9984.         {$ELSE}
  9985.         Inc(Integer(src), bpp);
  9986.         Inc(Integer(dest), bpp);
  9987.         {$ENDIF}
  9988.         Inc(x);
  9989.       end;
  9990.       Inc(y);
  9991.     end;
  9992.     Self.Assign(dstDIB);
  9993.   finally
  9994.     dstDIB.Free;
  9995.     FreeMem(Spoke);
  9996.     FreeMem(SpokeColor);
  9997.   end;
  9998. end;
  9999.  
  10000. procedure TDIB.DrawMandelbrot(ao, au: Integer; bo, bu: Double);
  10001. var
  10002.   c1, c2, z1, z2, tmp: Double;
  10003.   i, j, Count: Integer;
  10004.   dstDIB: TDIB;
  10005.   X, Y: Double;
  10006.   X2, Y2: Integer;
  10007. begin
  10008.   dstDIB := TDIB.Create;
  10009.   dstDIB.Assign(Self);
  10010.   X2 := dstDIB.FWidth;
  10011.   Y2 := dstDIB.FHeight;
  10012. {as Example
  10013.   ao := 1;
  10014.   au := -2;
  10015.   bo := 1.5;
  10016.   bu := -1.5;
  10017. }
  10018.   X := (ao - au) / dstDIB.FWidth;
  10019.   Y := (bo - bu) / dstDIB.FHeight;
  10020.   try
  10021.     c2 := bu;
  10022.     for i := 10 to X2 do
  10023.     begin
  10024.       c1 := au;
  10025.       for j := 0 to Y2 do
  10026.       begin
  10027.         z1 := 0;
  10028.         z2 := 0;
  10029.         Count := 0;
  10030.         {count is deep of iteration of the mandelbrot set
  10031.         if |z| >=2 then z is not a member of a mandelset}
  10032.         while (((z1 * z1 + z2 * z2 < 4) and (Count <= 90))) do
  10033.         begin
  10034.           tmp := z1;
  10035.           z1 := z1 * z1 - z2 * z2 + c1;
  10036.           z2 := 2 * tmp * z2 + c2;
  10037.           Inc(Count);
  10038.         end;
  10039.         //the color-palette depends on TColor(n*count mod t)
  10040.         dstDIB.Canvas.Pixels[j, i] := (16 * Count mod 255);
  10041.         c1 := c1 + X;
  10042.       end;
  10043.       c2 := c2 + Y;
  10044.     end;
  10045.   finally
  10046.     Self.Assign(dstDIB);
  10047.     dstDIB.Free;
  10048.   end;
  10049. end;
  10050.  
  10051. procedure TDIB.SephiaEffect(Depth: Integer{$IFDEF VER4UP} = 20{$ENDIF});
  10052. {Note: when depth parameter set to 0 will produce black and white picture only}
  10053. var
  10054.   color, color2: LongInt;
  10055.   r, g, b, rr, gg: byte;
  10056.   h, w: Integer;
  10057.   p0: PByteArray;
  10058.   x, y: Integer;
  10059. begin
  10060.   if Self.BitCount = 24 then
  10061.   begin
  10062.     Self.DoGrayScale;
  10063.     for y := 0 to Self.Height - 1 do
  10064.     begin
  10065.       p0 := Self.ScanLine[y];
  10066.       for x := 0 to Self.Width - 1 do
  10067.       begin
  10068.         r := p0[x * 3];
  10069.         g := p0[x * 3 + 1];
  10070.         b := p0[x * 3 + 2];
  10071.         rr := r + (depth * 2);
  10072.         gg := g + depth;
  10073.         if rr <= ((depth * 2) - 1) then
  10074.           rr := 255;
  10075.         if gg <= (depth - 1) then
  10076.           gg := 255;
  10077.         p0[x * 3] := rr;
  10078.         p0[x * 3 + 1] := gg;
  10079.         p0[x * 3 + 2] := b;
  10080.       end;
  10081.     end;
  10082.     Exit
  10083.   end;
  10084.   {this alogorithm is slower because does not use scanline property}
  10085.   for h := 0 to Self.Height-1 do
  10086.   begin
  10087.     for w := 0 to Self.Width-1 do
  10088.     begin
  10089.       //first convert the bitmap to greyscale
  10090.       color := ColorToRGB(Self.Canvas.Pixels[w, h]);
  10091.       r := GetRValue(color);
  10092.       g := GetGValue(color);
  10093.       b := GetBValue(color);
  10094.       color2 := (r + g + b) div 3;
  10095.       Self.Canvas.Pixels[w, h] := RGB(color2, color2, color2);
  10096.       //then convert it to sepia
  10097.       color := ColorToRGB(Self.Canvas.Pixels[w, h]);
  10098.       r := GetRValue(color);
  10099.       g := GetGValue(color);
  10100.       b := GetBValue(color);
  10101.       rr := r + (depth * 2);
  10102.       gg := g + depth;
  10103.       if rr <= ((depth * 2) - 1) then
  10104.         rr := 255;
  10105.       if gg <= (depth - 1) then
  10106.         gg := 255;
  10107.       Self.Canvas.Pixels[w, h] := RGB(rr, gg, b);
  10108.     end;
  10109.   end;
  10110.  
  10111. end;
  10112.  
  10113. procedure TDIB.EncryptDecrypt(const Key: Integer);
  10114. {for decript call it again}
  10115. var
  10116.   BytesPorScan: Integer;
  10117.   w, h: Integer;
  10118.   p: pByteArray;
  10119. begin
  10120.   try
  10121.     BytesPorScan := Abs(Integer(Self.ScanLine[1]) -
  10122.       Integer(Self.ScanLine[0]));
  10123.   except
  10124.     raise Exception.Create('Error ');
  10125.   end;
  10126.   RandSeed := Key;
  10127.   for h := 0 to Self.Height - 1 do
  10128.   begin
  10129.     P := Self.ScanLine[h];
  10130.     for w := 0 to BytesPorScan - 1 do
  10131.       P^[w] := P^[w] xor Random(256);
  10132.   end;
  10133. end;
  10134.  
  10135. procedure TDIB.LinePolar(x, y: Integer; AngleInDegree, Length: extended; Color: cardinal);
  10136. var
  10137.   xp, yp: Integer;
  10138. begin
  10139.   xp := Round(Sin(AngleInDegree * Pi / 180) * Length) + x;
  10140.   yp := Round(Cos(AngleInDegree * Pi / 180) * Length) + y;
  10141.   AntialiasedLine(x, y, xp, yp, Color);
  10142. end;
  10143.  
  10144. //y = 0.299*g + 0.587*b + 0.114*r;
  10145.  
  10146. procedure TDIB.BlendPixel(const X, Y: Integer; aColor: Cardinal; Alpha: byte);
  10147. var
  10148.   cR, cG, cB: byte;
  10149.   aR, aG, aB: byte;
  10150.   dColor: Cardinal;
  10151. begin
  10152.   aR := GetRValue(aColor);
  10153.   aG := GetGValue(aColor);
  10154.   aB := GetBValue(aColor);
  10155.   dColor := Self.Canvas.Pixels[x, y];
  10156.   cR := GetRValue(dColor);
  10157.   cG := GetGValue(dColor);
  10158.   cB := GetBValue(dColor);
  10159.   Canvas.Pixels[x, y] := RGB((Alpha * (aR - cR) shr 8) + cR, // R alpha
  10160.     (Alpha * (aG - cG) shr 8) + cG, // G alpha
  10161.     (Alpha * (aB - cB) shr 8) + cB); // B alpha
  10162. end;
  10163.  
  10164.  
  10165. procedure MakeDib(out DIB: TDIB; const iWidth, iHeight, iBitCount: Integer; iFillColor: TColor{$IFDEF VER4UP} = clBlack{$ENDIF}); {$IFDEF VER4UP} overload; {$ENDIF}
  10166. begin
  10167.   DIB := TDIB.Create;
  10168.   DIB.SetSize(iWidth, iHeight, iBitCount);
  10169.   DIB.Fill(iFillColor);
  10170. end;
  10171.  
  10172. procedure{$IFDEF VER4UP}MakeDib{$ELSE}MakeDib2{$ENDIF}(out DIB: TDIB; iBitmap: TBitmap); {$IFDEF VER4UP} overload; {$ENDIF}
  10173. begin
  10174.   DIB := TDIB.Create;
  10175.   if Assigned(iBitmap) then
  10176.     DIB.CreateDIBFromBitmap(iBitmap)
  10177.   else
  10178.     DIB.Fill(clBlack);
  10179. end;
  10180.  
  10181. initialization
  10182.   TPicture.RegisterClipBoardFormat(CF_DIB, TDIB);
  10183.   TPicture.RegisterFileFormat('dib', 'Device Independent Bitmap', TDIB);
  10184. finalization
  10185.   TPicture.UnRegisterGraphicClass(TDIB);
  10186.  
  10187.   FEmptyDIBImage.Free;
  10188.   FPaletteManager.Free;
  10189. end.