Subversion Repositories spacemission

{*******************************************************}

{                                                       }

{       DIB and PAINTBOX componets                      }

{                                                       }

{       Copyright (C) 1997-2000 Hiroyuki Hori           }

{         base components and effects                   }

{       Copyright (C) 2000 Keith Murray                 }

{         supernova effect                              }

{       Copyright (C) 2000 Michel Hibon                 }

{         new special effects added for DIB             }

{       Copyright (C) 2001 Joakim Back                  }

{         conFusion effects (as DxFusion)               }

{       Copyright (C) 2003 Babak Sateli                 }

{         24-bit DIB effect as supplement ones          }

{       Copyright (C) 2004-2012 Jaro Benes              }

{         32-bit DIB effect with alphachannel           }

{         direct works with texture buffer              }

{         modified and adapted all adopted functions    }

{                                                       }

{*******************************************************}

{$DEFINE USE_SCANLINE}

  {$IFDEF VER17UP} Types, UITypes,{$ENDIF}

  Math;

  TColorLineStyle = (csSolid, csGradient, csRainbow);

  TColorLinePixelGeometry = (pgPoint, pgCircular, pgRectangular);

  PRGBQuads = ^TRGBQuads;

  {   Added this type for New SPecial Effect   }

  TFilter = array[0..2, 0..2] of SmallInt;

  TLines = array[0..0] of TBGR;

  PLines = ^TLines;

  TBytes = array[0..0] of Byte;

  PBytes = ^TBytes;

  TPBytes = array[0..0] of PBytes;

  PPBytes = ^TPBytes;

  {   End of type's   }

  {  TDIBSharedImage  }

  {  TFilterTypeResample  }

  TFilterTypeResample = (ftrBox, ftrTriangle, ftrHermite, ftrBell, ftrBSpline,

    ftrLanczos3, ftrMitchell);

  TDistortType = (dtFast, dtSlow);

  {DXFusion effect type}

  TFilterMode = (fmNormal, fmMix50, fmMix25, fmMix75);

  {  TLightSource  }

  TLightSource = record

    X, Y: Integer;

    Size1, Size2: Integer;

    Color: TColor;

  end;

  {  TLightArray  }

  TLightArray = array{$IFNDEF VER4UP} [0..0]{$ENDIF} of TLightsource;

  {  TMatrixSetting  }

  TMatrixSetting = array[0..9] of Integer;

  {  TDIB  }

    FLUTDist: array[0..255, 0..255] of Integer;

    LG_COUNT: Integer;

    LG_DETAIL: Integer;

    FFreeList: TList;

    {   Added these 3 functions for New Specials Effects   }

    function Interval(iMin, iMax, iValue: Integer; iMark: Boolean): Integer; {$IFDEF VER9UP}inline;{$ENDIF}

    function IntToByte(i: Integer): Byte; {$IFDEF VER9UP}inline;{$ENDIF}

    function TrimInt(i, Min, Max: Integer): Integer; {$IFDEF VER9UP}inline;{$ENDIF}

    {   End of 3 functions for New Special Effect   }

    procedure Darkness(Amount: Integer);

    function GetAlphaChannel: TDIB;

    procedure SetAlphaChannel(const Value: TDIB);

    function GetClientRect: TRect;

    function GetRGBChannel: TDIB;

    procedure SetRGBChannel(const Value: TDIB);

    function HasAlphaChannel: Boolean;

    function AssignAlphaChannel(ALPHA: TDIB; ForceResize: Boolean{$IFDEF VER4UP} = False{$ENDIF}): Boolean;

    procedure RetAlphaChannel(out oDIB: TDIB);

    {   Added New Special Effect   }

    procedure Spray(Amount: Integer);

    procedure Emboss;

    procedure AddMonoNoise(Amount: Integer);

    procedure AddGradiantNoise(Amount: byte);

    function Twist(bmp: TDIB; Amount: byte): Boolean;

    function FishEye(bmp: TDIB): Boolean;

    function SmoothRotateWrap(Bmp: TDIB; cx, cy: Integer; Degree: Extended): Boolean;

    procedure Lightness(Amount: Integer);

    procedure Saturation(Amount: Integer);

    procedure Contrast(Amount: Integer);

    procedure AddRGB(aR, aG, aB: Byte);

    function Filter(Dest: TDIB; Filter: TFilter): Boolean;

    procedure Sharpen(Amount: Integer);

    function IntToColor(i: Integer): TBGR; {$IFDEF VER9UP}inline;{$ENDIF}

    function Rotate(Dst: TDIB; cx, cy: Integer; Angle: Double): Boolean;

    procedure SplitBlur(Amount: Integer);

    procedure GaussianBlur(Bmp: TDIB; Amount: Integer);

    {   End of New Special Effect   }

    {

    New effect for TDIB

    with Some Effects like AntiAlias, Contrast,

    Lightness, Saturation, GaussianBlur, Mosaic,

    Twist, Splitlight, Trace, Emboss, etc.

    Works with 24bit color DIBs.

    This component is based on TProEffectImage component version 1.0 by

    Written By Babak Sateli (babak_sateli@yahoo.com, http://raveland.netfirms.com)

    and modified by (c) 2004 Jaro Benes

    for DelphiX use.

    Demo was modified into DXForm with function like  original

    DISCLAIMER

    This component is provided AS-IS without any warranty of any kind, either express or

    implied. This component is freeware and can be used in any software product.

    }

    procedure DoInvert;

    procedure DoAddColorNoise(Amount: Integer);

    procedure DoAddMonoNoise(Amount: Integer);

    procedure DoAntiAlias;

    procedure DoContrast(Amount: Integer);

    procedure DoFishEye(Amount: Integer);

    procedure DoGrayScale;

    procedure DoLightness(Amount: Integer);

    procedure DoDarkness(Amount: Integer);

    procedure DoSaturation(Amount: Integer);

    procedure DoSplitBlur(Amount: Integer);

    procedure DoGaussianBlur(Amount: Integer);

    procedure DoMosaic(Size: Integer);

    procedure DoTwist(Amount: Integer);

    procedure DoSplitlight(Amount: Integer);

    procedure DoTile(Amount: Integer);

    procedure DoSpotLight(Amount: Integer; Spot: TRect);

    procedure DoTrace(Amount: Integer);

    procedure DoEmboss;

    procedure DoSolorize(Amount: Integer);

    procedure DoPosterize(Amount: Integer);

    procedure DoBrightness(Amount: Integer);

    procedure DoResample(AmountX, AmountY: Integer; TypeResample: TFilterTypeResample);

    {rotate}

    procedure DoSmoothRotate(Src: TDIB; cx, cy: Integer; Angle: Extended);

    procedure DoColorize(ForeColor, BackColor: TColor);

    {Simple explosion spoke effect}

    procedure DoNovaEffect(sr, sg, sb, cx, cy, radius,

      nspokes, randomhue, randomspok, randgauss: Integer; onProgress: TProgressEvent);

    {Simple Mandelbrot-set drawing}

    procedure DrawMandelbrot(ao, au: Integer; bo, bu: Double);

    {Sephia effect}

    procedure SephiaEffect(Depth: Integer{$IFDEF VER4UP} = 20{$ENDIF});

    {Simple blend pixel}

    procedure BlendPixel(const X, Y: Integer; aColor: Cardinal; Alpha: Byte); {$IFDEF VER9UP}inline;{$ENDIF}

    {Line in polar system}

    procedure LinePolar(x, y: Integer; AngleInDegree, Length: extended;

      Color: cardinal);

    {special version Dark/Light procedure in percent}

    procedure Darker(Percent: Integer);

    procedure Lighter(Percent: Integer);

    {Simple graphical crypt}

    procedure EncryptDecrypt(const Key: Integer);

    { Standalone DXFusion }

    {--- c o n F u s i o n ---}

    {By Joakim Back, www.back.mine.nu}

    {Huge thanks to Ilkka Tuomioja for helping out with the project.}

    {

    modified by (c) 2005 Jaro Benes for DelphiX use.

    }

    procedure CreateDIBFromBitmap(const Bitmap: TBitmap);

    {Drawing Methods.}

    procedure DrawOn(Dest: TRect; DestCanvas: TCanvas;

      Xsrc, Ysrc: Integer);

    procedure DrawTo(SrcDIB: TDIB; X, Y, Width, Height, SourceX,

      SourceY: Integer);

    procedure DrawTransparent(SrcDIB: TDIB; const X, Y, Width, Height,

      SourceX, SourceY: Integer; const Color: TColor); {$IFDEF VER5UP} reintroduce;{$ENDIF} //{$IFDEF VER9UP} overload;{$ENDIF}

    procedure DrawShadow(SrcDIB: TDIB; X, Y, Width, Height, Frame: Integer;

      FilterMode: TFilterMode);

    procedure DrawShadows(SrcDIB: TDIB; X, Y, Width, Height, Frame: Integer;

      Alpha: Byte);

    procedure DrawDarken(SrcDIB: TDIB; X, Y, Width, Height,

      Frame: Integer);

    procedure DrawAdditive(SrcDIB: TDIB; X, Y, Width, Height: Integer; Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF};

      Frame: Integer{$IFDEF VER4UP} = 0{$ENDIF});

    procedure DrawQuickAlpha(SrcDIB: TDIB; const X, Y, Width, Height,

      SourceX, SourceY: Integer; const Color: TColor;

      FilterMode: TFilterMode);

    procedure DrawTranslucent(SrcDIB: TDIB; const X, Y, Width, Height,

      SourceX, SourceY: Integer; const Color: TColor);

    procedure DrawMorphed(SrcDIB: TDIB; const X, Y, Width, Height, SourceX,

      SourceY: Integer; const Color: TColor);

    procedure DrawAlpha(SrcDIB: TDIB; const X, Y, Width, Height, SourceX,

      SourceY, Alpha: Integer; const Color: TColor);

    procedure DrawAlphaMask(SrcDIB, MaskDIB: TDIB; const X, Y, Width,

      Height, SourceX, SourceY: Integer);

    procedure DrawAntialias(SrcDIB: TDIB);

    procedure Draw3x3Matrix(SrcDIB: TDIB; Setting: TMatrixSetting);

    procedure DrawMono(SrcDIB: TDIB; const X, Y, Width, Height, SourceX,

      SourceY: Integer; const TransColor, ForeColor, BackColor: TColor);

    {One-color Filters.}

    procedure FilterLine(X1, Y1, X2, Y2: Integer; Color: TColor;

      FilterMode: TFilterMode); {$IFDEF VER9UP}inline;{$ENDIF}

    procedure FilterRect(X, Y, Width, Height: Integer; Color: TColor;

      FilterMode: TFilterMode); {$IFDEF VER9UP}inline;{$ENDIF}

    { Lightsource. }

    procedure InitLight(Count, Detail: Integer);

    procedure DrawLights(FLight: TLightArray; AmbientLight: TColor);

    //

    // effect for special purpose

    //

    procedure FadeOut(DIB2: TDIB; Step: Byte);

    procedure DoZoom(DIB2: TDIB; ZoomRatio: Real);

    procedure DoBlur(DIB2: TDIB);

    procedure FadeIn(DIB2: TDIB; Step: Byte);

    procedure FillDIB8(Color: Byte);

    procedure DoRotate(DIB1: TDIB; cX, cY, Angle: Integer);

    procedure Distort(DIB1: TDIB; dt: TDistortType; cX, cY, Angle: Integer; Factor: Real);

    function Ink(DIB: TDIB; const SprayInit: Boolean; const AmountSpray: Integer): Boolean;

    // lines

    procedure AntialiasedLine(x1, y1, x2, y2: Integer; color: TColor); {$IFDEF VER9UP} inline; {$ENDIF}

    function GetColorBetween(StartColor, EndColor: TColor; Pointvalue,

      FromPoint, ToPoint: Extended): TColor;

    procedure ColoredLine(const iStart, iEnd: TPoint; iColorStyle: TColorLineStyle;

      iGradientFrom, iGradientTo: TColor; iPixelGeometry: TColorLinePixelGeometry;

      iRadius: WORD);

    // standard property

    property AlphaChannel: TDIB read GetAlphaChannel write SetAlphaChannel;

    property RGBChannel: TDIB read GetRGBChannel write SetRGBChannel;

    function CreateBitmapFromDIB: TBitmap;

    procedure Fill(aColor: TColor);

    property ClientRect: TRect read GetClientRect;

  {  TDIBitmap  }

{$IFDEF VER9UP}property OnMouseWheel; {$ENDIF}

{$IFDEF VER9UP}property OnResize; {$ENDIF}

{$IFDEF VER9UP}property OnCanResize; {$ENDIF}

{$IFDEF VER9UP}property OnContextPopup; {$ENDIF}

const

  DefaultFilterRadius: array[TFilterTypeResample] of Single = (0.5, 1, 1, 1.5, 2, 3, 2);

function PosValue(Value: Integer): Integer;

type

  TOC = 0..511;

function DSin(const C: TOC): Single; {$IFDEF VER9UP}inline; {$ENDIF}

function DCos(const C: TOC): Single; {$IFDEF VER9UP}inline; {$ENDIF}

{   Added Constants for TFilter Type   }

const

  EdgeFilter: TFilter = ((-1, -1, -1), (-1, 8, -1), (-1, -1, -1));

  StrongOutlineFilter: TFilter = ((-100, 0, 0), (0, 0, 0), (0, 0, 100));

  Enhance3DFilter: TFilter = ((-100, 5, 5), (5, 5, 5), (5, 5, 100));

  LinearFilter: TFilter = ((-40, -40, -40), (-40, 255, -40), (-40, -40, -40));

  GranularFilter: TFilter = ((-20, 5, 20), (5, -10, 5), (100, 5, -100));

  SharpFilter: TFilter = ((-2, -2, -2), (-2, 20, -2), (-2, -2, -2));

{   End of constants   }

{   Added Constants for DXFusion Type   }

const

  { 3x3 Matrix Presets. }

  msEmboss: TMatrixSetting = (-1, -1, 0, -1, 6, 1, 0, 1, 1, 6);

  msHardEmboss: TMatrixSetting = (-4, -2, -1, -2, 10, 2, -1, 2, 4, 8);

  msBlur: TMatrixSetting = (1, 2, 1, 2, 4, 2, 1, 2, 1, 16);

  msSharpen: TMatrixSetting = (-1, -1, -1, -1, 15, -1, -1, -1, -1, 7);

  msEdgeDetect: TMatrixSetting = (-1, -1, -1, -1, 8, -1, -1, -1, -1, 1);

{Proportionaly scale of size, for recountin image sizes}

function GetScale(SourceWidth, SourceHeight, TargetWidth, TargetHeight: Integer): Single; {$IFDEF VER9UP}inline;{$ENDIF}

procedure MakeDib(out DIB: TDIB; const iWidth, iHeight, iBitCount: Integer; iFillColor: TColor{$IFDEF VER4UP} = clBlack{$ENDIF}); {$IFDEF VER4UP}overload; {$ENDIF}

procedure{$IFDEF VER4UP}MakeDib{$ELSE}MakeDIB2{$ENDIF}(out DIB: TDIB; iBitmap: TBitmap); {$IFDEF VER4UP}overload; {$ENDIF}

uses DXConsts, {$IFDEF PNG_GRAPHICS}pngimage,{$ENDIF} jpeg;

function GetScale(SourceWidth, SourceHeight, TargetWidth, TargetHeight: Integer): Single;

var

  XScale, YScale: Single;

begin

  XScale := 1;

  YScale := 1;

  if TargetWidth < SourceWidth then

    XScale := TargetWidth / SourceWidth;

  if TargetHeight < SourceHeight then

    YScale := TargetHeight / SourceHeight;

  if YScale < Result then

    Result := YScale;

end;

{$IFNDEF VER4UP}

function Min(B1, B2: Integer): Integer;

begin

  if B1 <= B2 then Result := B1 else Result := B2;

end;

{$ENDIF}

function DSin(const C: TOC): Single; {$IFDEF VER9UP}inline; {$ENDIF}

begin

  Result := sin(((c * 360) / 511) * Pi / 180);

end;

function DCos(const C: TOC): Single; {$IFDEF VER9UP}inline; {$ENDIF}

begin

  Result := cos(((c * 360) / 511) * Pi / 180);

end;

function MakeDIBPixelFormatMask(RBitMask, GBitMask, BBitMask: Integer): TDIBPixelFormat;

  {  TPaletteItem  }

  {  TPaletteManager  }

{  TPaletteItem  }