{ +-------------------------------------------------------------+ }
{ |                                                             | }
{ |   GM-Software                                               | }
{ |   ===========                                               | }
{ |                                                             | }
{ |   Project: All PRojects                                     | }
{ |                                                             | }
{ |   Description: Fast bitmap processing.                      | }
{ |                                                             | }
{ |                                                             | }
{ |   Copyright (C) - 2005 - Gerrit Moeller.                    | }
{ |                                                             | }
{ |   Source code distributed under MIT license.                | }
{ |                                                             | }
{ |   Web: https://www.gm-software.de                           | }
{ |                                                             | }
{ +-------------------------------------------------------------+ }

{$INCLUDE GMCompilerSettings.inc}

unit GMFastBMP;

interface

uses {$IFNDEF JEDIAPI}Windows{$ELSE}{$ENDIF}, GMActiveX, GMIntf;

type

  TRGBColor = packed record b,g,r: Byte end;
  PRGBColor =^TRGBColor;


const

  cRGBsz = SizeOf(TRGBColor);
  cMaxRGBLines = High(LongInt) div SizeOf(Pointer);
  cMaxRGBQuad = High(LongInt) div SizeOf(TRGBQuad);

  cDfltTopDown = False;
  cDfltFillWhite = False;


type

  PRGBMaxQuadArray = ^TRGBMaxQuadArray;
  TRGBMaxQuadArray = array [0..cMaxRGBQuad-11] of TRGBQuad;

  PBitmapHeaderMax = ^TBitmapHeaderMax;
  TBitmapHeaderMax = packed record
    bmiHeader: TBitmapInfoHeader;
    bmiColors: TRGBMaxQuadArray;
  end;


  TBmpLines = array [0..cMaxRGBLines-1] of Pointer;
  PBmpLines = ^TBmpLines;

  TGMFastBMPBase = class(TGMRefCountedObj, IGMGetHandle)
   protected
    FHandle: LongWord;
    FDC: LongWord;
    FBmpSize: TPoint;
    FBits: Pointer;
    FBitsMemSize: LongInt;
    FTopDown: Boolean;
    FRowSize: LongInt;
    FRowGap: LongInt;
    FLines: PBmpLines;
    FBmpInfo: PBitmapInfoHeader;

    procedure SetupPixelsMember(const PixelsPtr: Pointer); virtual; abstract;
    function BmpInfoHdrSize: LongInt; virtual;

   public // Interfaces
    function GetHandle: THandle; stdcall;

   public
    constructor Create(const ARefLifeTime: Boolean = True); overload; override;

    constructor Create(const AWidth: LongInt = 0;
                       const AHeight: LongInt = 0;
                       const AFillWhite: Boolean = cDfltFillWhite;
                       const ATopDown: Boolean = cDfltTopDown;
                       const ARefLifeTime: Boolean = True); reintroduce; overload;

    constructor Create(const ASize: TPoint;
                       const AFillWhite: Boolean = cDfltFillWhite;
                       const ATopDown: Boolean = cDfltTopDown;
                       const ARefLifeTime: Boolean = True); reintroduce; overload;

    destructor Destroy; override;

    procedure FillWhite;
    procedure SetBmpInfoHdrColors(const ColorCount: LongWord; const PColors: PRGBMaxQuadArray);

    procedure SetSize(const AWidth, AHeight: LongInt; const AFillWhite: Boolean = cDfltFillWhite; const ATopDown: Boolean = cDfltTopDown); virtual;
    function BitsPerPixel: LongInt; virtual; abstract;

    procedure Draw(const DestDC: HDC; const DstOrgn: TPoint; const ROP: DWORD = SRCCOPY);

    procedure StretchDraw(const DestDC: HDC; const DstOrgn, DestSz: TPoint; const ROP: DWORD = SRCCOPY); overload;
    procedure StretchDraw(const DestDC: HDC; const DstRect: TRect; const ROP: DWORD = SRCCOPY); overload;

    procedure StretchRect(const DestDC: HDC; const DstOrgn, DestSz, SrcOrgn, SrcSz: TPoint; const ROP: DWORD = SRCCOPY); overload;
    procedure StretchRect(const DestDC: HDC; const DstRect, SrcRect: TRect; const ROP: DWORD = SRCCOPY); overload;
    //procedure   TileDraw(fdc,x,y,w,h:LongInt); virtual; abstract;
    //procedure   Resize(Dst:TGMFastBMPBase); virtual; abstract;
    //procedure   SmoothResize(Dst:TGMFastBMPBase); virtual; abstract;
    //procedure   CopyRect(Dst:TGMFastBMPBase;x,y,w,h,sx,sy:LongInt); virtual; abstract;
    //procedure   Tile(Dst:TGMFastBMPBase); virtual; abstract;

    //function Size: TPoint;
    function Bounds: TRect;
    function DC: HDC;
    procedure DestroyDC;

    property Size: TPoint read FBmpSize;
    //property DC: LongWord read FDC;
    property Handle: LongWord read FHandle;
    property Width: LongInt read FBmpSize.x;
    property Height: LongInt read FBmpSize.y;
    property TopDown: Boolean read FTopDown;
    property Bits: Pointer read FBits;
    property BitsMemSize: LongInt read FBitsMemSize;
    property RowSize: LongInt read FRowSize;
    property RowGap: LongInt read FRowGap;
    property Lines: PBmpLines read FLines;
  end;


  TGMFastMonoBmp = class;

  IGMFastMonoBmp = interface(IUnknown)
    ['{67DDD64D-6B3D-473b-85A4-E3646ED51B07}']
    function Obj: TGMFastMonoBmp;
  end;

  TMonoLine = array [0..High(LongInt)-1] of Byte;
  PMonoLine = ^TMonoLine;
  TMonoLines = array [0..cMaxRGBLines-1] of PMonoLine;
  PMonoLines = ^TMonoLines;

  TGMFastMonoBmp = class(TGMFastBMPBase, IGMFastMonoBmp)
   protected
    FPixels: PMonoLines;

    procedure SetupPixelsMember(const PixelsPtr: Pointer); override;
    function BmpInfoHdrSize: LongInt; override;

   public
    constructor Create(const AWidth: LongInt = 0;
                       const AHeight: LongInt = 0;
                       const AFillWhite: Boolean = cDfltFillWhite;
                       const ATopDown: Boolean = cDfltTopDown;
                       const ARefLifeTime: Boolean = True);

    //destructor Destroy; override;
    function Obj: TGMFastMonoBmp;
    function BitsPerPixel: LongInt; override;
    procedure SetInvertedPixel(const x, y: LongInt; const r, g, b: Word);
    procedure SetPixel(const x, y: LongInt; const r, g, b: Word);

    property Pixels: PMonoLines read FPixels; // <- just a typecast to inherited FLines member!
  end;


  T256Line = array [0..High(LongInt)-1] of Byte;
  P256Line = ^T256Line;
  T256Lines = array [0..cMaxRGBLines-1] of P256Line;
  P256Lines = ^T256Lines;

  TGMFast256Bmp = class;

  IGMFast256Bmp = interface(IUnknown)
    ['{67DDD64D-6B3D-473b-85A4-E3646ED51B07}']
    function Obj: TGMFast256Bmp;
  end;

  TGMFast256Bmp = class(TGMFastBMPBase, IGMFast256Bmp)
   protected
    FPixels: P256Lines;

    procedure SetupPixelsMember(const PixelsPtr: Pointer); override;

   public
    function Obj: TGMFast256Bmp;
    function BitsPerPixel: LongInt; override;

    property Pixels: P256Lines read FPixels; // <- just a typecast to inherited FLines member!
  end;


  TRGBLine = array [0..High(LongInt) div SizeOf(TRGBColor)-1] of TRGBColor;
  PRGBLine = ^TRGBLine;
  TRGBLines = array [0..cMaxRGBLines-1] of PRGBLine;
  PRGBLines = ^TRGBLines;

  TGMFastRGBBmp = class;

  IGMFastRGBBmp = interface(IUnknown)
    ['{D2AFE8F2-FEFC-4652-B5D0-9D239950DFA8}']
    function Obj: TGMFastRGBBmp;
  end;

  TGMFastRGBBmp = class(TGMFastBMPBase, IGMFastRGBBmp)
   protected
    FPixels: PRGBLines;

    procedure SetupPixelsMember(const PixelsPtr: Pointer); override;

   public
    constructor Create(const ASource: IGMFastRGBBmp; const ARect: PRect = nil; const ARefLifeTime: Boolean = True); reintroduce; overload;
    //destructor Destroy; override;

    function Obj: TGMFastRGBBmp;
    function BitsPerPixel: LongInt; override;
    procedure CopyContents(const ASource: TGMFastRGBBmp; const ARect: PRect = nil);
    procedure CopyRect(const ASource: TGMFastRGBBmp; const ARect: TRect);
    //procedure SetSize(const AWidth, AHeight: LongInt; const AFillWhite: Boolean = cDfltFillWhite); override;
    procedure LoadFromStream(const AStream: IStream; const AOnProgress: IUnknown = nil);
    procedure LoadFromFile(const AFileName: TGMString; const AOnProgress: IUnknown = nil);
    procedure SaveToFile(const AFileName: TGMString);
    //procedure SaveToFile(const AFileName: TGMString);
    //procedure LoadFromhBmp(hBmp:LongInt);
    //procedure LoadFromRes(hInst:LongInt;sName:TGMString);

    property Pixels: PRGBLines read FPixels; // <- just a typecast to inherited FLines member!
    
    //procedure SetInterface(fWidth,fHeight:LongInt;pBits:Pointer);
    //procedure Copy(FB:TGMFastRGBBmp);
    // GDI drawing methods
    //procedure Draw(fdc: LongWord; x,y:LongInt); override;
    //procedure Stretch(fdc,x,y,w,h:LongInt); override;
    //procedure DrawRect(fdc,x,y,w,h,sx,sy:LongInt); override;
    //procedure StretchRect(fdc,x,y,w,h,sx,sy,sw,sh:LongInt); override;
    //procedure   TileDraw(fdc,x,y,w,h:LongInt); override;
    // native conversions
    //procedure   Resize(Dst:TGMFastBMPBase); override;
    //procedure   SmoothResize(Dst:TGMFastBMPBase); override;
    //procedure   CopyRect(Dst:TGMFastBMPBase;x,y,w,h,sx,sy:LongInt); override;
    //procedure   Tile(Dst:TGMFastBMPBase); override;
    //function CountColors:LongInt;
  end;

  

{const //colors dur

  tfBlack   : TRGBColor=(b:0;g:0;r:0);
  tfMaroon  : TRGBColor=(b:0;g:0;r:128);
  tfGreen   : TRGBColor=(b:0;g:128;r:0);
  tfOlive   : TRGBColor=(b:0;g:128;r:128);
  tfNavy    : TRGBColor=(b:128;g:0;r:0);
  tfPurple  : TRGBColor=(b:128;g:0;r:128);
  tfTeal    : TRGBColor=(b:128;g:128;r:0);
  tfGray    : TRGBColor=(b:128;g:128;r:128);
  tfSilver  : TRGBColor=(b:192;g:192;r:192);
  tfRed     : TRGBColor=(b:0;g:0;r:255);
  tfLime    : TRGBColor=(b:0;g:255;r:0);
  tfYellow  : TRGBColor=(b:0;g:255;r:255);
  tfBlue    : TRGBColor=(b:255;g:0;r:0);
  tfFuchsia : TRGBColor=(b:255;g:0;r:255);
  tfAqua    : TRGBColor=(b:255;g:255;r:0);
  tfLtGray  : TRGBColor=(b:192;g:192;r:192);
  tfDkGray  : TRGBColor=(b:128;g:128;r:128);
  tfWhite   : TRGBColor=(b:255;g:255;r:255);  }


procedure FxRGB(const Bmp: TGMFastRGBBmp; const ra, ga, ba: LongInt; const Bounds: TRect);
procedure FxLightness(const Bmp: TGMFastRGBBmp; Amount: LongInt; const Bounds: TRect);
procedure FxContrast(const Bmp: TGMFastRGBBmp; const Amount: LongInt; const Bounds: TRect);
procedure FxSaturation(const Bmp: TGMFastRGBBmp; const Amount: LongInt; const Bounds: TRect);
procedure FxHFlip(const Bmp: TGMFastRGBBmp; const Bounds: TRect);
procedure FxVFlip(const Bmp: TGMFastRGBBmp; const Bounds: TRect);
procedure FxEmboss(const Bmp: TGMFastRGBBmp; const Bounds: TRect);
procedure FxSpray(const Bmp, Dst: TGMFastRGBBmp; const Amount: LongInt; const Bounds: TRect);
procedure FxInvert(const Bmp: TGMFastRGBBmp; const Bounds: TRect);
procedure FxGrayscale(const Bmp: TGMFastRGBBmp; const Bounds: TRect);
procedure FxRedEyeFilter(const Bmp: TGMFastRGBBmp; const ThresHold: LongInt; const Bounds: TRect);
procedure FxSharpen(const Bmp: TGMFastRGBBmp; const Amount: LongInt; const Bounds: TRect);
procedure FxGaussianSharpen(const Bmp: TGMFastRGBBmp; const Amount: LongInt; const Bounds: TRect);
procedure FxSplitBlur(const Bmp: TGMFastRGBBmp; const Amount: LongInt; const Bounds: TRect);
procedure FxGaussianBlur(const Bmp: TGMFastRGBBmp; const Distance: LongInt; const Bounds: TRect);
procedure FxSoftenEdges(const Bmp: TGMFastRGBBmp; const Bounds: TRect);
procedure FxMosaic(const Bmp: TGMFastRGBBmp; const xAmount, yAmount: LongInt; const Bounds: TRect);
procedure FxFishEye(const Bmp, Dst: TGMFastRGBBmp; const Amount: Extended; const Bounds: TRect);
procedure FxTwist(const Bmp, Dst: TGMFastRGBBmp; const Amount: LongInt; const Bounds: TRect);
procedure FxAlphaBlend(const Dst, Src1, Src2: TGMFastRGBBmp; const Alpha: LongInt; const Bounds: TRect); // 0..255

{function FRGB(r,g,b:Byte): TRGBColor;
function IntToColor(i:LongInt): TRGBColor;
function TrimInt(i,Min,Max:LongInt): LongInt;}


implementation

uses GMCommon;

resourcestring

  RStrNoBmpStream = 'Stream does not contain a Bitmap';

  
{ ------------------------- }
{ ---- Global Routines ---- }
{ ------------------------- }                                     

{function FRGB(r,g,b:Byte):TRGBColor;
begin
  Result.b:=b;
  Result.g:=g;
  Result.r:=r;
end;

function IntToColor(i:LongInt):TRGBColor;
begin
  Result.b:=i shr 16;
  Result.g:=i shr 8;
  Result.r:=i;
end;}

function TrimInt(const Value, Min, Max: LongInt): LongInt;
begin
  if      Value > Max then Result := Max
  else if Value < Min then Result := Min
  else Result := Value;
end;

function IntToByte(const Value: LongInt): Byte;
begin
  if      Value > 255 then Result := 255
  else if Value < 0   then Result := 0
  else Result := Value;
end;

procedure LimitBounds(const Bmp: TGMFastRGBBmp; PBounds: PRect);
begin
  if (Bmp = nil) or (PBounds = nil) then Exit;
  if PBounds.Left > PBounds.Right then GMExchangeLongInt(PBounds.Left, PBounds.Right);
  if PBounds.Top > PBounds.Bottom then GMExchangeLongInt(PBounds.Top, PBounds.Bottom);
  IntersectRect(PBounds^, PBounds^, Bmp.Bounds);

  {PBounds.Left := Max(0, PBounds.Left);
  PBounds.Top := Max(0, PBounds.Top);
  PBounds.Right := Min(Bmp.Width, PBounds.Right);
  PBounds.Bottom := Min(0, PBounds.Bottom);}
end;

{procedure DecodeRLE4(Bmp:TFastDIB;Data:Pointer);
  procedure OddMove(Src,Dst:PByte;Size:Integer);
  begin
    if Size=0 then Exit;
    repeat
      Dst^:=(Dst^ and $F0)or(Src^ shr 4);
      Inc(Dst);
      Dst^:=(Dst^ and $0F)or(Src^ shl 4);
      Inc(Src);
      Dec(Size);
    until Size=0;
  end;
  procedure OddFill(Mem:PByte;Size,Value:Integer);
  begin
    Value:=(Value shr 4)or(Value shl 4);
    Mem^:=(Mem^ and $F0)or(Value and $0F);
    Inc(Mem);
    if Size>1 then FillByte(Mem^,Size,Value);
    Mem^:=(Mem^ and $0F)or(Value and $F0);
  end;
var
  pb: PByte;
  x,y,z,i: Integer;
begin
  pb:=Data; x:=0; y:=0;
  while y<Bmp.AbsHeight do
  begin
    if pb^=0 then
    begin
      Inc(pb);
      z:=pb^;
      case pb^ of
        0: begin
             Inc(y);
             x:=0;
           end;
        1: Break;
        2: begin
             Inc(pb); Inc(x,pb^);
             Inc(pb); Inc(y,pb^);
           end;
        else
        begin
          Inc(pb);
          i:=(z+1)shr 1;
          if(z and 2)=2 then Inc(i);
          if((x and 1)=1)and(x+i<Bmp.Width)then
            OddMove(pb,@Bmp.Pixels8[y,x shr 1],i)
          else
            Move(pb^,Bmp.Pixels8[y,x shr 1],i);
          Inc(pb,i-1);
          Inc(x,z);
        end;
      end;
    end else
    begin
      z:=pb^;
      Inc(pb);
      if((x and 1)=1)and(x+z<Bmp.Width)then
        OddFill(@Bmp.Pixels8[y,x shr 1],z shr 1,pb^)
      else
        FillByte(Bmp.Pixels8[y,x shr 1],z shr 1,pb^);
      Inc(x,z);
    end;
    Inc(pb);
  end;
end;}

function CompareRGBColors(const Color1, Color2: TRGBColor; const Delta: Byte = 0): Boolean;
begin
  Result := (Abs(Color1.r - Color2.r) <= Delta) and (Abs(Color1.g - Color2.g) <= Delta) and (Abs(Color1.b - Color2.b) <= Delta);
end;

procedure DecodeRLE8(const Width, Height: LongInt; const RLEBits, RGBBits: Pointer);
var pb: PByte; x, y, z, i, s, RowSize: LongInt;
begin
  RowSize := GMAlignedValue(Width, 4);
  pb := RLEBits; y:=0; x:=0;
  while y < Height do
   begin
    if pb^ = 0 then
     begin
      Inc(pb);
      case pb^ of
        0: begin Inc(y); x:=0; end;
        1: Break;
        2: begin Inc(pb); Inc(x,pb^); Inc(pb); Inc(y,pb^); end;
        else
         begin
          i := pb^;
          s := (i + 1) and (not 1);
          z := s - 1;
          Inc(pb);
          if x + s > Width then s := Width - x;
          Move(pb^, GMAddPtr(RGBBits, (y * RowSize) + x)^, s);
          Inc(pb, z);
          Inc(x, i);
         end;
       end;
     end else
     begin
      i:=pb^; Inc(pb);
      if i+x > Width then i := Width-x;
      FillByte(GMAddPtr(RGBBits, (y*RowSize) + x)^, i, pb^);
      Inc(x,i);
     end;
    Inc(pb);
   end;
end;


{ ------------------------ }
{ ---- TGMFastBMPBase ---- }
{ ------------------------ }

constructor TGMFastBMPBase.Create(const ARefLifeTime: Boolean);
begin
  inherited Create(ARefLifeTime);
  //FDC := CreateCompatibleDC(0);
  //GMApiCheckObj(DC <> 0, Self, 'CreateCompatibleDC');
  FTopDown := cDfltTopDown;
  GetMem(FBmpInfo, BmpInfoHdrSize);
  FillByte(FBmpInfo^, BmpInfoHdrSize, 0);
  FBmpInfo.biSize := SizeOf(TBitmapInfoHeader); // <- always use SizeOf(TBitmapInfoHeader) here!
  FBmpInfo.biPlanes := 1;
  FBmpInfo.biBitCount := BitsPerPixel;
  FBmpInfo.biCompression := BI_RGB;
end;

constructor TGMFastBMPBase.Create(const AWidth: LongInt; const AHeight: LongInt;
                                  const AFillWhite: Boolean; const ATopDown: Boolean; const ARefLifeTime: Boolean);
begin
  Create(ARefLifeTime);
  FTopDown := ATopDown;
  if (AWidth > 0) and (AHeight > 0) then SetSize(AWidth, AHeight, AFillWhite, ATopDown);
end;

constructor TGMFastBMPBase.Create(const ASize: TPoint; const AFillWhite, ATopDown, ARefLifeTime: Boolean);
begin
  Create(Asize.x, Asize.y, AFillWhite, ATopDown, ARefLifeTime);
end;

destructor TGMFastBMPBase.Destroy;
begin
  //if FDC <> 0 then begin DeleteDC(FDC); FDC := 0; end;
  DestroyDC;
  if FHandle <> 0 then begin DeleteObject(FHandle); FHandle := 0; end;
  FreeMem(FBmpInfo);
  FreeMem(FLines);
  inherited Destroy;
end;

function TGMFastBMPBase.BmpInfoHdrSize: LongInt;
begin
  Result := SizeOf(TBitmapInfoHeader);
end;

function TGMFastBMPBase.DC: HDC;
begin
  if FDC = 0 then
   begin
    FDC := CreateCompatibleDC(0);
    GMApiCheckObj(FDC <> 0, Self, 'CreateCompatibleDC');
    if FHandle <> 0 then DeleteObject(SelectObject(FDC, FHandle));
   end;
  Result := FDC;
end;

procedure TGMFastBMPBase.DestroyDC;
begin
  if FDC <> 0 then begin DeleteDC(FDC); FDC := 0; end;
end;

procedure TGMFastBMPBase.SetBmpInfoHdrColors(const ColorCount: LongWord; const PColors: PRGBMaxQuadArray);
begin
  ReallocMem(FBmpInfo, SizeOf(TBitmapInfoHeader) + ColorCount * SizeOf(TRGBQuad));
  Move(PColors^, PBitmapHeaderMax(FBmpInfo).bmiColors[0], ColorCount * SizeOf(TRGBQuad));
  FBmpInfo.biClrUsed := ColorCount;
  FBmpInfo.biClrImportant := ColorCount;
end;

function TGMFastBMPBase.GetHandle: Longword;
begin
  Result := FHandle;
end;

procedure TGMFastBMPBase.SetSize(const AWidth, AHeight: LongInt; const AFillWhite, ATopDown: Boolean);
var x, i: LongInt;
begin
  if (Width = AWidth) and (Height = AHeight) then Exit;
  if FHandle <> 0 then DeleteObject(FHandle);
  FTopDown := ATopDown;
  FBmpSize.x := AWidth;
  FBmpSize.y := AHeight;
  FBmpInfo.biWidth := Width;
  if TopDown then FBmpInfo.biHeight := -Height else FBmpInfo.biHeight := Height;
  FHandle := CreateDIBSection(0, PBitmapInfo(FBmpInfo)^, DIB_RGB_COLORS, FBits, 0, 0);
  GMApiCheckObj(FHandle <> 0, Self, 'CreateDIBSection');
  if FDC <> 0 then DeleteObject(SelectObject(FDC, FHandle));
  FRowSize := ((Width * BitsPerPixel + 31) shr 5) shl 2;
  FRowGap := Width mod 4;
  FBitsMemSize := RowSize * Height;

  FreeMem(FLines);
  GetMem(FLines, Height * SizeOf(Pointer));
  x := LongInt(Bits);
  for i:=0 to Height-1 do
   begin
    FLines[i] := Pointer(x);
    Inc(x, RowSize);
   end;

  SetupPixelsMember(FLines);
  if AFillWhite then FillWhite;
end;

procedure TGMFastBMPBase.FillWhite;
begin
  if (Bits <> nil) and (BitsMemSize > 0) then FillByte(Bits^, BitsMemSize, $FF);
end;

procedure TGMFastBMPBase.StretchDraw(const DestDC: HDC; const DstOrgn, DestSz: TPoint; const ROP: DWORD);
var ScanLines: LongInt;
begin
  ScanLines := StretchDIBits(DestDC, DstOrgn.x, DstOrgn.y, DestSz.x, DestSz.y, 0, 0, Width, Height, Bits, PBitmapInfo(FBmpInfo)^, DIB_RGB_COLORS, ROP);
  GMAPICheckObj(LongWord(ScanLines) <> GDI_ERROR, Self, 'StretchDraw: StretchDIBits');
end;

procedure TGMFastBMPBase.StretchDraw(const DestDC: HDC; const DstRect: TRect; const ROP: DWORD);
begin
  StretchDraw(DestDC, DstRect.TopLeft, GMRectSize(DstRect), ROP);
end;

procedure TGMFastBMPBase.Draw(const DestDC: HDC; const DstOrgn: TPoint; const ROP: DWORD);
begin
  StretchDraw(DestDC, DstOrgn, Size, ROP);
  //StretchDIBits(DestDC, DstOrgn.x, DstOrgn.y, Width, Height, 0, 0, Width, Height, Bits, PBitmapInfo(FBmpInfo)^, DIB_RGB_COLORS, ROP);
end;

procedure TGMFastBMPBase.StretchRect(const DestDC: HDC; const DstOrgn, DestSz, SrcOrgn, SrcSz: TPoint; const ROP: DWORD);
var ScanLines: LongInt;
begin
  ScanLines := StretchDIBits(DestDC, DstOrgn.x, DstOrgn.y, DestSz.x, DestSz.y, SrcOrgn.x, SrcOrgn.y, SrcSz.x, SrcSz.y, Bits, PBitmapInfo(FBmpInfo)^, DIB_RGB_COLORS, ROP);
  GMAPICheckObj(LongWord(ScanLines) <> GDI_ERROR, Self, 'StretchRect: StretchDIBits');
end;

procedure TGMFastBMPBase.StretchRect(const DestDC: HDC; const DstRect, SrcRect: TRect; const ROP: DWORD);
begin
  StretchRect(DestDC, DstRect.TopLeft, GMRectSize(DstRect), SrcRect.TopLeft, GMRectSize(SrcRect), ROP);
end;

function TGMFastBMPBase.Bounds: TRect;
begin
  Result := GMRect(0, 0, Width, Height);
end;


{ ------------------------ }
{ ---- TGMFastMonoBmp ---- }
{ ------------------------ }

constructor TGMFastMonoBmp.Create(const AWidth: LongInt; const AHeight: LongInt;
                                  const AFillWhite: Boolean; const ATopDown: Boolean; const ARefLifeTime: Boolean);
begin
  inherited Create(AWidth, AHeight, AFillWhite, ATopDown, ARefLifeTime);

  {if Inverted then
   begin
    FBmpInfo.bmiColors[0].rgbBlue := $FF;
    FBmpInfo.bmiColors[0].rgbGreen := $FF;
    FBmpInfo.bmiColors[0].rgbRed := $FF;
   end
  else
   begin}
  with PBitmapHeaderMax(FBmpInfo).bmiColors[1] do begin rgbBlue := $FF; rgbGreen := $FF; rgbRed := $FF; end;
   //end;
end;

{destructor TGMFastMonoBmp.Destroy;
begin
  FreeMem(FPixels);
  inherited Destroy;
end;}

function TGMFastMonoBmp.BmpInfoHdrSize: LongInt;
begin
  Result := inherited BmpInfoHdrSize + 2 * SizeOf(TRGBQuad);
end;

function TGMFastMonoBmp.Obj: TGMFastMonoBmp;
begin
  Result := Self;
end;

function TGMFastMonoBmp.BitsPerPixel: LongInt;
begin
  Result := 1;
end;

procedure TGMFastMonoBmp.SetupPixelsMember(const PixelsPtr: Pointer);
begin
  FPixels := PixelsPtr;
end;

{procedure TGMFastMonoBmp.SetSize(const AWidth, AHeight: LongInt; const AFillWhite: Boolean);
var x: LongInt; i: LongInt;
begin
  if (AWidth = Width) and (AHeight = Height) then Exit;
  inherited SetSize(AWidth, AHeight, AFillWhite);
  GetMem(FPixels, Height * SizeOf(Pointer));
  x := LongInt(Bits);
  for i:=0 to Height-1 do
   begin
    Pixels[i] := Pointer(x);
    Inc(x, RowSize);
   end;
end;}

procedure TGMFastMonoBmp.SetInvertedPixel(const x, y: LongInt; const r, g, b: Word);
var PLine: PMonoLine; Mask: Byte; bx: LongInt;
begin
  if (x >= Width) or (y >= Height) then Exit;
  //Assert((x < Width) and (y < Height));
  PLine := Pixels[y];
  Mask := $80 shr (x mod 8);
  bx := x div 8;

  if (r<>0) or (g<>0) or (b<>0) then
  //if (r=$FF) or (g=$FF) or (b=$FF) then
   PLine[bx] := PLine[bx] and not Mask
  else
   PLine[bx] := PLine[bx] or Mask;
end;

procedure TGMFastMonoBmp.SetPixel(const x, y: LongInt; const r, g, b: Word);
var PLine: PMonoLine; Mask: Byte; bx: LongInt;
begin
  if (x >= Width) or (y >= Height) then Exit;
  //Assert((x < Width) and (y < Height));
  PLine := Pixels[y];
  Mask := $80 shr (x mod 8);
  bx := x div 8;

  if (r=0) and (g=0) and (b=0) then
   PLine[bx] := PLine[bx] and not Mask
  else
   PLine[bx] := PLine[bx] or Mask;
end;


{ ----------------------- }
{ ---- TGMFast256Bmp ---- }
{ ----------------------- }

function TGMFast256Bmp.Obj: TGMFast256Bmp;
begin
  Result := Self;
end;

function TGMFast256Bmp.BitsPerPixel: LongInt;
begin
  Result := 8;
end;

procedure TGMFast256Bmp.SetupPixelsMember(const PixelsPtr: Pointer);
begin
  FPixels := PixelsPtr;
end;


{ ----------------------- }
{ ---- TGMFastRGBBmp ---- }
{ ----------------------- }

constructor TGMFastRGBBmp.Create(const ASource: IGMFastRGBBmp; const ARect: PRect; const ARefLifeTime: Boolean);
begin
  inherited Create(0, 0, False, ASource.Obj.TopDown, ARefLifeTime);
  CopyContents(ASource.Obj, ARect);
end;

{destructor TGMFastRGBBmp.Destroy;
begin
  FreeMem(FPixels);
  inherited Destroy;
end;}

function TGMFastRGBBmp.Obj: TGMFastRGBBmp;
begin
  Result := Self;
end;

function TGMFastRGBBmp.BitsPerPixel: LongInt;
begin
  Result := SizeOf(TRGBColor) * 8;
end;

procedure TGMFastRGBBmp.SetupPixelsMember(const PixelsPtr: Pointer);
begin
  FPixels := PixelsPtr;
end;

procedure TGMFastRGBBmp.CopyContents(const ASource: TGMFastRGBBmp; const ARect: PRect);
//var R: TRect;
begin
  if ASource = nil then Exit;

  // Alternative: Immer via CopyRect:
  //if ARect <> nil then R := ARect^ else R := ASource.Bounds;
  //CopyRect(ASource, R);

  if ARect <> nil then CopyRect(ASource, ARect^) else
   begin
    SetSize(ASource.Width, ASource.Height, False, ASource.TopDown);
    CopyMemory(Bits, ASource.Bits, BitsMemSize);
   end;
end;

procedure TGMFastRGBBmp.CopyRect(const ASource: TGMFastRGBBmp; const ARect: TRect);
var i, w: LongInt;
begin
  if ASource = nil then Exit;
  LimitBounds(ASource, @ARect);
  SetSize(ARect.Right - ARect.Left, ARect.Bottom - ARect.Top, False, ASource.TopDown);
  w := Width * cRGBsz;
  for i:=0 to Height-1 do CopyMemory(Pixels[i], @ASource.Pixels[ARect.Top+i, ARect.Left], w);
end;

{procedure TGMFastRGBBmp.SetSize(const AWidth, AHeight: LongInt; const AFillWhite: Boolean);
var x: LongInt; i: LongInt;
begin
  if (AWidth = Width) and (AHeight = Height) then Exit;
  inherited SetSize(AWidth, AHeight, AFillWhite);
  GetMem(FPixels, Height * SizeOf(Pointer));
  x:=LongInt(Bits);
  for i:=0 to Height-1 do
   begin
    Pixels[i] := Pointer(x);
    Inc(x, RowSize);
   end;
end;}

procedure TGMFastRGBBmp.LoadFromFile(const AFileName: TGMString; const AOnProgress: IUnknown);
var FileStrm: IStream;
begin
  FileStrm := TGMFileIStream.CreateRead(AFileName);
  LoadFromStream(FileStrm, AOnProgress);
end;

procedure TGMFastRGBBmp.LoadFromStream(const AStream: IStream; const AOnProgress: IUnknown);
var FileBits: Pointer; HBmp: THandle; cmpr: DWORD; HdrBuf, BitBuf: AnsiString;
    BmpHdr: TBitmapFileHeader; PBmpInfoHdr: PBitmapInfo;
begin
  if AStream = nil then Exit;
                                                                                
  GMSafeIStreamRead(AStream, @BmpHdr, SizeOf(BmpHdr), {$I %CurrentRoutine%});
  if BmpHdr.bfType <> cBmpSig then raise EGMException.ObjError(RStrNoBmpStream, Self, {$I %CurrentRoutine%});

  SetLength(HdrBuf, BmpHdr.bfOffBits - GMIStreamPos(AStream));
  GMSafeIStreamRead(AStream, PAnsiChar(HdrBuf), Length(HdrBuf), {$I %CurrentRoutine%});
  PBmpInfoHdr := Pointer(PAnsiChar(HdrBuf));

  SetSize(PBmpInfoHdr.bmiHeader.biWidth, Abs(PBmpInfoHdr.bmiHeader.biHeight), False, False);
  cmpr := PBmpInfoHdr.bmiHeader.biCompression;
  PBmpInfoHdr.bmiHeader.biCompression := BI_RGB;

  FileBits := nil;
  HBmp := CreateDIBSection(0, PBmpInfoHdr^, DIB_RGB_COLORS, FileBits, 0, 0);
  GMApiCheckObj(HBmp <> 0, Self, 'CreateDIBSection');
  try
   Setlength(BitBuf, BmpHdr.bfSize - GMIStreamPos(AStream));
   GMSafeIStreamRead(AStream, PAnsiChar(BitBuf), Length(BitBuf), {$I %CurrentRoutine%});
   case cmpr of
    BI_RLE8: DecodeRLE8(Width, Height, PAnsiChar(BitBuf), FileBits);
    //else GMSafeIStreamRead(AStream, FileBits, BmpHdr.bfSize - GMIStreamPos(AStream), {$I %CurrentRoutine%});
    else GMApiCheckObj(SetDIBits(0, HBmp, 0, Height, PAnsiChar(BitBuf), PBmpInfoHdr^, DIB_RGB_COLORS) > 0, Self, {$I %CurrentRoutine%});
   end;
   StretchDIBits(DC, 0, 0, Width, Height, 0, 0, Width, Height, FileBits, PBmpInfoHdr^, DIB_RGB_COLORS, SRCCOPY);
  finally
   DeleteObject(HBmp);
  end;
end;

procedure TGMFastRGBBmp.SaveToFile(const AFileName: TGMString);
var hFile: LongInt; iWrote: Cardinal; fHead: TBitmapFileHeader; WasNeg: Boolean;
begin
  // saves upside down.. just Flop from FastFX if you want
  hFile:=CreateFile(PGMChar(AFileName), GENERIC_WRITE, FILE_SHARE_READ, nil, CREATE_ALWAYS, 0, 0);
  fHead.bfType := 19778; // "BM"
  fHead.bfSize := SizeOf(fHead) + BmpInfoHdrSize + BitsMemSize;
  fHead.bfOffBits := SizeOf(fHead) + BmpInfoHdrSize;
  WriteFile(hFile, fHead, SizeOf(fHead), iWrote, nil);
  WasNeg := FBmpInfo.biHeight < 0;
  //FBmpInfo.biHeight := Abs(FBmpInfo.biHeight);
  if WasNeg then FBmpInfo.biHeight := -FBmpInfo.biHeight;
  WriteFile(hFile, FBmpInfo^, BmpInfoHdrSize, iWrote, nil);
  if WasNeg then FBmpInfo.biHeight := -FBmpInfo.biHeight;
  WriteFile(hFile, Bits^, BitsMemSize, iWrote, nil);
  CloseHandle(hFile);
end;


{procedure TGMFastRGBBmp.LoadFromFile(FileName:TGMString);
var
hFile,
bSize: LongInt;
iRead: Cardinal;
fHead: TBitmapFileHeader;
fSize: DWORD;
begin
  hFile:=CreateFile(PGMChar(FileName),GENERIC_READ,FILE_SHARE_READ,nil,OPEN_EXISTING,0,0);
  //hFile:=OpenFile(PGMChar(FileName),fData,OF_READ);
  ReadFile(hFile,fHead,SizeOf(fHead),iRead,nil);
  ReadFile(hFile,FBmpInfo,SizeOf(FBmpInfo),iRead,nil);
  SetSize(FBmpInfo.bmiHeader.biWidth,Abs(FBmpInfo.bmiHeader.biHeight));
  //bSize:=(((fInfo.bmiHeader.biWidth*fInfo.bmiHeader.biBitCount+31)shr 5)shl 2)*fInfo.bmiHeader.biHeight;
  //GetMem(fBits,bSize);
  fSize:=GetFileSize(hFile,nil);
  SetFilePointer(hFile,fHead.bfOffBits,nil,FILE_BEGIN);

  ReadFile(hFile,Bits^,fSize-fHead.bfOffBits,iRead,nil);
  StretchDIBits(hDC,0,0,Width,Height,0,0,Width,Height,Bits,FBmpInfo,DIB_RGB_COLORS,SRCCOPY);
  //FreeMem(fBits);
  CloseHandle(hFile);
end;}

{procedure TFastDIB.LoadFromFile(FileName:TGMString);
var
  i: DWord;
  Buffer: Pointer;
  FBmpInfo: TBMInfo;
  hFile:  Windows.HFILE;
  fBits,xSize,fSize: DWord;
begin
  hFile:=CreateFile(PGMChar(FileName),GENERIC_READ,FILE_SHARE_READ,nil,OPEN_EXISTING,0,0);
  fSize:=GetFileSize(hFile,nil);
  xSize:=fSize;
  if xSize>1078 then xSize:=1078;
  GetMem(Buffer,1078);
  ReadFile(hFile,Buffer^,xSize,i,nil);
  fBits:=LoadHeader(Buffer,FBmpInfo);
  SetSizeIndirect(FBmpInfo);
  SetFilePointer(hFile,fBits-xSize,nil,FILE_CURRENT);
  if(FBmpInfo.Header.Compression=1)or(FBmpInfo.Header.Compression=2)then xSize:=PDWord(Integer(Buffer)+2)^-fBits else
  if fSize-fBits > Size then xSize:=Size else xSize:=fSize-fBits;
  if(FBmpInfo.Header.Compression=0)or(FBmpInfo.Header.Compression=3)then
    ReadFile(hFile,Bits^,xSize,i,nil)else
  begin
    ReAllocMem(Buffer,xSize);
    ReadFile(hFile,Buffer^,xSize,i,nil);
    if FBmpInfo.Header.Compression=1 then DecodeRLE8(Self,Buffer) else DecodeRLE4(Self,Buffer);
  end;
  CloseHandle(hFile);
  FreeMem(Buffer);
end;}


{procedure TGMFastRGBBmp.SaveToFile(const AFileName: TGMString);
type TByteArray = array [0..0] of Byte; PByteArray =^TByteArray;
var hFile:  LongInt;
    iWrote: Cardinal;
    //fData:  TofStruct;
    fHead:  TBitmapFileHeader;
begin
  // saves upside down.. just Flop from FastFX if you want
  hFile:=CreateFile(PGMChar(AFileName),GENERIC_WRITE,FILE_SHARE_READ,nil,CREATE_ALWAYS,0,0);
  //hFile:=OpenFile(PGMChar(FileName),fData,OF_CREATE or OF_WRITE);
  fHead.bfType := 19778; // "BM"
  fHead.bfSize := SizeOf(fHead) + SizeOf(FBmpInfo) + BitsMemSize;
  fHead.bfOffBits := SizeOf(fHead)+SizeOf(FBmpInfo);
  WriteFile(hFile, fHead, SizeOf(fHead), iWrote, nil);
  FBmpInfo.biHeight := Abs(FBmpInfo.biHeight);
  WriteFile(hFile, FBmpInfo, SizeOf(FBmpInfo), iWrote, nil);
  FBmpInfo.biHeight := -FBmpInfo.biHeight;
  WriteFile(hFile, PByteArray(Bits)^, BitsMemSize, iWrote, nil);
  CloseHandle(hFile);
end;}

{procedure TGMFastRGBBmp.LoadFromhBmp(hBmp:LongInt);
var Bmp:   TBitmap; memDC: LongInt;
begin
  GetObject(hBmp,SizeOf(Bmp),@Bmp);
  SetSize(Bmp.bmWidth,Bmp.bmHeight);
  memDC:=CreateCompatibleDC(0);
  GMApiCheckObj(memDC <> 0, Self, 'CreateCompatibleDC');
  SelectObject(memDC,hBmp);
  GMApiCheckObj(GetDIBits(memDC, hBmp, 0, Height, Bits, FBmpInfo, DIB_RGB_COLORS) <> 0, Self, 'GetDIBits');
  DeleteDC(memDC);
end;}

{procedure TGMFastRGBBmp.LoadFromRes(hInst:LongInt;sName:TGMString);
var
hBmp: LongInt;
begin
  hBmp:=LoadImage(hInst,PGMChar(sName),IMAGE_BITMAP,0,0,0);
  LoadFromhBmp(hBmp);
  DeleteObject(hBmp);
end;}


{
  SrcLn := @ASource.Pixels[ARect.Top, ARect.Left];
  DstLn := @Pixels[0, 0];
  for i:=0 to Height-1 do
   begin
    CopyMemory(DstLn, SrcLn, w);
    SrcLn := GMAddPtr(SrcLn, ASource.RowSize); // Ptr(LongInt(n1)+Dst.RowSize);
    DstLn := GMAddPtr(DstLn, RowSize); // Ptr(LongInt(n2)+RowSize);
   end;

}

  {for y:=Bounds.Top to Bounds.Bottom-1 do
   begin
    Tmp := @Bmp.Pixels[y, Bounds.Left];
    for x:=Bounds.Left to Bounds.Right-1 do
     begin
      Tmp.b:=Tmp.b xor 255;
      Tmp.g:=Tmp.g xor 255;
      Tmp.r:=Tmp.r xor 255;
      Inc(Tmp);
     end;
   end;


procedure TGMFastRGBBmp.CopyRect(Dst:TGMFastBMPBase;x,y,w,h,sx,sy:LongInt);
var
n1,n2: Pointer;
i:     LongInt;
begin
  if x<0 then
  begin
    Dec(sx,x);
    Inc(w,x);
    x:=0;
  end;
  if y<0 then
  begin
    Dec(sy,y);
    Inc(h,y);
    y:=0;
  end;
  if sx<0 then
  begin
    Dec(x,sx);
    Inc(w,sx);
    sx:=0;
  end;
  if sy<0 then
  begin
    Dec(y,sy);
    Inc(h,sy);
    sy:=0;
  end;
  if(sx>Width-1)or(sy>Height-1)then Exit;

  if sx+w>Width     then Dec(w,(sx+w)-(Width));
  if sy+h>Height    then Dec(h,(sy+h)-(Height));
  if x+w>Dst.Width  then Dec(w,(x+w)-(Dst.Width));
  if y+h>Dst.Height then Dec(h,(y+h)-(Dst.Height));

  n1:=@Dst.Pixels[y,x];
  n2:=@Pixels[sy,sx];
  for i:=0 to h-1 do
  begin
    CopyMemory(n1,n2,w*3);
    n1:=Ptr(LongInt(n1)+Dst.RowSize);
    n2:=Ptr(LongInt(n2)+RowSize);
  end;
end;}



{procedure TGMFastRGBBmp.SetInterface(fWidth,fHeight:LongInt;pBits:Pointer);
var
x: LongInt;
i: LongInt;
begin
  Width:=fWidth;
  Height:=Abs(fHeight);
  FBmpInfo.bmiHeader.biWidth:=fWidth;
  FBmpInfo.bmiHeader.biHeight:=fHeight;
  RowSize:=((Width*24+31)shr 5)shl 2;
  Gap:=Width mod 4;
  MemSize:=RowSize*Height;
  ReallocMem(Pixels,Height*4);
  Bits:=pBits;
  x:=LongInt(Bits);
  for i:=0 to fHeight-1 do
  begin
    Pixels[i]:=Pointer(x);
    Inc(x,RowSize);
  end;
end;}

{procedure TGMFastRGBBmp.TileDraw(fdc,x,y,w,h:LongInt);
var
wd,hd,
hBmp,
memDC: LongInt;
begin
  if(Width=0)or(Height=0)then Exit;
  memDC:=CreateCompatibleDC(fdc);
  hBmp:=CreateCompatibleBitmap(fdc,w,h);
  SelectObject(memDC,hBmp);
  Draw(memDC,0,0);
  wd:=Width;
  hd:=Height;
  while wd<w do
  begin
    BitBlt(memDC,wd,0,wd*2,h,memDC,0,0,SRCCOPY);
    Inc(wd,wd);
  end;
  while hd<h do
  begin
    BitBlt(memDC,0,hd,w,hd*2,memDC,0,0,SRCCOPY);
    Inc(hd,hd);
  end;
  BitBlt(fdc,x,y,w,h,memDC,0,0,SRCCOPY);
  DeleteDC(memDC);
  DeleteObject(hBmp);
end;}

{procedure TGMFastRGBBmp.Resize(Dst:TGMFastBMPBase);
var
xCount,
yCount,
x,y,xP,yP,
xD,yD,
yiScale,
xiScale:  LongInt;
xScale,
yScale:   Single;
Read,
Line:     PRGBLine;
Tmp:      TRGBColor;
pc:       PRGBColor;
begin
  if(Dst.Width=0)or(Dst.Height=0)then Exit;
  if(Dst.Width=Width)and(Dst.Height=Height)then
  begin
    CopyMemory(Dst.Bits,Bits,MemSize);
    Exit;
  end;

  xScale:=Dst.Width/Width;
  yScale:=Dst.Height/Height;
  if(xScale<1)or(yScale<1)then
  begin  // shrinking
    xiScale:=(Width shl 16) div Dst.Width;
    yiScale:=(Height shl 16) div Dst.Height;
    yP:=0;
    for y:=0 to Dst.Height-1 do
    begin
      xP:=0;
      read:=Pixels[yP shr 16];
      pc:=@Dst.Pixels[y,0];
      for x:=0 to Dst.Width-1 do
      begin
        pc^:=Read[xP shr 16];
        Inc(pc);
        Inc(xP,xiScale);
      end;
      Inc(yP,yiScale);
    end;
  end
  else   // zooming
  begin
    yiScale:=Round(yScale+0.5);
    xiScale:=Round(xScale+0.5);
    GetMem(Line,Dst.Width*3);
    for y:=0 to Height-1 do
    begin
      yP:=Trunc(yScale*y);
      Read:=Pixels[y];
      for x:=0 to Width-1 do
      begin
        xP:=Trunc(xScale*x);
        Tmp:=Read[x];
        for xCount:=0 to xiScale-1 do
        begin
          xD:=xCount+xP;
          if xD>=Dst.Width then Break;
          Line[xD]:=Tmp;
        end;
      end;
      for yCount:=0 to yiScale-1 do
      begin
        yD:=yCount+yP;
        if yD>=Dst.Height then Break;
        CopyMemory(Dst.Pixels[yD],Line,Dst.Width*3);                           
      end;
    end;
    FreeMem(Line);
  end;
end;}

// huge thanks to Vit Kovalcik for this awesome function!
// performs a fast bilinear interpolation <vkovalcik@iname.com>
{procedure TGMFastRGBBmp.SmoothResize(Dst:TGMFastBMPBase);
var
x,y,xP,yP,
yP2,xP2:     LongInt;
Read,Read2:  PRGBLine;
t,z,z2,iz2:  LongInt;
pc:PRGBColor;
w1,w2,w3,w4: LongInt;
Col1,Col2:   PRGBColor;
begin
  if(Dst.Width<1)or(Dst.Height<1)then Exit;
  if Width=1 then
  begin
    Resize(Dst);
    Exit;
  end;
  if(Dst.Width=Width)and(Dst.Height=Height)then
  begin
    CopyMemory(Dst.Bits,Bits,MemSize);
    Exit;
  end;
  xP2:=((Width-1)shl 15)div Dst.Width;
  yP2:=((Height-1)shl 15)div Dst.Height;
  yP:=0;
  for y:=0 to Dst.Height-1 do
  begin
    xP:=0;
    Read:=Pixels[yP shr 15];
    if yP shr 16<Height-1 then
      Read2:=Pixels[yP shr 15+1]
    else
      Read2:=Pixels[yP shr 15];
    pc:=@Dst.Pixels[y,0];
    z2:=yP and $7FFF;
    iz2:=$8000-z2;
    for x:=0 to Dst.Width-1 do
    begin
      t:=xP shr 15;
      Col1:=@Read[t];
      Col2:=@Read2[t];
      z:=xP and $7FFF;
      w2:=(z*iz2)shr 15;
      w1:=iz2-w2;
      w4:=(z*z2)shr 15;
      w3:=z2-w4;
      pc.b:=
        (Col1.b*w1+PRGBColor(LongInt(Col1)+3).b*w2+
         Col2.b*w3+PRGBColor(LongInt(Col2)+3).b*w4)shr 15;
      pc.g:=
        (Col1.g*w1+PRGBColor(LongInt(Col1)+3).g*w2+
         Col2.g*w3+PRGBColor(LongInt(Col2)+3).g*w4)shr 15;
      pc.r:=
        (Col1.r*w1+PRGBColor(LongInt(Col1)+3).r*w2+
         Col2.r*w3+PRGBColor(LongInt(Col2)+3).r*w4)shr 15;
      Inc(pc);
      Inc(xP,xP2);
    end;
    Inc(yP,yP2);
  end;
end;}

{procedure TGMFastRGBBmp.CopyRect(Dst:TGMFastBMPBase;x,y,w,h,sx,sy:LongInt);
var
n1,n2: Pointer;
i:     LongInt;
begin
  if x<0 then
  begin
    Dec(sx,x);
    Inc(w,x);
    x:=0;
  end;
  if y<0 then
  begin
    Dec(sy,y);
    Inc(h,y);
    y:=0;
  end;
  if sx<0 then
  begin
    Dec(x,sx);
    Inc(w,sx);
    sx:=0;
  end;
  if sy<0 then
  begin
    Dec(y,sy);
    Inc(h,sy);
    sy:=0;
  end;
  if(sx>Width-1)or(sy>Height-1)then Exit;

  if sx+w>Width     then Dec(w,(sx+w)-(Width));
  if sy+h>Height    then Dec(h,(sy+h)-(Height));
  if x+w>Dst.Width  then Dec(w,(x+w)-(Dst.Width));
  if y+h>Dst.Height then Dec(h,(y+h)-(Dst.Height));

  n1:=@Dst.Pixels[y,x];
  n2:=@Pixels[sy,sx];
  for i:=0 to h-1 do
  begin
    CopyMemory(n1,n2,w*3);
    n1:=Ptr(LongInt(n1)+Dst.RowSize);
    n2:=Ptr(LongInt(n2)+RowSize);
  end;
end;}

{procedure TGMFastRGBBmp.Tile(Dst:TGMFastBMPBase);
var
w,h,cy,cx: LongInt;
begin
  if(Dst.Width=0)or(Dst.Height=0)or
    (Width=0)or(Height=0)then Exit;
  CopyRect(Dst,0,0,Width,Height,0,0);
  w:=Width;
  h:=Height;
  cx:=Dst.Width;
  cy:=Dst.Height;
  while w<cx do
  begin
    Dst.CopyRect(Dst,w,0,w*2,h,0,0);
    Inc(w,w);
  end;
  while h<cy do
  begin
    Dst.CopyRect(Dst,0,h,w,h*2,0,0);
    Inc(h,h);
  end;
end;}

// Vit's function, accurate to 256^3!
{function TGMFastRGBBmp.CountColors:LongInt;
type
TSpace = array[0..255,0..255,0..31]of Byte;
PSpace =^TSpace;
var
x,y:   LongInt;
Tmp:   PRGBColor;
Count: LongInt;
Buff:  PByte;
Test:  Byte;
Space: PSpace;
begin
  New(Space);
  FillByte(Space^,SizeOf(TSpace),0);
  Tmp:=Bits;
  Count:=0;
  for y:=0 to Height-1 do
  begin
    for x:=0 to Width-1 do
    begin
      Buff:=@Space^[Tmp.r,Tmp.g,Tmp.b shr 3];
      Test:=(1 shl(Tmp.b and 7));
      if(Buff^ and Test)=0 then
      begin
        Inc(Count);
        Buff^:=Buff^ or Test;
      end;
      Inc(Tmp);
    end;
    Tmp:=Ptr(LongInt(Tmp)+Gap);
  end;
  Result:=Count;
  Dispose(Space);
end;}


{ -------------------------- }
{ ---- Image Operations ---- }
{ -------------------------- }

procedure FxRGB(const Bmp: TGMFastRGBBmp; const ra, ga, ba: LongInt; const Bounds: TRect);
var Table: array [0..255] of TRGBColor; x, y: LongInt; Tmp: PRGBColor; i: Byte;
begin
  LimitBounds(Bmp, @Bounds);

  for i:=0 to 255 do
   begin
    Table[i].b:=IntToByte(i+ba);
    Table[i].g:=IntToByte(i+ga);
    Table[i].r:=IntToByte(i+ra);
   end;

  for y:=Bounds.Top to Bounds.Bottom-1 do
   begin
    Tmp := @Bmp.Pixels[y, Bounds.Left];
    for x:=Bounds.Left to Bounds.Right-1 do
     begin
      Tmp.b:=Table[Tmp.b].b;
      Tmp.g:=Table[Tmp.g].g;
      Tmp.r:=Table[Tmp.r].r;
      Inc(Tmp);
     end;
   end;
end;

procedure FxContrast(const Bmp: TGMFastRGBBmp; const Amount: LongInt; const Bounds: TRect);
var x, y: LongInt; Table: array [0..255] of Byte; Tmp: PRGBColor; i: Byte;
begin
  LimitBounds(Bmp, @Bounds);

  for i:=0 to 126 do
   begin
    y:=(Abs(128-i)*Amount) div 256; Table[i]:=IntToByte(i-y);
   end;
  for i:=127 to 255 do
   begin
    y:=(Abs(128-i)*Amount) div 256; Table[i]:=IntToByte(i+y);
   end;

  for y:=Bounds.Top to Bounds.Bottom-1 do
   begin
    Tmp := @Bmp.Pixels[y, Bounds.Left];
    for x:=Bounds.Left to Bounds.Right-1 do
     begin
      Tmp.b:=Table[Tmp.b];
      Tmp.g:=Table[Tmp.g];
      Tmp.r:=Table[Tmp.r];
      Inc(Tmp);
     end;
   end;
end;

procedure FxSaturation(const Bmp: TGMFastRGBBmp; const Amount: LongInt; const Bounds: TRect);
var Grays: array[0..767]of LongInt; Alpha: array[0..255]of Word; Gray, x, y: LongInt; pc: PRGBColor; i: Byte;
begin
  LimitBounds(Bmp, @Bounds);

  for i:=0 to 255 do Alpha[i]:=(i*Amount)shr 8;
  x:=0;
  for i:=0 to 255 do
   begin
    Gray:=i-Alpha[i];
    Grays[x]:=Gray; Inc(x);
    Grays[x]:=Gray; Inc(x);
    Grays[x]:=Gray; Inc(x);
   end;

  for y:=Bounds.Top to Bounds.Bottom-1 do
   begin
    pc := @Bmp.Pixels[y, Bounds.Left];
    for x:=Bounds.Left to Bounds.Right-1 do
     begin
      Gray:=Grays[pc.r+pc.g+pc.b];
      pc.b:=IntToByte(Gray+Alpha[pc.b]);
      pc.g:=IntToByte(Gray+Alpha[pc.g]);
      pc.r:=IntToByte(Gray+Alpha[pc.r]);
      Inc(pc);
     end;
   end;
end;

procedure FxLightness(const Bmp: TGMFastRGBBmp; Amount: LongInt; const Bounds: TRect);
var x, y: LongInt; Table: array [0..255] of Byte; Tmp: PRGBColor; i: Byte;
begin
  LimitBounds(Bmp, @Bounds);

  if Amount<0 then
   begin
    Amount:=-Amount;
    for i:=0 to 255 do Table[i]:=IntToByte(i-((Amount*i)shr 8));
   end else
    for i:=0 to 255 do Table[i]:=IntToByte(i+((Amount*(i xor 255))shr 8));

  for y:=Bounds.Top to Bounds.Bottom-1 do
   begin
    Tmp := @Bmp.Pixels[y, Bounds.Left];
    for x:=Bounds.Left to Bounds.Right-1 do
     begin
      Tmp.b:=Table[Tmp.b];
      Tmp.g:=Table[Tmp.g];
      Tmp.r:=Table[Tmp.r];
      Inc(Tmp);
     end;
   end;
end;

procedure FxHFlip(const Bmp: TGMFastRGBBmp; const Bounds: TRect);
var w, x, y: LongInt; Tmp: TRGBColor; Line: PRGBLine;
begin
  LimitBounds(Bmp, @Bounds);
  w:=GMRectSize(Bounds).x-1;
  Line:=Bmp.Pixels[Bounds.Top];
  for y:=Bounds.Top to Bounds.Bottom-1 do
   begin
    for x:=0 to w div 2 do
     begin
      Tmp:=Line[Bounds.Left+x];
      Line[Bounds.Left+x] := Line[Bounds.Right-x-1];
      Line[Bounds.Right-x-1] := Tmp;
     end;
    //Line := Ptr(PtrInt(Line)+Bmp.RowSize);
    Line := Pointer(PtrInt(Line)+Bmp.RowSize);
   end;
end;

procedure FxVFlip(const Bmp: TGMFastRGBBmp; const Bounds: TRect);
var y, h, w: LongInt; p1, p2, Line: PRGBColor;
begin
  LimitBounds(Bmp, @Bounds);
  w := (Bounds.Right - Bounds.Left) * cRGBsz;
  GetMem(Line, w);
  try
   h:=Bounds.Bottom - Bounds.Top-1;
   for y:=0 to h div 2 do
    begin
     p1 := @Bmp.Pixels[Bounds.Top+y, Bounds.Left];
     p2 := @Bmp.Pixels[Bounds.Bottom-y-1, Bounds.Left];
     CopyMemory(Line, p1 , w);
     CopyMemory(p1, p2, w);
     CopyMemory(p2, Line, w);
    end;
  finally
   FreeMem(Line);
  end;
end;

procedure FxEmboss(const Bmp: TGMFastRGBBmp; const Bounds: TRect);
//const c2szRGB = 2 * cRGBsz;
var x, y, w: LongInt; p1, p2: PRGBColor; Line: PRGBLine;
begin
  LimitBounds(Bmp, @Bounds);
  w := Bounds.Right - Bounds.Left;
  GetMem(Line, w * cRGBsz);
  try
   CopyMemory(Line, @Bmp.Pixels[Bounds.Bottom-1, Bounds.Left], w * cRGBsz);
   for y:=Bounds.Top to Bounds.Bottom-1 do
    begin
     p1 := @Bmp.Pixels[y, Bounds.Left];
     if y < Bounds.Bottom-2 then p2 := @Bmp.Pixels[y+1, Bounds.Left+1] else p2 := GMAddPtr(Line, cRGBsz);
     for x:=Bounds.Left to Bounds.Right-1 do
      begin
       p1.b:=(p1.b+(p2.b xor $FF))shr 1;
       p1.g:=(p1.g+(p2.g xor $FF))shr 1;
       p1.r:=(p1.r+(p2.r xor $FF))shr 1;
       Inc(p1);
       if (y < Bounds.Bottom-2) and (x < Bounds.Right-2) then Inc(p2);
      end;
    end;
  finally
   FreeMem(Line);
  end;
end;

procedure FxSpray(const Bmp, Dst: TGMFastRGBBmp; const Amount: LongInt; const Bounds: TRect);
var r, x, y: LongInt;
begin
  LimitBounds(Bmp, @Bounds);
  for y:=Bounds.Top to Bounds.Bottom-1 do
   for x:=Bounds.Left to Bounds.Right-1 do
    begin
     r:=Random(Amount);
     Dst.Pixels[y,x]:=
     Bmp.Pixels[TrimInt(y+(r-Random(r*2)),Bounds.Top,Bounds.Bottom-1), TrimInt(x+(r-Random(r*2)),Bounds.Left,Bounds.Right-1)];
    end;
end;

procedure FxInvert(const Bmp: TGMFastRGBBmp; const Bounds: TRect);
var x, y: LongInt; Tmp: PRGBColor;
begin
  LimitBounds(Bmp, @Bounds);
  for y:=Bounds.Top to Bounds.Bottom-1 do
   begin
    Tmp := @Bmp.Pixels[y, Bounds.Left];
    for x:=Bounds.Left to Bounds.Right-1 do
     begin
      Tmp.b:=Tmp.b xor 255;
      Tmp.g:=Tmp.g xor 255;
      Tmp.r:=Tmp.r xor 255;
      Inc(Tmp);
     end;
   end;
end;

procedure FxGrayscale(const Bmp: TGMFastRGBBmp; const Bounds: TRect);
var x, y: LongInt; g, i: Byte; Tmp: PRGBColor; // Div3: array [0..767] of Byte;
begin
  LimitBounds(Bmp, @Bounds);

//x:=0;
//for i:=0 to 255 do
// begin
//  Div3[x]:=i; Inc(x);
//  Div3[x]:=i; Inc(x);
//  Div3[x]:=i; Inc(x);
// end;

  for y:=Bounds.Top to Bounds.Bottom-1 do
   begin
    Tmp := @Bmp.Pixels[y, Bounds.Left];
    for x:=Bounds.Left to Bounds.Right-1 do
     begin
      g := Round(Tmp.r * 0.3 + Tmp.g * 0.59 + Tmp.b * 0.11);
//    g:=Div3[Tmp.b+Tmp.g+Tmp.r];
      Tmp.b:=g; Tmp.g:=g; Tmp.r:=g;
      Inc(Tmp);
     end;
   end;
end;

procedure FxRedEyeFilter(const Bmp: TGMFastRGBBmp; const ThresHold: LongInt; const Bounds: TRect);
const rf = 0.5133333; gf = 1; bf = 0.1933333; // Ammount = 12;
var x, y, r, g, b: LongInt; Tmp: PRGBColor; //Col: TRGBColor;
begin
  LimitBounds(Bmp, @Bounds);
  for y:=Bounds.Top to Bounds.Bottom-1 do
   begin
    Tmp := @Bmp.Pixels[y, Bounds.Left];
    for x:=Bounds.Left to Bounds.Right-1 do
     begin
      r := Round(Tmp.r * rf);
      g := Round(Tmp.g * gf);
      b := Round(Tmp.b * bf);
      if (r >= g - ThresHold) and (r >= b -ThresHold) then Tmp.r := IntToByte(Round((g + b) / (2 * rf)));
      Inc(Tmp);
     end;
   end;
end;

procedure FxSharpen(const Bmp: TGMFastRGBBmp; const Amount: LongInt; const Bounds: TRect);
var Lin0, Lin1, Lin2: PRGBLine; pc: PRGBColor; cx, x, y: LongInt; Buf: array [0..8] of TRGBColor;
begin
  LimitBounds(Bmp, @Bounds);
  for y:=Bounds.Top to Bounds.Bottom-1 do
   begin
    Lin0 := Bmp.Pixels[TrimInt(y-Amount, 0, Bounds.Bottom-1)];
    Lin1 := Bmp.Pixels[y];
    Lin2 := Bmp.Pixels[TrimInt(y+Amount, 0, Bounds.Bottom-1)];
    pc := @Bmp.Pixels[y, Bounds.Left];
    for x:=Bounds.Left to Bounds.Right-1 do
     begin
      cx:=TrimInt(x-Amount, 0, Bounds.Right-1);
      Buf[0]:=Lin0[cx]; Buf[1]:=Lin1[cx];
      Buf[2]:=Lin2[cx]; Buf[3]:=Lin0[x];
      Buf[4]:=Lin1[x];  Buf[5]:=Lin2[x];
      cx:=TrimInt(x+Amount, 0, Bounds.Right-1);
      Buf[6]:=Lin0[cx];
      Buf[7]:=Lin1[cx];
      Buf[8]:=Lin2[cx];
      pc.b:=IntToByte(
              (256*Buf[4].b-(Buf[0].b+Buf[1].b+Buf[2].b+Buf[3].b+
               Buf[5].b+Buf[6].b+Buf[7].b+Buf[8].b)*16)div 128);
      pc.g:=IntToByte(
              (256*Buf[4].g-(Buf[0].g+Buf[1].g+Buf[2].g+Buf[3].g+
               Buf[5].g+Buf[6].g+Buf[7].g+Buf[8].g)*16)div 128);
      pc.r:=IntToByte(
              (256*Buf[4].r-(Buf[0].r+Buf[1].r+Buf[2].r+Buf[3].r+
               Buf[5].r+Buf[6].r+Buf[7].r+Buf[8].r)*16)div 128);
      Inc(pc);
     end;
   end;
end;

procedure FxGaussianSharpen(const Bmp: TGMFastRGBBmp; const Amount: LongInt; const Bounds: TRect);
var i: LongInt;
begin
  for i:=Amount downto 1 do FxSharpen(Bmp, i, Bounds);
end;

procedure FxSplitBlur(const Bmp: TGMFastRGBBmp; const Amount: LongInt; const Bounds: TRect);
var Lin1, Lin2: PRGBLine; pc: PRGBColor; cx, x, y: LongInt; Buf: array [0..3] of TRGBColor;
begin
  LimitBounds(Bmp, @Bounds);
  for y:=Bounds.Top to Bounds.Bottom-1 do
   begin
    Lin1:=Bmp.Pixels[TrimInt(y+Amount, 0, Bounds.Bottom-1)];
    Lin2:=Bmp.Pixels[TrimInt(y-Amount, 0, Bounds.Bottom-1)];
    pc := @Bmp.Pixels[y, Bounds.Left];
    for x:=Bounds.Left to Bounds.Right-1 do
     begin
      cx:=TrimInt(x+Amount, 0, Bounds.Right-1);
      Buf[0]:=Lin1[cx];
      Buf[1]:=Lin2[cx];
      cx:=TrimInt(x-Amount, 0, Bounds.Right-1);
      Buf[2]:=Lin1[cx];
      Buf[3]:=Lin2[cx];
      pc.b:=(Buf[0].b+Buf[1].b+Buf[2].b+Buf[3].b)shr 2;
      pc.g:=(Buf[0].g+Buf[1].g+Buf[2].g+Buf[3].g)shr 2;
      pc.r:=(Buf[0].r+Buf[1].r+Buf[2].r+Buf[3].r)shr 2;
      Inc(pc);
     end;
   end;
end;

procedure FxGaussianBlur(const Bmp: TGMFastRGBBmp; const Distance: LongInt; const Bounds: TRect);
var i: LongInt;
begin
  for i:=1 to Distance do FxSplitBlur(Bmp, i, Bounds);
end;

procedure FxSoftenEdges(const Bmp: TGMFastRGBBmp; const Bounds: TRect);
var pc: PRGBColor; x, y: LongInt; Clr1, Clr2: TRGBColor;
  procedure AssignColor;
  begin
    if CompareRGBColors(Clr1, Clr2) and not CompareRGBColors(Clr1, pc^, 50) then
     begin
//    pc.r := ((Clr1.r + Clr2.r + pc.r) div 3);
//    pc.g := ((Clr1.g + Clr2.g + pc.g) div 3);
//    pc.b := ((Clr1.b + Clr2.b + pc.b) div 3);
      pc.r := ((Clr2.r + pc.r) shr 1);
      pc.g := ((Clr2.g + pc.g) shr 1);
      pc.b := ((Clr2.b + pc.b) shr 1);
     end;
  end;
begin
  LimitBounds(Bmp, @Bounds);
  for y:=Bounds.Top to Bounds.Bottom-1 do
   begin
    pc := @Bmp.Pixels[y, Bounds.Left];
    for x:=Bounds.Left to Bounds.Right-1 do
     begin
      if (y > Bounds.Top) and (x > Bounds.Left) then
       begin Clr1 := Bmp.Pixels[y-1, x]; Clr2 := Bmp.Pixels[y, x-1]; AssignColor; end;

      if (y > Bounds.Top) and (x < Bounds.Right-1) then
       begin Clr1 := Bmp.Pixels[y-1, x]; Clr2 := Bmp.Pixels[y, x+1]; AssignColor; end;

      if (y < Bounds.Bottom-1) and (x > Bounds.Left) then
       begin Clr1 := Bmp.Pixels[y+1, x]; Clr2 := Bmp.Pixels[y, x-1]; AssignColor; end;

      if (y < Bounds.Bottom-1) and (x < Bounds.Right-1) then
       begin Clr1 := Bmp.Pixels[y+1, x]; Clr2 := Bmp.Pixels[y, x+1]; AssignColor; end;

      Inc(pc);
     end;
   end;
end;

procedure FxMosaic(const Bmp: TGMFastRGBBmp; const xAmount, yAmount: LongInt; const Bounds: TRect);
var Delta, tx, ty, cx, cy, ix, iy, x, y: LongInt; Col: TRGBColor; Pix: PRGBColor; Line: PRGBLine;
begin
  if(xAmount<1)or(yAmount<1)then Exit;
  ix:=(xAmount shr 1)+(xAmount and 1);
  iy:=(yAmount shr 1)+(yAmount and 1);
  y:=Bounds.Top;
  while y < Bounds.Bottom do
   begin
    x:=Bounds.Left;
    cy:=y+iy;
    if cy>=Bounds.Bottom then
      Line:=Bmp.Pixels[Bounds.Bottom-1]
    else
      Line:=Bmp.Pixels[cy];
    if y+yAmount-1>=Bounds.Bottom then
      ty:=Bounds.Bottom-1-y
    else
      ty:=yAmount;
    while x < Bounds.Right do
     begin
      cx:=x+ix;
      if cx>=Bounds.Right then
        Col:=Line[Bounds.Right-1]
      else
        Col:=Line[cx];
      if x+xAmount-1>=Bounds.Right then
        tx:=Bounds.Right-1-x
      else
        tx:=xAmount;
      Delta:=Bmp.RowSize-tx*3;
      //Pix:=Ptr(PtrInt(Bmp.Pixels[y])+x*3);
      Pix:=Pointer(PtrInt(Bmp.Pixels[y])+x*3);
      for cy:=1 to ty do
       begin
        for cx:=1 to tx do
        begin
          Pix^:=Col;
          Inc(Pix);
        end;
        //Pix:=Ptr(PtrInt(Pix)+Delta);
        Pix:=Pointer(PtrInt(Pix)+Delta);
       end;
      Inc(x,xAmount);
     end;
    Inc(y,yAmount);
   end;
end;

procedure FxFishEye(const Bmp, Dst: TGMFastRGBBmp; const Amount: Extended; const Bounds: TRect);
var
xmid,ymid              : Single;
fx,fy                  : Single;
r1, r2                 : Single;
ifx, ify               : LongInt;
dx, dy                 : Single;
rmax                   : Single;
ty, tx                 : LongInt;
weight_x, weight_y     : array[0..1] of Single;
weight                 : Single;
new_red, new_green     : LongInt;
new_blue               : LongInt;
total_red, total_green : Single;
total_blue             : Single;
ix, iy                 : LongInt;
sli, slo : PRGBLine;
begin
  LimitBounds(Bmp, @Bounds);
  IntersectRect((@Bounds)^, Bounds, Dst.Bounds);

  xmid := (Bounds.Left + Bounds.Right) /2;
  ymid := (Bounds.Top + Bounds.Bottom) /2;
  rmax := (Bounds.Right - Bounds.Left) * Amount;

  for ty := Bounds.Top to Bounds.Bottom-1 do begin
    for tx := Bounds.Left to Bounds.Right - 1 do begin
      dx := tx - xmid;
      dy := ty - ymid;
      r1 := Sqrt(dx * dx + dy * dy);
      if r1 = 0 then begin
        fx := xmid;
        fy := ymid;
      end
      else begin
        r2 := rmax / 2 * (1 / (1 - r1/rmax) - 1);
        fx := dx * r2 / r1 + xmid;
        fy := dy * r2 / r1 + ymid;
      end;
      ify := Trunc(fy);
      ifx := Trunc(fx);
                // Calculate the weights.
      if fy >= 0  then begin
        weight_y[1] := fy - ify;
        weight_y[0] := 1 - weight_y[1];
      end else begin
        weight_y[0] := -(fy - ify);
        weight_y[1] := 1 - weight_y[0];
      end;
      if fx >= 0 then begin
        weight_x[1] := fx - ifx;
        weight_x[0] := 1 - weight_x[1];
      end else begin
        weight_x[0] := -(fx - ifx);
        Weight_x[1] := 1 - weight_x[0];
      end;

      if ifx < 0 then
        ifx := Bounds.Right-1-(-ifx mod Bounds.Right)
      else if ifx > Bounds.Right-1  then
        ifx := ifx mod Bounds.Right;
      if ify < 0 then
        ify := Bounds.Bottom-1-(-ify mod Bounds.Bottom)
      else if ify > Bounds.Bottom-1 then
        ify := ify mod Bounds.Bottom;

      total_red   := 0.0;
      total_green := 0.0;
      total_blue  := 0.0;
      for ix := 0 to 1 do begin
        for iy := 0 to 1 do begin
          if ify + iy < Bounds.Bottom then
            sli := Bmp.Pixels[ify + iy]
          else
            sli := Bmp.Pixels[Bounds.Bottom - ify - iy];
          if ifx + ix < Bounds.Right then begin
            new_red := sli^[ifx + ix].r;
            new_green := sli^[ifx + ix].g;
            new_blue := sli^[ifx + ix].b;
          end
          else begin
            new_red := sli^[Bounds.Right - ifx - ix].r;
            new_green := sli^[Bounds.Right - ifx - ix].g;
            new_blue := sli^[Bounds.Right - ifx - ix].b;
          end;
          weight := weight_x[ix] * weight_y[iy];
          total_red   := total_red   + new_red   * weight;
          total_green := total_green + new_green * weight;
          total_blue  := total_blue  + new_blue  * weight;
        end;
      end;
      slo := Dst.Pixels[ty];
      slo^[tx].r := Round(total_red);
      slo^[tx].g := Round(total_green);
      slo^[tx].b := Round(total_blue);
    end;
  end;
end;

procedure FxTwist(const Bmp, Dst: TGMFastRGBBmp; const Amount: LongInt; const Bounds: TRect);
var
  fxmid, fymid : Single;
  txmid, tymid : Single;
  fx,fy : Single;
  tx2, ty2 : Single;
  r : Single;
  theta : Single;
  ifx, ify : LongInt;
  dx, dy : Single;
  OFFSET : Single;
  ty, tx             : LongInt;
  weight_x, weight_y     : array[0..1] of Single;
  weight                 : Single;
  new_red, new_green     : LongInt;
  new_blue               : LongInt;
  total_red, total_green : Single;
  total_blue             : Single;
  ix, iy                 : LongInt;
  sli, slo : PRGBLine;

  function ArcTan2(xt,yt : Single): Single;
  begin
    if xt = 0 then
      if yt > 0 then
        Result := Pi/2
      else
        Result := -(Pi/2)
    else begin
      Result := ArcTan(yt/xt);
      if xt < 0 then
        Result := Pi + ArcTan(yt/xt);
    end;
  end;

begin
  LimitBounds(Bmp, @Bounds);
  IntersectRect((@Bounds)^, Bounds, Dst.Bounds);
  OFFSET := -(Pi/2);
  dx := Bounds.Right - Bounds.Left - 1;
  dy := Bounds.Bottom - Bounds.Top - 1;
  r := Sqrt(dx * dx + dy * dy);
  tx2 := Bounds.Left + r;
  ty2 := Bounds.Top + r;
  txmid := (Bounds.Left + Bounds.Right -1) / 2;    //Adjust these to move center of rotation
  tymid := (Bounds.Top + Bounds.Bottom -1) / 2;   //Adjust these to move ......
  fxmid := txmid;
  fymid := tymid;
  if tx2 >= Bounds.Right then tx2 := Bounds.Right-1;
  if ty2 >= Bounds.Bottom then ty2 := Bounds.Bottom-1;

  for ty := Bounds.Top to Round(ty2) do begin
    for tx := Bounds.Left to Round(tx2) do begin
      dx := tx - txmid;
      dy := ty - tymid;
      r := Sqrt(dx * dx + dy * dy);
      if r = 0 then begin
        fx := 0;
        fy := 0;
      end
      else begin
        theta := ArcTan2(dx,dy) - r/Amount - OFFSET;
        fx := r * Cos(theta);
        fy := r * Sin(theta);
      end;
      fx := fx + fxmid;
      fy := fy + fymid;

      ify := Trunc(fy);
      ifx := Trunc(fx);
                // Calculate the weights.
      if fy >= 0  then begin
        weight_y[1] := fy - ify;
        weight_y[0] := 1 - weight_y[1];
      end else begin
        weight_y[0] := -(fy - ify);
        weight_y[1] := 1 - weight_y[0];
      end;
      if fx >= 0 then begin
        weight_x[1] := fx - ifx;
        weight_x[0] := 1 - weight_x[1];
      end else begin
        weight_x[0] := -(fx - ifx);
        Weight_x[1] := 1 - weight_x[0];
      end;

      if ifx < 0 then
        ifx := Bounds.Right-1-(-ifx mod Bounds.Right)
      else if ifx > Bounds.Right-1  then
        ifx := ifx mod Bounds.Right;
      if ify < 0 then
        ify := Bounds.Bottom-1-(-ify mod Bounds.Bottom)
      else if ify > Bounds.Bottom-1 then
        ify := ify mod Bounds.Bottom;

      total_red   := 0.0;
      total_green := 0.0;
      total_blue  := 0.0;
      for ix := 0 to 1 do begin
        for iy := 0 to 1 do begin
          if ify + iy < Bounds.Bottom then
            sli := Bmp.Pixels[ify + iy]
          else
            sli := Bmp.Pixels[Bounds.Bottom - ify - iy];
          if ifx + ix < Bounds.Right then begin
            new_red := sli^[ifx + ix].r;
            new_green := sli^[ifx + ix].g;
            new_blue := sli^[ifx + ix].b;
          end
          else begin
            new_red := sli^[Bounds.Right - ifx - ix].r;
            new_green := sli^[Bounds.Right - ifx - ix].g;
            new_blue := sli^[Bounds.Right - ifx - ix].b;
          end;
          weight := weight_x[ix] * weight_y[iy];
          total_red   := total_red   + new_red   * weight;
          total_green := total_green + new_green * weight;
          total_blue  := total_blue  + new_blue  * weight;
        end;
      end;
      slo := Dst.Pixels[ty];
      slo^[tx].r := Round(total_red);
      slo^[tx].g := Round(total_green);
      slo^[tx].b := Round(total_blue);
    end;
  end;
end;

{$R-}

procedure FxAlphaBlend(const Dst, Src1, Src2: TGMFastRGBBmp; const Alpha: LongInt; const Bounds: TRect);
var x, y, i: LongInt; c1, c2, c3: PRGBColor; Table: array [-255..255] of LongInt;
begin
  {ToDo: FxAlphaBlend mit Bounds}
  //LimitBounds(Bmp, @Bounds);
  for i:=-255 to 255 do
  Table[i]:=(Alpha*i)shr 8;
  c1:=Dst.Bits;
  c2:=Src1.Bits;
  c3:=Src2.Bits;
  for y:=0 to Dst.Height-1 do
   begin
    for x:=0 to Dst.Width-1 do
     begin
      c1.b:=Table[c2.b-c3.b]+c3.b;
      c1.g:=Table[c2.g-c3.g]+c3.g;
      c1.r:=Table[c2.r-c3.r]+c3.r;
      Inc(c1); Inc(c2); Inc(c3);
     end;
    c1:=Pointer(PtrInt(c1)+Dst.RowGap);
    c2:=Pointer(PtrInt(c2)+Src1.RowGap);
    c3:=Pointer(PtrInt(c3)+Src2.RowGap);
   end;
end;


end.