RnQ/for.RnQ/RTL/RnQGraphics32.pas

unit RnQGraphics32;
{$I ForRnQConfig.inc}

{$IFDEF FPC}
{$DEFINE TransparentStretchBltMissing}
{$DEFINE CopyPaletteMissing}
{$ENDIF}

interface

uses
  Winapi.Windows, Winapi.Wincodec, Winapi.ActiveX, System.SysUtils, System.Types, System.Classes,
  Vcl.Graphics, Vcl.Imaging.PNGImage, Generics.Collections,
  RDFileUtil, RDGlobal, RDUtils, GR32;

{$I NoRTTI.inc}

type
  TGradientDirection = (gdVertical, gdHorizontal);
  TPAFormat = (PA_FORMAT_UNK, PA_FORMAT_BMP, PA_FORMAT_JPEG, PA_FORMAT_GIF, PA_FORMAT_PNG, PA_FORMAT_XML, PA_FORMAT_SWF,
    PA_FORMAT_ICO, PA_FORMAT_TIF, PA_FORMAT_WEBP, PA_FORMAT_JSON);

const
  PAFormat: array [TPAFormat] of string = ('.dat', '.bmp', '.jpeg', '.gif', '.png', '.xml', '.swf', '.ico', '.tif', '.webp', '.json');
  //PAFormatString: array [TPAFormat] of string = ('Unknown', 'Bitmap', 'JPEG', 'GIF', 'PNG', 'XML', 'SWF', 'ICON', 'TIF', 'WEBP', 'JSON');

type
  TAniDisposalType = (dtUndefined, { Take no action }
    dtDoNothing, { Leave graphic, next frame goes on top of it }
    dtToBackground, { restore original background for next frame }
    dtToPrevious); { restore image as it existed before this frame }

  TAniFrame = class
  private
    { private declarations }
    frLeft: Integer;
    frTop: Integer;
    frWidth: Integer;
    frHeight: Integer;

    frDelay: Integer;
    frDisposalMethod: TAniDisposalType;
    TheEnd: boolean; { end of what gets copied }

    IsCopy: boolean;

  public
    constructor Create;
    constructor CreateCopy(Item: TAniFrame);
    // destructor Destroy; override;
  end;

  TAniFrameList = class(TList)
  private
    function GetFrame(I: Integer): TAniFrame;
  public
    { note: Frames is 1 based, goes from [1..Count] }
    property Frames[I: Integer]: TAniFrame read GetFrame; default;
  end;

  // --------------------------------------------------------------------------
  // Represents a location in a 2D coordinate system (integer coordinates)
  // --------------------------------------------------------------------------

type
  TRnQBitmap = class
  protected
    fHI: HICON;
    FNumFrames: Integer;
    FCurrentFrame: Integer;
    FNumIterations: Integer;

    fFrames: TAniFrameList;

    WasDisposal: TAniDisposalType;
    CurrentIteration: Integer;
    LastTime: DWord;
    CurrentInterval: DWord;
  public
    fBmp: TBitmap;
    htMask: TBitmap;
    htTransparent: boolean; // is Has Mask
    fTransparentColor: COLORREF;
    f32Alpha: boolean;
    fFormat: TPAFormat;
    fWidth: Integer;
    fHeight: Integer;
  private
    fAnimated: boolean;
    procedure SetCurrentFrame(AFrame: Integer);
    procedure NextFrame(OldFrame: Integer);
  public
    constructor Create; overload;
    constructor Create(Width, Heigth: Integer); Overload;
    constructor Create(const fn: String); Overload;
    constructor Create(hi: HICON); Overload;
    destructor Destroy; override;
    procedure Clear;
    procedure MakeEmpty;

    procedure MaskDraw(DC: HDC; const DestBnd, SrcBnd: TGPRect); Overload;
    procedure MaskDraw(DC: HDC; const DX, DY: Integer); Overload;
    procedure Draw(DC: HDC; DX, DY: Integer); Overload;
    procedure Draw(DC: HDC; DestBnd, SrcBnd: TGPRect; pEnabled: boolean = True; isCopy32: boolean = false); Overload;
    procedure Draw(DC: HDC; DestR: TGPRect); Overload;
    function CloneAll: TRnQBitmap;
    function Clone(bnd: TGPRect): TRnQBitmap;
    function CloneFrame(frame: Integer): TRnQBitmap;
    procedure SetTransparentColor(clr: cardinal);
    function bmp2ico32: HICON;
    procedure GetHICON(var hi: HICON);
    function GetWidth: Integer; {$IFDEF HAS_INLINE}inline; {$ENDIF HAS_INLINE}
    function GetHeight: Integer; {$IFDEF HAS_INLINE}inline; {$ENDIF HAS_INLINE}
    function RnQCheckTime: boolean;
    property Animated: boolean read fAnimated;
    property NumFrames: Integer read FNumFrames;
    property Width: Integer read fWidth;
    property Height: Integer read fHeight;
    property CurrentFrame: Integer read FCurrentFrame write SetCurrentFrame;
  end;

  procedure DrawRbmp(DC: HDC; var bmp: TRnQBitmap; DestR, SrcR: TGPRect); overload; {$IFDEF HAS_INLINE}inline;{$ENDIF HAS_INLINE}
  procedure DrawRbmp(DC: HDC; var bmp: TRnQBitmap; DestR: TGPRect); overload; {$IFDEF HAS_INLINE}inline;  {$ENDIF HAS_INLINE}
  procedure DrawRbmp(var Canvas: TCanvas; var bmp: TRnQBitmap; DestR: TGPRect); overload; {$IFDEF HAS_INLINE}inline;  {$ENDIF HAS_INLINE}
  procedure DrawRbmp(DC: HDC; var bmp: TRnQBitmap); overload; {$IFDEF HAS_INLINE}inline; {$ENDIF HAS_INLINE}
  procedure DrawRbmp(DC: HDC; var bmp: TRnQBitmap; X, Y: Integer); overload; {$IFDEF HAS_INLINE}inline;{$ENDIF HAS_INLINE}
  procedure DrawRbmp(DC: HDC; var bmp: TRnQBitmap; DestR, SrcR: TGPRect; pEnabled: boolean = True; IsCopy: boolean = false); overload; {$IFDEF HAS_INLINE}inline;{$ENDIF HAS_INLINE}
  function LoadPic(const fn: String; var bmp: TRnQBitmap; idx: Integer = 0): Boolean; overload;
  function LoadPic(var str: TStream; var bmp: TRnQBitmap; idx: Integer = 0; ff: TPAFormat = PA_FORMAT_UNK): Boolean; overload;
  function LoadPic(pt: TThemeSourcePath; const fn: String; var bmp: TRnQBitmap; idx: Integer = 0): Boolean; overload;
  function LoadPic2(const fn: string; var bmp: TRnQBitmap): boolean; // if not loaded then bmp is nil!
  function GetImageDimensions(Bytes: TBytes): TPair;

  function IsSupportedPicFile(fn: String): Boolean;
  function getSupPicExts: String;
  function DetectFileFormatStream(str: TStream): TPAFormat;
  procedure StretchPic(var bmp: TBitmap; maxH, maxW: Integer); overload;
  procedure StretchPic(var bmp: TRnQBitmap; maxH, maxW: Integer); overload;
  procedure SmoothRotate(var Src, Dst: TBitmap; cx, cy: Integer; Angle: Extended);

  procedure FillGradient(DC: HDC; ARect: TRect; // ColorCount: Integer;
  StartColor, EndColor: cardinal; ADirection: TGradientDirection; Alpha: Byte = $FF);
  function WinGradientFill(DC: HDC; Vertex: PTriVertex; NumVertex: ULONG; Mesh: Pointer; NumMesh, Mode: ULONG): BOOL; stdcall;
  procedure FillRoundRectangle(DC: HDC; ARect: TRect; clr: cardinal);
  procedure DrawTextTransparent(DC: HDC; X, Y: Integer; const Text: String; Font: TFont; Alpha: Byte; fmt: Integer);
//  procedure DrawText32(DC: HDC; TextRect: TRect; const Text: String; Font: TFont; TextFlags: cardinal);
  function wbmp2bmp(Stream: TStream; var pic: TBitmap; CalcOnly: boolean = false): TSize; overload;
  function wbmp2bmp(Stream: TStream; var pic: TBitmap32; CalcOnly: boolean = false): TSize; overload;

  function createBitmap(DX, DY: Integer): TBitmap; overload;
  function createBitmap(cnv: Tcanvas): TBitmap; overload;

// Color
type
  Thls = record
    h, l, s: double;
  end; // H=[0,6] L=[0,1] S=[0,1]

  function gpColorFromAlphaColor(Alpha: Byte; Color: TColor): cardinal;
  function color2hls(clr: TColor): Thls;
  function hls2color(hls: Thls): TColor;
  function addLuminosity(clr: TColor; q: real): TColor;
  function MidColor(clr1, clr2: cardinal): cardinal; overLoad;
  function MidColor(const clr1, clr2: cardinal; koef: double): cardinal; overLoad;
  function blend(c1, c2: TColor; left: real): TColor;

  // convert
  function pic2ico(pic: TBitmap): Ticon;
  function bmp2ico2(bitmap: TBitmap): Ticon;
  function bmp2ico3(bitmap: TBitmap): Ticon;
  function bmp2ico4M(bitmap: TBitmap): HICON;
  function bmp2ico32(bitmap: TBitmap): HICON;
  function bmp2ico(bitmap: TBitmap): Ticon;
  procedure ico2bmp(ico: Ticon; bmp: TBitmap);
  procedure ico2bmp2(pIcon: HICON; bmp: TBitmap);

type
  TRnQAni = TRnQBitmap;

//  function CreateAni(const fn: String; var b: boolean): TRnQBitmap; {$IFDEF HAS_INLINE} inline; {$ENDIF HAS_INLINE} overload;
//  function CreateAni(fs: TStream; var b: boolean): TRnQBitmap; {$IFDEF HAS_INLINE} inline; {$ENDIF HAS_INLINE} overload;
  function LoadAGifFromStream(var NonAnimated: boolean; Stream: TStream): TRnQBitmap;
  procedure LoadPictureStream(str: TStream; var gpPicture: IPicture);
  procedure ConvertToRGBA(var png: TPNGImage);
  function Bitmap32ToPNG(bmp: TBitmap32): TPNGImage;
//  procedure ResampleSticker(var bmp: TBitmap; MaxStickerHeight: Integer; MaxStickerWidth: Integer);

type
  TRGB = record
    B, G, R : Byte;
  end;
  ARGB = array [0..32677] of TRGB;
  PARGB = ^ARGB;
  PRGB = ^TRGB;
  PARGBArray = array of PARGB;
  TRGB32 = record
    B, G, R, L : byte;
  end;
  ARGB32 = array [0..32677] of TRGB32;
  PARGB32 = ^ARGB32;
  PRGB32 = ^TRGB32;
  PARGB32Array = array of PARGB32;

  procedure ResampleProportional(var Stream: TMemoryStream; MaxWidth, MaxHeight: Integer); overload;

const
  icon_size = 16;

var
  MaxChatImgWidthVal, MaxChatImgHeightVal: Integer;
  LimitMaxChatImgWidth, LimitMaxChatImgHeight: Boolean;

implementation

uses
  Winapi.MMSystem, System.Math, System.UITypes,
{$IFDEF UNICODE}
  System.AnsiStrings,
{$ENDIF UNICODE}
  Winapi.CommCtrl,
  litegif1, uIconStream;

const
  JPEG_HDRS: array [0 .. 6] of AnsiString = (
    #$FF#$D8#$FF#$E0,
    #$FF#$D8#$FF#$E1,
    #$FF#$D8#$FF#$ED, {ADOBE}
    #$FF#$D8#$FF#$E2, {CANON}
    #$FF#$D8#$FF#$E3,
    #$FF#$D8#$FF#$DB, {SAMSUNG}
    #$FF#$D8#$FF#$FE {UNKNOWN});
  ICON: array [0 .. 3] of AnsiChar = #$00#$00#$01#$00;
  TIF: array [0 .. 3] of AnsiChar = #$49#$49#$2A#$00;
//  WEBP: array [0 .. 3] of AnsiChar = #$52#$49#$46#$46;

const
  IID_IPicture: TGUID = '{7BF80980-BF32-101A-8BBB-00AA00300CAB}';

type
  TBitmapWithDimens = record
    width: Integer;
    height: Integer;
    bmp: TBitmap;
  end;

var
  supExts: array [0 .. 9] of string = ('bmp', 'wbmp', 'wbm', 'ico', 'icon', 'gif', 'png', 'jpg', 'jpe', 'jpeg');
  // , 'tif', 'dll')
  ThePalette: HPalette; { the rainbow palette for 256 colors }

{ ----------------TAniFrame.Create }

constructor TAniFrame.Create;
begin
  inherited Create;
end;

constructor TAniFrame.CreateCopy(Item: TAniFrame);
begin
  inherited Create;
  System.Move(Item.frLeft, frLeft, DWord(@TheEnd) - DWord(@frLeft));
  IsCopy := True;
end;

{ ----------------TAniFrame.Destroy }
{
  destructor TAniFrame.Destroy;
  begin
  inherited Destroy;
  end; }

{ ----------------TAniFrameList.GetFrame }

function TAniFrameList.GetFrame(I: Integer): TAniFrame;
begin
  Assert((I <= Count) and (I >= 1), 'Frame index out of range');
  Result := TAniFrame(Items[I - 1]);
end;

destructor TRnQBitmap.Destroy;
var
  I: Integer;
begin
  FreeAndNil(fBmp);
  FreeAndNil(htMask);
  if fHI > 0 then
    DestroyIcon(fHI);
  if Assigned(fFrames) then
  begin
    for I := 1 to fFrames.Count do
      fFrames[I].Free;
    fFrames.Clear;
    FreeAndNil(fFrames);
  end;
  inherited;
end;

constructor TRnQBitmap.Create;
begin
  fBmp := nil;
  htMask := nil;
  htTransparent := false;
  fHI := 0;
  f32Alpha := false;
  fFormat := PA_FORMAT_UNK;

  fAnimated := false;
  FCurrentFrame := 1;
  fFrames := nil;
  FNumFrames := 0;
  CurrentIteration := 1;
end;

procedure TRnQBitmap.Clear;
begin
  FreeAndNil(fBmp);
  FreeAndNil(htMask);
  htTransparent := false;
  if fHI > 0 then
    DestroyIcon(fHI);
  fHI := 0;
  f32Alpha := false;
  fFormat := PA_FORMAT_UNK;
end;

constructor TRnQBitmap.Create(Width, Heigth: Integer);
begin
  Create;
  fBmp := TBitmap.Create;
  fBmp.PixelFormat := pf32bit;
  fBmp.SetSize(Width, Heigth);
  fWidth := Width;
  fHeight := Heigth;
end;

constructor TRnQBitmap.Create(hi: HICON);
begin
  Create;
  fHI := CopyIcon(hi);
  fWidth := icon_size;
  fHeight := icon_size;
end;

constructor TRnQBitmap.Create(const fn: String);
begin
  Create;
  LoadPic(fn, Self);
end;

function TRnQBitmap.GetWidth: Integer;
begin
  Result := fWidth;
end;

function TRnQBitmap.GetHeight: Integer;
begin
  Result := fHeight;
end;

procedure LoadPictureStream(str: TStream; var gpPicture: IPicture);
var
  stra: TStreamAdapter;
  dwFileSize: DWord;
begin
  str.Position := 0;
  stra := TStreamAdapter.Create(str);
  dwFileSize := str.Size;
  try
    if Assigned(gpPicture) then
      gpPicture := nil;
    OleLoadPicture(stra, dwFileSize, false, IID_IPicture, gpPicture)
  except end;
end;

function LoadPic2(const fn: string; var bmp: TRnQBitmap): boolean;
begin
  Result := LoadPic(fn, bmp);
  if not Result then
    FreeAndNil(bmp);
end;

function LoadPic(const fn: String; var bmp: TRnQBitmap; idx: Integer = 0): Boolean;
var
  Stream: TStream;
  ff: TPAFormat;
  pic: TPicture;
begin
  Result := FileExists(fn);
  if not Assigned(bmp) then
    if not Result then
      Exit
    else
      bmp := TRnQBitmap.Create
  else
    bmp.Clear;
  if not Result then
    Exit;
  if (LowerCase(ExtractFileExt(fn)) = '.ico') or (LowerCase(ExtractFileExt(fn)) = '.icon') then
    ff := PA_FORMAT_ICO
  else if (LowerCase(ExtractFileExt(fn)) = '.swf') then
  begin
    Result := false;
    Exit;
  end else
    ff := PA_FORMAT_UNK;

  Stream := TFileStream.Create(fn, fmOpenRead or fmShareDenyWrite);
  try
    Result := LoadPic(Stream, bmp, idx, ff);
  finally
    if Assigned(Stream) then
      Stream.Free;
  end;

  if not Result then
  begin
    pic := TPicture.Create;
    try
      pic.LoadFromFile(fn);
    except
      FreeAndNil(pic);
    end;
    if Assigned(pic) then
    begin
      bmp.fBmp := TBitmap.Create;
      try
        bmp.fBmp.Assign(pic.Graphic);
        bmp.fWidth := bmp.fBmp.Width;
        bmp.fHeight := bmp.fBmp.Height;
        bmp.fTransparentColor := ColorToRGB(bmp.fBmp.TransparentColor);
        Result := True;
      except
        bmp.Free;
        bmp := NIL;
        Result := false;
      end;
    end;
    FreeAndNil(pic);
  end;
end;

function GetLastErrorText: string;
var
  C: array [Byte] of Char;
begin

  FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, nil, GetLastError, LOCALE_USER_DEFAULT, C, SizeOf(C), nil);
  Result := StrPas(C);
end;

function LoadIconFromStream(str: TStream): HICON;
var
  icn: Ticon;
begin
  icn := Ticon.Create;
  icn.LoadFromStream(str);
  Result := CopyIcon(icn.Handle);
  icn.Free;
end;

procedure ConvertToRGBA(var png: TPNGImage);
var
  tmp: TPNGImage;
  tRNS: TChunktRNS;
  PLTE: TChunkPLTE;
  dst: pRGBLine;
  src, alpha: Vcl.Imaging.PNGImage.pByteArray;
  x, y: integer;
  i: byte;
begin
  tmp := TPNGImage.CreateBlank(COLOR_RGBALPHA, 8, png.Width, png.Height);
  case png.Header.ColorType of
    COLOR_PALETTE:
    begin
      tRNS := png.Chunks.ItemFromClass(TChunktRNS) as TChunktRNS;
      PLTE := png.Chunks.ItemFromClass(TChunkPLTE) as TChunkPLTE;
      for y := 0 to png.Height - 1 do begin
        dst := tmp.Scanline[y];
        src := png.Scanline[y];
        alpha := tmp.AlphaScanline[y];
        for x := 0 to png.Width - 1 do begin
          case png.Header.BitDepth of
            8: i := src[x];
            2,4: i := src[x div 2] shr ((1-(x mod 2))*4) and $0F;
            1: i := src[x div 8] shr (7-(x mod 8)) and 1;
          end;
          dst[x].rgbtBlue := PLTE.Item[i].rgbBlue;
          dst[x].rgbtGreen := PLTE.Item[i].rgbGreen;
          dst[x].rgbtRed := PLTE.Item[i].rgbRed;
          if tRNS <> nil then alpha[x] := tRNS.PaletteValues[i] else alpha[x] := 255;
        end;
      end;
    end;

    COLOR_GRAYSCALE:
    begin
      for y := 0 to png.Height - 1 do begin
        dst := tmp.Scanline[y];
        src := png.Scanline[y];
        alpha := tmp.AlphaScanline[y];
        for x := 0 to png.Width - 1 do begin
          case png.Header.BitDepth of
            8: i := src[x];
            2,4: i := (src[x div 2] shr ((1-(x mod 2))*4) and $0F) * 17;
            1: i := (src[x div 8] shr (7-(x mod 8)) and 1) * 255;
          end;
          dst[x].rgbtBlue := i;
          dst[x].rgbtGreen := i;
          dst[x].rgbtRed := i;
          alpha[x] := 255;
        end;
      end;
    end;

    COLOR_RGB:
    begin
      BitBlt(tmp.Canvas.Handle, 0, 0, tmp.Width,tmp.Height, png.Canvas.Handle, 0, 0, SRCCOPY);
      for y := 0 to png.Height - 1 do
        FillChar(tmp.AlphaScanline[y]^, png.Width, 255);
    end;

    COLOR_GRAYSCALEALPHA:
    begin
      BitBlt(tmp.Canvas.Handle, 0, 0, tmp.Width,tmp.Height, png.Canvas.Handle, 0, 0, SRCCOPY);
      for y := 0 to png.Height - 1 do
        Move(png.AlphaScanline[y]^, tmp.AlphaScanline[y]^, png.Width);
    end;

    else tmp.Assign(png);
  end;
  png.Free;
  png := tmp;
end;

function Bitmap32ToPNG(bmp: TBitmap32): TPNGImage;
var
  X, Y: integer;
  BmpRGBA: GR32.PColor32Array;
  PngRGB: PRGB;
begin
  Result := TPNGImage.CreateBlank(COLOR_RGBALPHA, 8, bmp.Width , bmp.Height);

  Result.CreateAlpha;
  Result.Canvas.CopyMode:= cmSrcCopy;
  bmp.DrawTo(Result.Canvas.Handle);

  for Y := 0 to Pred(bmp.Height) do
  begin
    BmpRGBA := bmp.ScanLine[Y];
    PngRGB := Result.Scanline[Y];

    for X := 0 to Pred(bmp.Width) do
    begin
      Result.AlphaScanline[Y][X] := AlphaComponent(BmpRGBA^[X]);
      if AlphaComponent(BmpRGBA[X]) <> 0 then
      begin
        PngRGB^.B := Round(BlueComponent(BmpRGBA[X]) / AlphaComponent(BmpRGBA[X]) * 255);
        PngRGB^.R := Round(RedComponent(BmpRGBA[X]) / AlphaComponent(BmpRGBA[X]) * 255);
        PngRGB^.G := Round(GreenComponent(BmpRGBA[X]) / AlphaComponent(BmpRGBA[X]) * 255);
      end
        else
      begin
        PngRGB^.B := Round(BlueComponent(BmpRGBA[X]) * 255);
        PngRGB^.R := Round(RedComponent(BmpRGBA[X]) * 255);
        PngRGB^.G := Round(GreenComponent(BmpRGBA[X]) * 255);
      end;
      Inc(PngRGB);
    end;
  end;
end;

//procedure AddFilter(bmpOrig: TBitmap32; Kernel: TCustomKernel);
//var
//  Resampler: TKernelResampler;
//begin
//  Resampler := TKernelResampler.Create(bmpOrig);
//  Resampler.Kernel := Kernel;
//  Resampler.KernelMode := kmDynamic;
//end;

function GetBPP(bmp: TBitmap): Integer;
begin
  case (bmp.PixelFormat) of
    pf1bit: Result := 1;
    pf4bit: Result := 4;
    pf8bit: Result := 8;
    pf15bit: Result := 15;
    pf16bit: Result := 16;
    pf24bit: Result := 24;
    pf32bit: Result := 32;
    else Result := 0;
  end;
end;

//procedure ApplyFilter(var bmp: TBitmap; var bmpOrig: TBitmap32);
//begin
//  if (bmp.Width * bmp.Height * GetBPP(bmp) / 8 > 5 * 1024 * 1024) then
//    TDraftResampler.Create(bmpOrig)
//  else
//    AddFilter(bmpOrig, TCosineKernel.Create)
//end;

//procedure ResampleProportional(var bmp: TBitmap); overload;
//var
//  Aspect: single;
//  NewWidth, NewHeight: Integer;
//  bmpOrig, bmp32: TBitmap32;
//begin
//  if (bmp.Width = 0) or (bmp.Height = 0) then
//    Exit;
//
//  Aspect := bmp.Width / bmp.Height;
//  NewWidth := bmp.Width;
//  NewHeight := bmp.Height;
//
//  if (LimitMaxChatImgHeight) and (NewHeight > MaxChatImgHeightVal) then
//  begin
//    NewHeight := MaxChatImgHeightVal;
//    NewWidth := round(NewHeight * Aspect);
//  end;
//
//  if (LimitMaxChatImgWidth) and (NewWidth > MaxChatImgWidthVal) then
//  begin
//    NewWidth := MaxChatImgWidthVal;
//    NewHeight := round(NewWidth / Aspect);
//  end;
//
//  if (bmp.Width <> NewWidth) or (bmp.Height <> NewHeight) then
//  begin
//    bmpOrig := TBitmap32.Create;
//    bmpOrig.Assign(bmp);
//
//    bmp32 := TBitmap32.Create;
//    bmp32.Width := NewWidth;
//    bmp32.Height := NewHeight;
//
//    if bmp.Transparent then
//    begin
//      bmpOrig.DrawMode := dmBlend;
//      bmpOrig.CombineMode := cmBlend;
//      bmp32.DrawMode := dmBlend;
//      bmp32.CombineMode := cmBlend;
//    end;
//
//    ApplyFilter(bmp, bmpOrig);
//
//    bmp32.Draw(bmp32.BoundsRect, bmpOrig.BoundsRect, bmpOrig);
//    bmp.Assign(bmp32);
//    bmpOrig.Free;
//    bmp32.Free;
//  end
//end;

//procedure ResampleProportional(var bmp: TBitmap; MaxWidth, MaxHeight: Integer); overload;
//var
//  Aspect: Single;
//  NewWidth, NewHeight: Integer;
//  bmpOrig, bmp32: TBitmap32;
//begin
//  if (bmp.Width = 0) or (bmp.Height = 0) then
//    Exit;
//
//  Aspect := bmp.Width / bmp.Height;
//  NewWidth := bmp.Width;
//  NewHeight := bmp.Height;
//
//  if NewHeight > MaxHeight then
//  begin
//    NewHeight := MaxHeight;
//    NewWidth := Round(NewHeight * Aspect);
//  end;
//
//  if NewWidth > MaxWidth then
//  begin
//    NewWidth := MaxWidth;
//    NewHeight := Round(NewWidth / Aspect);
//  end;
//
//  if (bmp.Width <> NewWidth) or (bmp.Height <> NewHeight) then
//  begin
//    bmpOrig := TBitmap32.Create;
//    bmpOrig.Assign(bmp);
//
//    bmp32 := TBitmap32.Create;
//    bmp32.Width := NewWidth;
//    bmp32.Height := NewHeight;
//
//    if bmp.Transparent then
//    begin
//      bmpOrig.DrawMode := dmBlend;
//      bmpOrig.CombineMode := cmBlend;
//      bmp32.DrawMode := dmBlend;
//      bmp32.CombineMode := cmBlend;
//    end;
//
//    TDraftResampler.Create(bmpOrig);
//    bmp32.Draw(bmp32.BoundsRect, bmpOrig.BoundsRect, bmpOrig);
//    bmp.Assign(bmp32);
//    bmpOrig.Free;
//    bmp32.Free;
//  end
//end;

procedure ResampleProportional(var bmp: TBitmap; MaxWidth, MaxHeight: Integer); overload;
var
  Stream: TMemoryStream;
begin
  if (bmp.Width = 0) or (bmp.Height = 0) then
    Exit;

  Stream := TMemoryStream.Create;
  bmp.SaveToStream(Stream);
  Stream.Position := 0;
  ResampleProportional(Stream, MaxWidth, MaxHeight);
  bmp.LoadFromStream(Stream);
  Stream.Free;
end;

procedure ResampleProportional(var Stream: TMemoryStream; MaxWidth, MaxHeight: Integer); overload;
var
  Factory: IWICImagingFactory;
  Scaler: IWICBitmapScaler;
  Source: TWICImage;
  Aspect: Single;
  NewWidth, NewHeight: Integer;
begin
  try
    Source := TWICImage.Create;
    Source.LoadFromStream(Stream);
  except
    Exit;
  end;

  Aspect := Source.Width / Source.Height;
  NewWidth := Source.Width;
  NewHeight := Source.Height;

  if NewHeight > MaxHeight then
  begin
    NewHeight := MaxHeight;
    NewWidth := Round(NewHeight * Aspect);
  end;

  if NewWidth > MaxWidth then
  begin
    NewWidth := MaxWidth;
    NewHeight := Round(NewWidth / Aspect);
  end;

  if (Source.Width <> NewWidth) or (Source.Height <> NewHeight) then
  try
    Factory := TWICImage.ImagingFactory;
    Factory.CreateBitmapScaler(Scaler);
    Scaler.Initialize(Source.Handle, NewWidth, NewHeight, RDUtils.IfThen(TOSVersion.Check(10), 4, WICBitmapInterpolationModeFant));
    Source.Handle := IWICBitmap(Scaler);
    Stream.Clear;
    Source.SaveToStream(Stream);
    Stream.Seek(0, soBeginning);
    Scaler := nil;
    Factory := nil;
  except end;
  FreeAndNil(Source);
end;

//procedure ResampleSticker(var bmp: TBitmap; MaxStickerHeight: Integer; MaxStickerWidth: Integer);
//var
//  Aspect: single;
//  bmpOrig, bmp32: TBitmap32;
//  NewWidth, NewHeight: Integer;
//begin
//  if (bmp.Width = 0) or (bmp.Height = 0) then
//    Exit;
//
//  Aspect := bmp.Width / bmp.Height;
//
//  NewWidth := bmp.Width;
//  NewHeight := bmp.Height;
//
//  if NewHeight > MaxStickerHeight then
//  begin
//    NewHeight := MaxStickerHeight;
//    NewWidth := round(NewHeight * Aspect);
//  end;
//
//  if NewWidth > MaxStickerWidth then
//  begin
//    NewWidth := MaxStickerWidth;
//    NewHeight := round(NewWidth / Aspect);
//  end;
//
//  if (bmp.Width <> NewWidth) or (bmp.Height <> NewHeight) then
//  begin
//    bmpOrig := TBitmap32.Create;
//    bmpOrig.Assign(bmp);
//
//    bmp32 := TBitmap32.Create;
//    bmp32.Width := NewWidth;
//    bmp32.Height := NewHeight;
//
//    if bmp.Transparent then
//    begin
//      bmpOrig.DrawMode := dmBlend;
//      bmpOrig.CombineMode := cmBlend;
//      bmp32.DrawMode := dmBlend;
//      bmp32.CombineMode := cmBlend;
//    end;
//
//    AddFilter(bmpOrig, TCosineKernel.Create);
//    bmp32.Draw(bmp32.BoundsRect, bmpOrig.BoundsRect, bmpOrig);
//    bmp.Assign(bmp32);
//    bmpOrig.Free;
//    bmp32.Free;
//  end
//end;

function LoadPic(var str: TStream; var bmp: TRnQBitmap; idx: Integer = 0; ff: TPAFormat = PA_FORMAT_UNK): Boolean;
var
  png: TPNGImage;
  winimg: TWICImage;
//  resStr: TResourceStream;
  NonAnimated: boolean;
  pic: IPicture;
  A, b: Integer;
  h, w: Integer;
  R: TRect;

  vBmp: TBitmap;
  IcoStream: TIconStream;
  icn: Ticon;
begin
  Result := false;
  if not Assigned(str) then
    Exit;

  if ff = PA_FORMAT_UNK then
    ff := DetectFileFormatStream(str);

  str.Position := 0;

  case ff of
    PA_FORMAT_BMP:
      try
        // FreeAndNil(bmp);
        if not Assigned(bmp) then
          bmp := TRnQBitmap.Create
        else
          bmp.Clear;
        bmp.f32Alpha := false;
        bmp.fFormat := ff;
        bmp.fBmp := TBitmap.Create;
        bmp.fBmp.LoadFromStream(str);
//        if resample then
//          ResampleProportional(bmp.fBmp);
        bmp.fWidth := bmp.fBmp.Width;
        bmp.fHeight := bmp.fBmp.Height;
        bmp.fTransparentColor := ColorToRGB(bmp.fBmp.TransparentColor);
        FreeAndNil(str);
        Result := True;
      except end;

    PA_FORMAT_JPEG:
      begin
        str.Position := 0;
        vBmp := nil;
        try
          try
            LoadPictureStream(str, pic);
            if pic <> nil then
            begin
              // scr := CreateDC('DISPLAY', nil, nil, nil);
              pic.get_Width(A);
              pic.get_Height(b);

              vBmp := TBitmap.Create;
              vBmp.PixelFormat := pf24bit;
              // w := MulDiv(a, GetDeviceCaps(scr, LOGPIXELSX), 2540);
              // h := MulDiv(b, GetDeviceCaps(scr, LOGPIXELSY), 2540);
              w := MulDiv(A, GetDeviceCaps(vBmp.Canvas.Handle, LOGPIXELSX), 2540);
              h := MulDiv(b, GetDeviceCaps(vBmp.Canvas.Handle, LOGPIXELSY), 2540);
              // a := 50; b := 120;
              R.left := 0;
              R.Top := 0;
              R.Right := w;
              R.Bottom := h;
              vBmp.SetSize(w, h);
              pic.Render(vBmp.Canvas.Handle, 0, 0, w, h, 0, b, A, -b, R);
              pic := nil;
            end;
          finally
            FreeAndNil(str);
          end;
        except
          vBmp := nil;
        end;

        if Assigned(vBmp) then
        try
          if not Assigned(bmp) then
            bmp := TRnQBitmap.Create
          else
            bmp.Clear;
          bmp.f32Alpha := false;
          bmp.fFormat := ff;
          bmp.fBmp := TBitmap.Create;
          bmp.fBmp.Assign(vBmp);
          bmp.fBmp.Transparent := false;
//          if resample then
//            ResampleProportional(bmp.fBmp);
          bmp.fWidth := bmp.fBmp.Width;
          bmp.fHeight := bmp.fBmp.Height;
          Result := True;
          vBmp.Free;
        except end;
      end;

    PA_FORMAT_GIF:
      try
        // aniImg := CreateAni(str, NonAnimated);
        if Assigned(bmp) then
          bmp.Free;
        // else
        // bmp.Clear;
        bmp := LoadAGifFromStream(NonAnimated, str);
        // if Assigned(aniImg) and (aniImg.NumFrames > 0) then
        if Assigned(bmp) and (bmp.NumFrames > 0) then
        begin
          // bmp := TBitmap.Create;
          if (idx < 1) or (idx > bmp.NumFrames) then
            idx := 1;
          bmp.CurrentFrame := idx;
          bmp.fTransparentColor := ColorToRGB(bmp.fBmp.TransparentColor);
          bmp.fFormat := ff;
          str.Free;
          str := NIL;
          Result := True;
        end;
      except end;
    PA_FORMAT_PNG:
      try
        png := TPNGImage.Create;
        png.LoadFromStream(str);

        if not png.Empty then
        begin
          if (png.Header.ColorType = COLOR_PALETTE) then
            ConvertToRGBA(png);

          if not Assigned(bmp) then
            bmp := TRnQBitmap.Create
          else
            bmp.Clear;
          bmp.fFormat := ff;
          bmp.fBmp := TBitmap.Create;
          bmp.fBmp.Assign(png);

          if not (png.TransparencyMode = ptmNone) then
          begin
            bmp.f32Alpha := True;
            bmp.fBmp.PixelFormat := pf32bit;
            bmp.fBmp.AlphaFormat := afPremultiplied;
          end
            else
          begin
            bmp.f32Alpha := False;
            bmp.fBmp.PixelFormat := pf24bit;
            bmp.fBmp.AlphaFormat := afIgnored;
          end;

//          if resample then
//            ResampleProportional(bmp.fBmp);

          bmp.fTransparentColor := ColorToRGB(bmp.fBmp.TransparentColor);
          bmp.fWidth := bmp.fBmp.Width;
          bmp.fHeight := bmp.fBmp.Height;

          png.Free;
          FreeAndNil(str);
          Result := True;
        end;
      except end;
    PA_FORMAT_ICO:
      try
        if (idx < 1) then
          idx := 1;
        if idx > 1 then
        begin
          IcoStream := TIconStream.Create;
          IcoStream.LoadFromStream(str);
          if (idx < 1) or (idx > IcoStream.Count) then
            idx := 1;
          dec(idx);
          if not Assigned(bmp) then
            bmp := TRnQBitmap.Create
          else
            bmp.Clear;
          bmp.f32Alpha := false;
          bmp.fFormat := ff;
          bmp.fBmp := TBitmap.Create;
          bmp.fBmp.Height := IcoStream[idx].bHeight;
          bmp.fBmp.Width := IcoStream[idx].bWidth;
          // bmp.Canvas.Brush.Color:= clBtnFace;
          bmp.fBmp.Canvas.Brush.Color := $010101;
          bmp.fBmp.Canvas.FillRect(bmp.fBmp.Canvas.ClipRect);

          IcoStream.Draw(bmp.fBmp.Canvas.Handle, 0, 0, idx);
          bmp.SetTransparentColor($010101);
          bmp.fBmp.Transparent := True;
//          if resample then
//            ResampleProportional(bmp.fBmp);
          bmp.fWidth := bmp.fBmp.Width;
          bmp.fHeight := bmp.fBmp.Height;

          IcoStream.Free;
        end
        else
        begin
          if not Assigned(bmp) then
            bmp := TRnQBitmap.Create
          else
            bmp.Clear;

          bmp.f32Alpha := false;
          bmp.fFormat := ff;
          icn := TIcon.Create;
          icn.LoadFromStream(str);
          bmp.fWidth := icn.Width;
          bmp.fHeight := icn.Height;
          icn.Free;
          str.Position := 0;
          bmp.fHI := LoadIconFromStream(str);
          if bmp.fHI = 0 then
            FreeAndNil(bmp);
        end;
        FreeAndNil(str);
        if Assigned(bmp) then
          Result := True;
      except end;
    PA_FORMAT_TIF:
      try
        winimg := TWICImage.Create;
        winimg.LoadFromStream(str);
        if not winimg.empty then
        begin
          if not Assigned(bmp) then
            bmp := TRnQBitmap.Create
          else
            bmp.Clear;
          bmp.f32Alpha := false;
          bmp.fFormat := ff;
          bmp.fBmp := TBitmap.Create;
          bmp.fBmp.PixelFormat := pf24bit;
          bmp.fBmp.Assign(winimg);
//          if resample then
//            ResampleProportional(bmp.fBmp);
          bmp.fWidth := bmp.fBmp.Width;
          bmp.fHeight := bmp.fBmp.Height;

          winimg.Free;
          FreeAndNil(str);
          Result := True;
        end;
      except end;
{    PA_FORMAT_WEBP:
      try
        winimg := TWICImage.Create;
        winimg.LoadFromStream(str);
        if not winimg.empty then
        begin
          if not Assigned(bmp) then
            bmp := TRnQBitmap.Create
          else
            bmp.Clear;
          bmp.fFormat := ff;
          bmp.fBmp := TBitmap.Create;
          bmp.fBmp.Assign(winimg);
          bmp.f32Alpha := True;
          bmp.fBmp.PixelFormat := pf32bit;
          bmp.fBmp.AlphaFormat := afPremultiplied;

          if resample then
            ResampleProportional(bmp.fBmp);
          bmp.fWidth := bmp.fBmp.Width;
          bmp.fHeight := bmp.fBmp.Height;

          winimg.Free;
          FreeAndNil(str);
          Result := True;
        end;
      except
        try
          png := TPNGImage.Create;
          resStr := TResourceStream.Create(HInstance, 'NOWEBP', RT_RCDATA);
          png.LoadFromStream(resStr);
          if not png.empty then
          begin
            if not Assigned(bmp) then
              bmp := TRnQBitmap.Create
            else
              bmp.Clear;
            bmp.f32Alpha := false;
            bmp.fFormat := ff;
            bmp.fBmp := TBitmap.Create;
            bmp.fBmp.PixelFormat := pf32bit;
            bmp.fBmp.AlphaFormat := afPremultiplied;
            bmp.fBmp.Assign(png);
            bmp.f32Alpha := True;

            bmp.fTransparentColor := ColorToRGB(bmp.fBmp.TransparentColor);
            bmp.fWidth := bmp.fBmp.Width;
            bmp.fHeight := bmp.fBmp.Height;

            png.Free;
            FreeAndNil(str);
            Result := True;
          end;
        except end;
      end;
}
    // PA_FORMAT_XML: ;
    // PA_FORMAT_SWF: ;
    // PA_FORMAT_UNK: ;
  else
    begin
      // msgDlg(gettrans 'Can''t load picture from stream "%s"');
      Result := false;
    end;
  end;
end;

function GetImageDimensions(Bytes: TBytes): TPair;
var
  BMP: TBitmap;
  PNG: TPNGImage;
  WIC: TWICImage;
  Format: TPAFormat;
  MemStr: TMemoryStream;
begin
  Result.Key := 0;
  Result.Value := 0;

  if not Assigned(Bytes) then
    Exit;

  MemStr := TMemoryStream.Create;
  MemStr.WriteBuffer(Bytes[0], Length(Bytes));
  Format := DetectFileFormatStream(MemStr);
  MemStr.Position := 0;

  case Format of
    PA_FORMAT_BMP:
    begin
      BMP := TBitmap.Create;
      BMP.LoadFromStream(MemStr);
      Result.Key := BMP.Width;
      Result.Value := BMP.Height;
      BMP.Free;
    end;

    PA_FORMAT_PNG:
    begin
      PNG := TPNGImage.Create;
      PNG.LoadFromStream(MemStr);
      Result.Key := PNG.Width;
      Result.Value := PNG.Height;
      PNG.Free;
    end;

    else
    begin
      WIC := TWICImage.Create;
      WIC.LoadFromStream(MemStr);
      if not WIC.Empty then
      begin
        Result.Key := WIC.Width;
        Result.Value := WIC.Height;
      end;
      WIC.Free;
    end;
  end;

  MemStr.Free;
end;

function LoadPic(pt: TThemeSourcePath; const fn: String; var bmp: TRnQBitmap; idx: Integer = 0): Boolean;
  function fullpath(const fn: string): string;
  begin
    if ansipos(':', fn) = 0 then
      Result := pt.path + fn
    else
      Result := fn
  end;

var
  Stream: TMemoryStream;
  ff: TPAFormat;
begin
  // result := false;
  Stream := nil;
  Result := loadFile(pt, fn, TStream(Stream));
  ff := PA_FORMAT_UNK;
  if (LowerCase(ExtractFileExt(fn)) = '.ico') or (LowerCase(ExtractFileExt(fn)) = '.icon') then
    ff := PA_FORMAT_ICO;
  if Result then
    Result := LoadPic(TStream(Stream), bmp, idx, ff);
  if not Result then
    if Assigned(Stream) then
      Stream.Free;
end;

procedure TRnQBitmap.SetTransparentColor(clr: cardinal);
begin
  fBmp.TransparentColor := clr;
  fTransparentColor := clr;
end;

procedure TRnQBitmap.MaskDraw(DC: HDC; const DestBnd, SrcBnd: TGPRect);
{ Draw parts of this bitmap on ACanvas }
var
  OldPalette, myPalette: HPalette;
  RestorePalette: boolean;
  DoHalftone: boolean;
  pt: TPoint;
  BPP: Integer;
  MyDC: HDC;
begin
  // with DestBnd do
  begin
    // AHandle := dc;  {LDB}
    myPalette := fBmp.Palette;
    // PaletteNeeded;
    OldPalette := 0;
    RestorePalette := false;

    if myPalette <> 0 then
    begin
      OldPalette := SelectPalette(DC, myPalette, True);
      RealizePalette(DC);
      RestorePalette := True;
    end;
    BPP := GetDeviceCaps(DC, BITSPIXEL) * GetDeviceCaps(DC, PLANES);
    DoHalftone := (BPP <= 8) and (fBmp.PixelFormat in [pf15bit, pf16bit, pf24bit]);
    if DoHalftone then
    begin
      GetBrushOrgEx(DC, pt);
      SetStretchBltMode(DC, HALFTONE);
      SetBrushOrgEx(DC, pt.X, pt.Y, @pt);
    end
    else if not fBmp.Monochrome then
      SetStretchBltMode(DC, STRETCH_DELETESCANS);
    // SetStretchBltMode(dc, HALFTONE);
    try
      // AHandle := dc;   {LDB}
      MyDC := fBmp.Canvas.Handle;
      if htTransparent then
        TransparentStretchBlt(DC, DestBnd.X, DestBnd.Y, DestBnd.Width, DestBnd.Height, MyDC, SrcBnd.X, SrcBnd.Y, SrcBnd.Width,
          SrcBnd.Height, htMask.Canvas.Handle, SrcBnd.X, SrcBnd.Y) { LDB }
      else
        StretchBlt(DC, DestBnd.X, DestBnd.Y, DestBnd.Width, DestBnd.Height, MyDC, SrcBnd.X, SrcBnd.Y, SrcBnd.Width,
          SrcBnd.Height, SRCCOPY);
    finally
      if RestorePalette then
        SelectPalette(DC, OldPalette, True);
    end;
  end;
end;

procedure TRnQBitmap.MakeEmpty;
var
  hbr: HBRUSH;
begin
  if Assigned(fBmp) then
  begin
    fBmp.TransparentMode := tmAuto;
    fBmp.Transparent := True;
    // loadedpic.fTransparentColor := loadedpic.fBmp.TransparentColor;
    fTransparentColor := ColorToRGB(fBmp.TransparentColor);
    hbr := CreateSolidBrush(fTransparentColor);
    FillRect(fBmp.Canvas.Handle, fBmp.Canvas.ClipRect, hbr);
    DeleteObject(hbr);
  end;
end;

procedure TRnQBitmap.MaskDraw(DC: HDC; const DX, DY: Integer);
{ Draw parts of this bitmap on ACanvas }
var
  OldPalette, myPalette: HPalette;
  RestorePalette: boolean;
  DoHalftone: boolean;
  pt: TPoint;
  BPP: Integer;
begin
  // with DestRect do
  begin
    // AHandle := dc;  {LDB}
    myPalette := fBmp.Palette;
    // PaletteNeeded;
    OldPalette := 0;
    RestorePalette := false;

    if myPalette <> 0 then
    begin
      OldPalette := SelectPalette(DC, myPalette, True);
      RealizePalette(DC);
      RestorePalette := True;
    end;
    BPP := GetDeviceCaps(DC, BITSPIXEL) * GetDeviceCaps(DC, PLANES);
    DoHalftone := (BPP <= 8) and (fBmp.PixelFormat in [pf15bit, pf16bit, pf24bit]);
    if DoHalftone then
    begin
      GetBrushOrgEx(DC, pt);
      SetStretchBltMode(DC, HALFTONE);
      SetBrushOrgEx(DC, pt.X, pt.Y, @pt);
    end
    else if not fBmp.Monochrome then
      SetStretchBltMode(DC, STRETCH_DELETESCANS);
    try
      // AHandle := dc;   {LDB}
      if htTransparent then
        TransparentStretchBlt(DC, DX, DY, fWidth, fHeight, fBmp.Canvas.Handle, 0, 0, fWidth, fHeight, htMask.Canvas.Handle, 0,
          0) { LDB }
      else
        BitBlt(DC, DX, DY, fWidth, fHeight, fBmp.Canvas.Handle, 0, 0, SRCCOPY);

      // StretchBlt(dc, Left, Top, Right - Left, Bottom - Top,
      // fBmp.Canvas.Handle,
      // SrcRect.Left, SrcRect.Top, SrcRect.Right - SrcRect.Left, SrcRect.Bottom - SrcRect.Top,
      // SRCCOPY);
    finally
      if RestorePalette then
        SelectPalette(DC, OldPalette, True);
    end;
  end;
end;

// procedure TRnQBitmap.Draw(DC: HDC; DestR : TRect; SrcX, SrcY, SrcW, SrcH : Integer; pEnabled : Boolean= True; isCopy : Boolean= false);
procedure TRnQBitmap.Draw(DC: HDC; DestBnd, SrcBnd: TGPRect; pEnabled: boolean = True; isCopy32: boolean = false);
var
  blend: BLENDFUNCTION;
  // hBMP: HDC;
  ico: HICON;
  LeftTop: TGPPoint;
  // p : TPoint;
begin
  if fAnimated then
  begin
    with fFrames[FCurrentFrame] do
    begin
      (* LeftTop.X := SrcX+ (FCurrentFrame-1)*Width;
        //         SRect := Rect(ALeft, 0, ALeft+Width, Height); {current frame location in Strip bitmap}
        //         FStretchedRect := Rect(X, Y, X+Width, Y+Height);
        LeftTop.Y := SrcY;
      *)
      LeftTop := SrcBnd.TopLeft;
      // inc(LeftTop.X, (FCurrentFrame-1)*Width);
      inc(LeftTop.Y, (FCurrentFrame - 1) * Height);
    end;
  end
  else
  begin
    // LeftTop.X := SrcX;
    // LeftTop.Y := SrcY;
    LeftTop := SrcBnd.TopLeft;
  end;
  if Assigned(fBmp) and not (fBmp.Handle = 0) and fBmp.HandleAllocated then
  begin
    if f32Alpha then
    begin
      if not isCopy32 then
        blend.AlphaFormat := AC_SRC_ALPHA
      else
        blend.AlphaFormat := AC_SRC_OVER;
      blend.BlendOp := AC_SRC_OVER;

      blend.BlendFlags := 0;
      if not pEnabled then
        blend.SourceConstantAlpha := 150
      else
        blend.SourceConstantAlpha := $FF;

      // StretchDIBits(DC,DX,DY,Width,Height,0, 0, Width, Height,pAND, PBitmapInfo(@iAND)^, DIB_RGB_COLORS,SRCAND);
      AlphaBlend(DC, DestBnd.X, DestBnd.Y, DestBnd.Width, DestBnd.Height, fBmp.Canvas.Handle,
                     SrcBnd.X, SrcBnd.Y, SrcBnd.Width, SrcBnd.Height, blend);
    end
    else if fBmp.Transparent then
    begin
        TransparentBlt(DC, DestBnd.X, DestBnd.Y, DestBnd.Width, DestBnd.Height, fBmp.Canvas.Handle, LeftTop.X, LeftTop.Y,
          SrcBnd.Width, SrcBnd.Height, fTransparentColor and not AlphaMask)
        { begin
          blend.AlphaFormat         := AC_SRC_ALPHA
          //       else
          //          blend.AlphaFormat         := AC_SRC_OVER
          ;
          blend.BlendOp             := AC_SRC_OVER;
          //         blend.BlendFlags          := AC_SRC_NO_ALPHA;
          blend.BlendFlags          := 0;
          if not pEnabled then
          blend.SourceConstantAlpha := 100
          else
          blend.SourceConstantAlpha := $FF;
          //StretchDIBits(DC,DX,DY,Width,Height,0, 0, Width, Height,pAND, PBitmapInfo(@iAND)^, DIB_RGB_COLORS,SRCAND);
          hBMP := fBmp.Canvas.Handle;
          //       fBmp.Canvas.Lock;
          Windows.AlphaBlend(DC, DestR.Left, DestR.Top, DestR.Right-DestR.Left, DestR.Bottom - DestR.Top,
          HBMP, SrcX, SrcY, SrcW, SrcH, blend);
          end }
        // TransparentStretchBlt(DC, DestR.Left, DestR.Top, DestR.Right-DestR.Left, DestR.Bottom - DestR.Top,
        // fbmp.Canvas.Handle, SrcX, SrcY, SrcW, SrcH, fbmp.ma, SrcX, SrcY)
    end
    else if htTransparent then
      MaskDraw(DC, DestBnd, makeRect(LeftTop, SrcBnd.Size))
    else
    begin
      // MaskBlt(DC, DestR.Left, DestR.Top, DestR.Right-DestR.Left, DestR.Bottom - DestR.Top,
      // fbmp.Canvas.Handle, SrcX, SrcY, fBmp.MaskHandle, 0, 0, SrcCopy);
      // if not isCopy32 then
      StretchBlt(DC, DestBnd.X, DestBnd.Y, DestBnd.Width, DestBnd.Height, fBmp.Canvas.Handle, LeftTop.X, LeftTop.Y, SrcBnd.Width,
        SrcBnd.Height, SRCCOPY)
      { else
        begin
        blend.AlphaFormat    := AC_SRC_OVER;
        blend.BlendOp        := AC_SRC_OVER;

        blend.BlendFlags         := AC_SRC_NO_PREMULT_ALPHA;
        //            blend.BlendFlags         := 0;
        if not pEnabled then
        blend.SourceConstantAlpha := 100
        else
        blend.SourceConstantAlpha := $FF;
        Windows.AlphaBlend(DC, DestBnd.X, DestBnd.Y, DestBnd.Width, DestBnd.Height,
        fbmp.Canvas.Handle,LeftTop.X, LeftTop.Y, SrcBnd.Width, SrcBnd.Height, blend);
        end; }
    end;
  end
  else if fHI > 0 then
  begin
    ico := CopyImage(fHI, IMAGE_ICON, DestBnd.Width, DestBnd.Height, LR_COPYFROMRESOURCE);
    // DrawIconEx(AboutPBox.Canvas.Handle, 0, 0, ico, 48, 48, 0, 0, DI_NORMAL);
    // DrawIconEx(DC, DestR.Left, DestR.Top, fHI, DestR.Right-DestR.Left, DestR.Bottom-DestR.Top, 0, 0, DI_NORMAL);
    DrawIconEx(DC, DestBnd.X, DestBnd.Y, ico, DestBnd.Width, DestBnd.Height, 0, 0, DI_NORMAL);
    DeleteObject(ico);
  end;
end;

procedure TRnQBitmap.Draw(DC: HDC; DestR: TGPRect);
begin
  Draw(DC, DestR, RDGlobal.makeRect(0, 0, fWidth, fHeight));
end;

procedure TRnQBitmap.Draw(DC: HDC; DX, DY: Integer);
var
  blend: BLENDFUNCTION;
  LeftTop: TPoint;
  MyDC: HDC;
begin
  if fAnimated then
  begin
    // with fFrames[FCurrentFrame] do
    begin
      // LeftTop.X := (FCurrentFrame-1)*Width;
      // LeftTop.Y := 0;

      LeftTop.X := 0;
      LeftTop.Y := (FCurrentFrame - 1) * Height;
    end;
  end
  else
  begin
    LeftTop.X := 0;
    LeftTop.Y := 0;
  end;

  if Assigned(fBmp) and not (fBmp.Handle = 0) and fBmp.HandleAllocated then
  begin
    MyDC := fBmp.Canvas.Handle;
    if f32Alpha then
    begin
      blend.AlphaFormat := AC_SRC_ALPHA
      // else
      // blend.AlphaFormat         := AC_SRC_OVER
        ;
      blend.BlendOp := AC_SRC_OVER;
      blend.BlendFlags := 0;
      blend.SourceConstantAlpha := $FF;
      // StretchDIBits(DC,DX,DY,Width,Height,0, 0, Width, Height,pAND, PBitmapInfo(@iAND)^, DIB_RGB_COLORS,SRCAND);
      AlphaBlend(DC, DX, DY, fWidth, fHeight, MyDC, LeftTop.X, LeftTop.Y, fWidth, fHeight, blend);
    end
    else if fBmp.Transparent then
        TransparentBlt(DC, DX, DY, fWidth, fHeight, MyDC, LeftTop.X, LeftTop.Y, fWidth, fHeight,
          fTransparentColor and (not AlphaMask))
        {
          begin
          blend.AlphaFormat         := AC_SRC_ALPHA
          //       else
          //        blend.AlphaFormat         := AC_SRC_OVER
          ;
          blend.BlendOp             := AC_SRC_OVER;
          blend.BlendFlags          := AC_SRC_NO_ALPHA;
          blend.SourceConstantAlpha := $FF;
          //StretchDIBits(DC,DX,DY,Width,Height,0, 0, Width, Height,pAND, PBitmapInfo(@iAND)^, DIB_RGB_COLORS,SRCAND);
          Windows.AlphaBlend(DC, DX, DY, fWidth, fHeight, MyDC,
          LeftTop.X, LeftTop.Y, fWidth, fHeight, blend);
          end
        }
    else if htTransparent then
      // MaskDraw(DC, DX, DY)
      MaskDraw(DC, RDGlobal.makeRect(DX, DY, fWidth, fHeight), RDGlobal.makeRect(LeftTop.X, LeftTop.Y, fWidth, fHeight))
    else
      // MaskBlt(DC, DX, DY, fWidth, fHeight,
      // fbmp.Canvas.Handle, 0, 0, fBmp.MaskHandle, 0, 0, SrcCopy);
      // StretchBlt(DC, DX, DY, fWidth, fHeight,
      // fbmp.Canvas.Handle, 0, 0, fWidth, fHeight, SrcCopy);
      BitBlt(DC, DX, DY, fWidth, fHeight, MyDC, LeftTop.X, LeftTop.Y, SRCCOPY);
  end
  else if fHI > 0 then
    DrawIconEx(DC, DX, DY, fHI, 0, 0, 0, 0, DI_NORMAL);
end;

// type
// PColor32 = ^TColor32;
// TColor32 = type Cardinal;
// in new Delphi we have TAlphaColor in UITypes
function SetAlpha(Color32: TAlphaColor; NewAlpha: Byte): TAlphaColor; {$IFDEF HAS_INLINE}inline; {$ENDIF HAS_INLINE}
begin
  { if NewAlpha <= 0 then
    //       NewAlpha := 0
    Result := (Color32 and $00FFFFFF)
    else
    if NewAlpha > 255 then
    //          NewAlpha := 255;
    Result := AlphaMask or (Color32 and $00FFFFFF)
    else }
  Result := (Color32 and $00FFFFFF) or (NewAlpha shl 24);
end;

function TRnQBitmap.CloneAll: TRnQBitmap;
begin
  Result := TRnQBitmap.Create;
  Result.f32Alpha := Self.f32Alpha;
  Result.fFormat := Self.fFormat;
  if Assigned(Self.fBmp) then
  begin
    Result.fBmp := TBitmap.Create;
    Result.fBmp.Assign(Self.fBmp);
  end;
  Result.fWidth := Self.fWidth;
  Result.fHeight := Self.fHeight;
  Result.fTransparentColor := Self.fTransparentColor;
  Result.fAnimated := Self.fAnimated;
  Result.htTransparent := Self.htTransparent;

  Result.fHI := CopyIcon(Self.fHI);
  Result.FNumFrames := Self.FNumFrames;
  Result.FCurrentFrame := Self.FCurrentFrame;
  Result.LastTime := Self.LastTime;
  Result.CurrentInterval := Self.CurrentInterval;
  Result.CurrentIteration := Self.CurrentIteration;
  Result.FNumIterations := Self.FNumIterations;
  Result.fFrames := Self.fFrames;
  Result.WasDisposal := Self.WasDisposal;

  if Assigned(Self.htMask) then
  begin
    Result.htMask := TBitmap.Create;
    Result.htMask.Assign(Self.htMask);
  end;
end;

function TRnQBitmap.Clone(bnd: TGPRect): TRnQBitmap;
var
  MyDC: HDC;
  I: Integer;
  frame: TAniFrame;
begin
  if Assigned(fBmp) and not (fBmp.Handle = 0) and fBmp.HandleAllocated then
  begin
    Result := TRnQBitmap.Create(bnd.Width, bnd.Height);
    Result.f32Alpha := f32Alpha;
    Result.fTransparentColor := fTransparentColor;
    if (fBmp.Width = 0) or (fBmp.Height = 0) then
      Exit;
    MyDC := fBmp.Canvas.Handle;
    SetStretchBltMode(MyDC, COLORONCOLOR);
    if f32Alpha then
      Result.fBmp.PixelFormat := pf32bit
    else
    begin
      Result.fBmp.PixelFormat := fBmp.PixelFormat;
      if fBmp.Transparent then
      begin
        Result.fBmp.Transparent := True;
        Result.fBmp.TransparentColor := fBmp.TransparentColor;
      end;
    end;
    if Animated and (bnd.X = 0) and (bnd.Y = 0) and (bnd.Width = Width) and (bnd.Height = Height) then
    begin
      Result.fFormat := PA_FORMAT_UNK;
      Result.FNumFrames := FNumFrames;
      Result.fAnimated := Result.FNumFrames > 1;
      Result.fWidth := fWidth;
      Result.fHeight := fHeight;
      Result.FNumIterations := FNumIterations;
      Result.htTransparent := htTransparent;
      begin
        // Strip := ThtBitmap.Create;
        // if fBmp.Width > fWidth then
        if fBmp.Height > fHeight then
        begin
          Result.fBmp.Height := 0;
          Result.fBmp.SetSize(fBmp.Width, fBmp.Height);
        end;
        BitBlt(Result.fBmp.Canvas.Handle, 0, 0, fBmp.Width, fBmp.Height, MyDC, 0, 0, SRCCOPY);
        if Assigned(htMask) then
        begin
          Result.htMask := TBitmap.Create;
          Result.htMask.Assign(htMask);
          Result.htTransparent := True;
        end
        else
        begin
          Result.htMask := NIL;
          Result.htTransparent := false;
        end;
        if Result.fBmp.Palette <> 0 then
          DeleteObject(Result.fBmp.ReleasePalette);
        Result.fBmp.Palette := CopyPalette(fBmp.Palette);
      end;
      if not Assigned(Result.fFrames) then
        Result.fFrames := TAniFrameList.Create;
      for I := 1 to Result.FNumFrames do
      begin
        frame := TAniFrame.Create;
        try
          frame.frDisposalMethod := fFrames[I].frDisposalMethod;
          frame.frLeft := fFrames[I].frLeft;
          frame.frTop := fFrames[I].frTop;
          frame.frWidth := fFrames[I].frWidth;
          frame.frHeight := fFrames[I].frHeight;
          frame.frDelay := fFrames[I].frDelay;
        except
          frame.Free;
          Raise;
        end;
        Result.fFrames.Add(frame);
      end;
      Result.WasDisposal := dtToBackground;
    end else
      BitBlt(Result.fBmp.Canvas.Handle, 0, 0, bnd.Width, bnd.Height, MyDC, bnd.X, bnd.Y, SRCCOPY);
  end
  else if fHI > 0 then
  begin
    Result := TRnQBitmap.Create;
    Result.f32Alpha := f32Alpha;
    Result.fHI := CopyIcon(fHI);
    Result.fWidth := fWidth;
    Result.fHeight := fHeight;
  end
  else
    Result := NIL;
end;

function TRnQBitmap.CloneFrame(frame: Integer): TRnQBitmap;
var
  LeftTop: TPoint;
var
  SRect: TRect;
  blend: BLENDFUNCTION;
begin
  if frame >= 0 then
    SetCurrentFrame(frame);
  if fAnimated then
  begin
    with fFrames[FCurrentFrame] do
    begin
      // LeftTop.X := (FCurrentFrame-1)*Width;
      // LeftTop.Y := 0;
      LeftTop.X := 0;
      LeftTop.Y := (FCurrentFrame - 1) * Height;
    end;
  end
  else
  begin
    LeftTop.X := 0;
    LeftTop.Y := 0;
  end;
  if Assigned(fBmp) and not (fBmp.Handle = 0) and fBmp.HandleAllocated then
  begin
    Result := TRnQBitmap.Create(Width, Height);
    Result.f32Alpha := f32Alpha;
    // B32.SetSize(PNG.Width,PNG.Height);
    if (fBmp.Width = 0) or (fBmp.Height = 0) then
      Exit;
    // SetStretchBltMode(fBmp.Canvas.Handle,COLORONCOLOR);
    if f32Alpha then
      Result.fBmp.PixelFormat := pf32bit
    else
      Result.fBmp.PixelFormat := pf24bit;

    if f32Alpha then
    begin
      blend.AlphaFormat := AC_SRC_OVER;
      blend.BlendOp := AC_SRC_OVER;
      blend.BlendFlags := 0;
      blend.SourceConstantAlpha := $FF;
      AlphaBlend(Result.fBmp.Canvas.Handle, 0, 0, Width, Height, fBmp.Canvas.Handle, LeftTop.X, LeftTop.Y, Width, Height, blend);
    end
    // if f32Alpha then
    else
    begin
      SRect := Rect(LeftTop, Point(LeftTop.X + Width, LeftTop.Y + Height)); { current frame location in Strip bitmap }
      Result.fBmp.SetSize(Width, Height);
      Result.fBmp.Canvas.CopyRect(Rect(0, 0, Width, Height), fBmp.Canvas, SRect);
      Result.fBmp.Transparent := fBmp.Transparent;
      Result.fBmp.TransparentColor := fBmp.TransparentColor;
      Result.fBmp.TransparentMode := fBmp.TransparentMode;

      if htTransparent then
      begin
        Result.htMask := TBitmap.Create;
        Result.htMask.Monochrome := True;
        Result.htMask.SetSize(Width, Height);
        Result.htMask.Canvas.CopyRect(Rect(0, 0, Width, Height), htMask.Canvas, SRect);
        Result.htMask.Transparent := htMask.Transparent;
        Result.htMask.TransparentColor := htMask.TransparentColor;
        Result.htMask.TransparentMode := htMask.TransparentMode;

      end;
      Result.fBmp.Transparent := false;
      Result.fFormat := PA_FORMAT_GIF;
      Result.htTransparent := htTransparent and Assigned(htMask);
    end;
  end
  else if fHI > 0 then
  begin
    Result := TRnQBitmap.Create;
    Result.f32Alpha := f32Alpha;
    Result.fHI := CopyIcon(fHI);
    Result.fWidth := fWidth;
    Result.fHeight := fHeight;
  end
  else
    Result := NIL;
end;

function TRnQBitmap.bmp2ico32: HICON;
const
  MaxRGBQuads = MaxInt div SizeOf(TRGBQuad) - 1;
type
  TRGBQuadArray = array [0 .. MaxRGBQuads] of TRGBQuad;
  PRGBQuadArray = ^TRGBQuadArray;

  TBitmapInfo4 = packed record
    bmiHeader: TBitmapV4Header;
    bmiColors: array [0 .. 0] of TRGBQuad;
  end;
var
  ImageBits: PRGBQuadArray;
  BitmapInfo: TBitmapInfo4;
  IconInfo: TIconInfo;
  AlphaBitmap: HBitmap;
  MaskBitmap: TBitmap;
  X, Y: Integer;
  // AlphaLine: PByteArray;
  // HasAlpha, HasBitmask: Boolean;
  // Color, TransparencyColor: TColor;
  PB: PColor32;
begin
  // Convert a PNG object to an alpha-blended icon resource
  ImageBits := nil;

  // Allocate a DIB for the color data and alpha channel
  with BitmapInfo.bmiHeader do
  begin
    bV4Size := SizeOf(BitmapInfo.bmiHeader);
    bV4Width := Self.Width;
    bV4Height := Self.Height;
    bV4Planes := 1;
    bV4BitCount := 32;
    bV4V4Compression := BI_BITFIELDS;
    bV4SizeImage := 0;
    bV4XPelsPerMeter := 0;
    bV4YPelsPerMeter := 0;
    bV4ClrUsed := 0;
    bV4ClrImportant := 0;
    bV4RedMask := $00FF0000;
    bV4GreenMask := $0000FF00;
    bV4BlueMask := $000000FF;
    bV4AlphaMask := $FF000000;
  end;
  AlphaBitmap := CreateDIBSection(0, PBitmapInfo(@BitmapInfo)^, DIB_RGB_COLORS, Pointer(ImageBits), 0, 0);
  try
    // Spin through and fill it with a wash of color and alpha.
    // AlphaLine := nil;
    // HasAlpha := Self.f32Alpha;// Png.Header.ColorType in [COLOR_GRAYSCALEALPHA, COLOR_RGBALPHA];
    // HasBitmask := Png.TransparencyMode = ptmBit;
    // HasBitmask := self.htTransparent;
    // TransparencyColor := self.fTransparentColor;
    for Y := 0 to Self.Height - 1 do
    begin
      PB := Pointer(Self.fBmp.ScanLine[Self.Height - Y - 1]);
      if PB <> nil then
      begin
        // inc(PB, LeftTop.X);
        // PC:=Pointer(Result.fBmp.ScanLine[r-LeftTop.y]);
        for X := 0 to Self.Width - 1 do
          with ImageBits^[Y * Self.Width + X] do
          // for C:=0 to width-1 do
          begin
            if Self.f32Alpha then
              rgbReserved := PAlphaColor(PB)^ shr 24 and $FF
            else if Self.htTransparent then
              rgbReserved := Integer(PAlphaColor(PB)^ <> Self.fTransparentColor) * $FF
            else
              rgbReserved := $FF;
            if rgbReserved = 0 then
            begin
              rgbBlue := $7F;
              rgbGreen := $7F;
              rgbRed := $7F;
            end
            else
            begin
              { rgbRed := Pcolor32(PB)^ and $FF;
                rgbGreen := Pcolor32(PB)^ shr 8 and $FF;
                rgbBlue := Pcolor32(PB)^ shr 16 and $FF; }
              rgbBlue := PAlphaColor(PB)^ and $FF;
              rgbGreen := PAlphaColor(PB)^ shr 8 and $FF;
              rgbRed := PAlphaColor(PB)^ shr 16 and $FF;
            end;
            inc(PB); // Inc(PC);
          end;
      end;
    end;

    // Create an empty mask
    MaskBitmap := TBitmap.Create;
    try
      MaskBitmap.Width := Self.Width;
      MaskBitmap.Height := Self.Height;
      MaskBitmap.PixelFormat := pf1bit;
      MaskBitmap.Canvas.Brush.Color := clBlack;
      // MaskBitmap.Canvas.Brush.Color := clWhite;
      MaskBitmap.Canvas.FillRect(Rect(0, 0, MaskBitmap.Width, MaskBitmap.Height));

      // Create the alpha blended icon
      IconInfo.fIcon := True;
      IconInfo.hbmColor := AlphaBitmap;
      IconInfo.hbmMask := MaskBitmap.Handle;
      // IconInfo.hbmMask := 0;
      Result := CreateIconIndirect(IconInfo);
    finally
      MaskBitmap.Free;
    end;
  finally
    DeleteObject(AlphaBitmap);
  end;
end;

procedure TRnQBitmap.GetHICON(var hi: HICON);
// var
// ico : Ticon;
// tbmp : TBitmap;
begin
  if fHI > 0 then
    hi := CopyIcon(fHI)
  else if Assigned(fBmp) then
  begin
    // ico := TIcon.Create;
    // ico.Assign(fBmp);
    // ico := bmp2ico3(fBmp);
    // hi := CopyIcon(ico.Handle);
    // if f32Alpha and (GetComCtlVersion >= ComCtlVersionIE6) then
    if f32Alpha and ((Win32MajorVersion > 5) or ((Win32MajorVersion = 5) and (Win32MinorVersion >= 1)))
    // if 1=1

    { (GetComCtlVersion >= ComCtlVersionIE6) } then
    // Windows XP or later, using the modern method: convert every PNG to
    // an icon resource with alpha channel
    begin
      { tbmp := TBitmap.Create;
        tbmp.Assign(fBmp);
        Demultiply(tbmp);
        hi := bmp2ico32(tbmp);
        //          hi := bmp2ico4M(tbmp);
        tbmp.Free; }
      // hi := bmp2ico32(fbmp);
      hi := Self.bmp2ico32;
      // hi := bmp2ico4M(fBmp);
    end
    else
      hi := bmp2ico4M(fBmp);
    { begin
      ico := bmp2ico(fBmp);
      hi := ico.handle;
      ico.free;
      end; }
    // hi :=self.bmp2ico32;
    // ico.Free;
  end;
end;

function wbmp2bmp(Stream: TStream; var pic: TBitmap; CalcOnly: boolean = false): TSize;
const
  WBMP_TYPE_BW_NOCOMPRESSION = 0;
  WBMP_DATA_MASK = $7F;
  WBMP_DATA_SHIFT = 7;
  WBMP_CONTINUE_MASK = $80;
  WBMP_FIXEDHEADERFIELD_EXT_MASK = $60;
  WBMP_FIXEDHEADERFIELD_EXT_00 = $00;
  WBMP_FIXEDHEADERFIELD_EXT_01 = $20;
  WBMP_FIXEDHEADERFIELD_EXT_10 = $40;
  WBMP_FIXEDHEADERFIELD_EXT_11 = $60;
  WBMP_FIXEDHEADERFIELD_EXT_11_IDENT_MASK = $70;
  WBMP_FIXEDHEADERFIELD_EXT_11_IDENT_SHIFT = 4;
  WBMP_FIXEDHEADERFIELD_EXT_11_VALUE_MASK = $0F;
  WBMP_FIXEDHEADERFIELD_EXT_11_VALUE_SHIFT = 0;
var
  FTypeField: Byte;
  FFixHeaderField: Byte;
  // width, height : Integer;
  b: Byte;
  BytesPerRow: Integer;
  I: Integer;
  SId: string[8];
  SVal: string[16];

  function ReadNum: Integer;
  var
    b: Integer;
  begin
    Result := 0;
    b := 0;
    repeat
      // B := 0;
      Stream.Read(b, SizeOf(Byte));
      Result := (Result shl WBMP_DATA_SHIFT) or (b and WBMP_DATA_MASK);
    until (b and WBMP_CONTINUE_MASK) = 0;
  end;

var
  Pal: TMaxLogPalette;
begin
  Result.cx := 0;
  Result.cy := 0;
  if not Assigned(Stream) then
    Exit;
  Stream.Position := 0;
  Stream.Read(b, SizeOf(Byte));
  FTypeField := b;
  case FTypeField of
    WBMP_TYPE_BW_NOCOMPRESSION:
      begin
        // FixImage;
        Stream.Read(b, SizeOf(Byte));
        FFixHeaderField := b;
        // ExtHeaders.Clear;
        if (FFixHeaderField and WBMP_CONTINUE_MASK) <> 0 then
          case FFixHeaderField and WBMP_FIXEDHEADERFIELD_EXT_MASK of
            WBMP_FIXEDHEADERFIELD_EXT_00: // Not Implemented
              begin
                // raise Exception.Create(sNotImplemented);
              end;
            WBMP_FIXEDHEADERFIELD_EXT_01, WBMP_FIXEDHEADERFIELD_EXT_10: // Reserved
              begin
                // raise Exception.Create(sReservedExtHeaderType);
              end;
            WBMP_FIXEDHEADERFIELD_EXT_11:
              begin
                repeat
                  Stream.Read(b, SizeOf(Byte));
                  SetLength(SId, (b and WBMP_FIXEDHEADERFIELD_EXT_11_IDENT_MASK) shr WBMP_FIXEDHEADERFIELD_EXT_11_IDENT_SHIFT);
                  SetLength(SVal, (b and WBMP_FIXEDHEADERFIELD_EXT_11_VALUE_MASK) shr WBMP_FIXEDHEADERFIELD_EXT_11_VALUE_SHIFT);
                  Stream.Read(SId[1], Length(SId));
                  Stream.Read(SVal[1], Length(SVal));
                  // ExtHeaders.Values[SId] := SVal;
                until (b and WBMP_CONTINUE_MASK) = 0;
              end;
          end;
        Result.cx := ReadNum;
        Result.cy := ReadNum;
        if (Result.cy > 5000) or (Result.cy > 5000) or (Result.cy < 0) then
        begin
          Result.cx := 0;
          Result.cy := 0;
          FreeAndNil(pic);
          Exit;
        end;
        if CalcOnly then
          FreeAndNil(pic)
        else
        begin
          if not Assigned(pic) then
          begin
            pic := TBitmap.Create;
          end
          else
          begin
            pic.Height := 0;
          end;
          pic.PixelFormat := pf1bit;
          pic.SetSize(Result.cx, Result.cy);
          FillChar(Pal, SizeOf(Pal), 0);
          Pal.palVersion := $300;
          Pal.palNumEntries := 2;
          Pal.palPalEntry[1].peRed := $FF;
          Pal.palPalEntry[1].peGreen := $FF;
          Pal.palPalEntry[1].peBlue := $FF;
          pic.Palette := CreatePalette(PLogPalette(@Pal)^);
          BytesPerRow := Result.cx div 8;
          if Result.cx mod 8 > 0 then
            inc(BytesPerRow);
          for I := 0 to Result.cy - 1 do
            Stream.Read(pic.ScanLine[I]^, BytesPerRow);
          // Changed(Self);
        end;
      end;
    // else
    // raise Exception.Create(sUnsuportedWBMPType);
  end;
end;

function wbmp2bmp(Stream: TStream; var pic: TBitmap32; CalcOnly: boolean = false): TSize;
const
  WBMP_TYPE_BW_NOCOMPRESSION = 0;
  WBMP_DATA_MASK = $7F;
  WBMP_DATA_SHIFT = 7;
  WBMP_CONTINUE_MASK = $80;
  WBMP_FIXEDHEADERFIELD_EXT_MASK = $60;
  WBMP_FIXEDHEADERFIELD_EXT_00 = $00;
  WBMP_FIXEDHEADERFIELD_EXT_01 = $20;
  WBMP_FIXEDHEADERFIELD_EXT_10 = $40;
  WBMP_FIXEDHEADERFIELD_EXT_11 = $60;
  WBMP_FIXEDHEADERFIELD_EXT_11_IDENT_MASK = $70;
  WBMP_FIXEDHEADERFIELD_EXT_11_IDENT_SHIFT = 4;
  WBMP_FIXEDHEADERFIELD_EXT_11_VALUE_MASK = $0F;
  WBMP_FIXEDHEADERFIELD_EXT_11_VALUE_SHIFT = 0;
var
  FTypeField: Byte;
  FFixHeaderField: Byte;
  // width, height : Integer;
  b: Byte;
  BytesPerRow: Integer;
  I: Integer;
  SId: string[8];
  SVal: string[16];

  function ReadNum: Integer;
  var
    b: Integer;
  begin
    Result := 0;
    b := 0;
    repeat
      // B := 0;
      Stream.Read(b, SizeOf(Byte));
      Result := (Result shl WBMP_DATA_SHIFT) or (b and WBMP_DATA_MASK);
    until (b and WBMP_CONTINUE_MASK) = 0;
  end;

var
  Pal: TMaxLogPalette;
begin
  Result.cx := 0;
  Result.cy := 0;
  if not Assigned(Stream) then
    Exit;
  Stream.Position := 0;
  Stream.Read(b, SizeOf(Byte));
  FTypeField := b;
  case FTypeField of
    WBMP_TYPE_BW_NOCOMPRESSION:
      begin
        // FixImage;
        Stream.Read(b, SizeOf(Byte));
        FFixHeaderField := b;
        // ExtHeaders.Clear;
        if (FFixHeaderField and WBMP_CONTINUE_MASK) <> 0 then
          case FFixHeaderField and WBMP_FIXEDHEADERFIELD_EXT_MASK of
            WBMP_FIXEDHEADERFIELD_EXT_00: // Not Implemented
              begin
                // raise Exception.Create(sNotImplemented);
              end;
            WBMP_FIXEDHEADERFIELD_EXT_01, WBMP_FIXEDHEADERFIELD_EXT_10: // Reserved
              begin
                // raise Exception.Create(sReservedExtHeaderType);
              end;
            WBMP_FIXEDHEADERFIELD_EXT_11:
              begin
                repeat
                  Stream.Read(b, SizeOf(Byte));
                  SetLength(SId, (b and WBMP_FIXEDHEADERFIELD_EXT_11_IDENT_MASK) shr WBMP_FIXEDHEADERFIELD_EXT_11_IDENT_SHIFT);
                  SetLength(SVal, (b and WBMP_FIXEDHEADERFIELD_EXT_11_VALUE_MASK) shr WBMP_FIXEDHEADERFIELD_EXT_11_VALUE_SHIFT);
                  Stream.Read(SId[1], Length(SId));
                  Stream.Read(SVal[1], Length(SVal));
                  // ExtHeaders.Values[SId] := SVal;
                until (b and WBMP_CONTINUE_MASK) = 0;
              end;
          end;
        Result.cx := ReadNum;
        Result.cy := ReadNum;
        if (Result.cy > 5000) or (Result.cy > 5000) or (Result.cy < 0) then
        begin
          Result.cx := 0;
          Result.cy := 0;
          FreeAndNil(pic);
          Exit;
        end;
        if CalcOnly then
          FreeAndNil(pic)
        else
        begin
          if not Assigned(pic) then
            pic := TBitmap32.Create
          else
            pic.Height := 0;
          // pic.PixelFormat := pf1bit;
          pic.SetSize(Result.cx, Result.cy);
          FillChar(Pal, SizeOf(Pal), 0);
          Pal.palVersion := $300;
          Pal.palNumEntries := 2;
          Pal.palPalEntry[1].peRed := $FF;
          Pal.palPalEntry[1].peGreen := $FF;
          Pal.palPalEntry[1].peBlue := $FF;
          BytesPerRow := Result.cx div 8;
          if Result.cx mod 8 > 0 then
            inc(BytesPerRow);
          for I := 0 to Result.cy - 1 do
            Stream.Read(pic.ScanLine[I]^, BytesPerRow);
          // Changed(Self);
        end;
      end;
    // else
    // raise Exception.Create(sUnsuportedWBMPType);
  end;
end;

function createBitmap(DX, DY: Integer): TBitmap;
begin
  Result := TBitmap.Create;
  Result.PixelFormat := pf24bit;
  Result.SetSize(DX, DY);
end;

function createBitmap(cnv: Tcanvas): TBitmap;
begin
  with cnv.ClipRect do
    Result := createBitmap(Right - left + 1, Bottom - Top + 1);
end;

function getSupPicExts: String;
var
  I: Integer;
  s: String;
  // var
  // l : TStrings;
begin
  // FileFormatList.GetExtensionList(l);
  s := '';
  for I := low(supExts) to High(supExts) do
    s := s + '*.' + supExts[I] + '; ';
  Result := 'All images' + '|' + s; // + '|';
  // result := FileFormatList.GetGraphicFilter([], fstDescription,
  // [foCompact, foIncludeAll, foIncludeExtension], nil);
  // !!!!!!!!!!!!!!!!!         ADDD       WBMP, GIF         !!!!!!!!!!!!!
end;

function IsSupportedPicFile(fn: String): Boolean;
begin
  Result := False;
  fn := LowerCase(ExtractFileExt(fn));
  if Length(fn) > 3 then // dot + extension
  begin
    fn := Copy(fn, 2, Length(fn) - 1);
    Result := (fn = 'bmp') or (fn = 'wbmp') or (fn = 'wbm') or (fn = 'gif') or (fn = 'ico') or
              (fn = 'icon') or (fn = 'png') or (fn = 'jpg') or (fn = 'jpeg') or (fn = 'tif');
  end;
end; // IsSupportedPicFile

function DetectFileFormatStream(str: TStream): TPAFormat;
var
  s: array [0 .. 3] of AnsiChar;
begin
  str.Seek(0, soFromBeginning);
  // str.Position := 0;
  str.Read(s, 4);
  // s := Copy(pBuffer, 1, 4);
  if s = 'GIF8' then
    Result := PA_FORMAT_GIF
  else if MatchStr(s, JPEG_HDRS) then
    Result := PA_FORMAT_JPEG
  else if AnsiStartsText(AnsiString('BM'), s) then
    Result := PA_FORMAT_BMP
  else if s = '
    Result := PA_FORMAT_XML
  else if AnsiStartsText(AnsiString('CWS'), s) then
    Result := PA_FORMAT_SWF
  else if AnsiStartsText(AnsiString('FWS'), s) then
    Result := PA_FORMAT_SWF
  else if AnsiStartsText(AnsiString('<27>PNG'), s) then
    Result := PA_FORMAT_PNG
  else if AnsiStartsText(AnsiString('RIFF'), s) then
  begin
    str.Read(s, 4);
    str.Read(s, 4);
    if AnsiStartsText(AnsiString('WEBP'), s) then
      Result := PA_FORMAT_WEBP
    else
      Result := PA_FORMAT_UNK;
  end else if (s = ICON) then
    Result := PA_FORMAT_ICO
  else if (s = TIF) then
    Result := PA_FORMAT_TIF
  else if s[0] = '{' then
    Result := PA_FORMAT_JSON
  else
    Result := PA_FORMAT_UNK;
end;

procedure StretchPic(var bmp: TBitmap; maxH, maxW: Integer);
var
  bmp1: TBitmap;
begin
  if (bmp.Width > maxW) or (bmp.Height > maxH) then
  begin
    bmp1 := TBitmap.Create;
    if bmp.Width * maxH < bmp.Height * maxW then
    begin
      bmp1.SetSize(maxH * bmp.Width div bmp.Height, maxH);
    end
    else
    begin
      bmp1.SetSize(maxW, maxW * bmp.Height div bmp.Width);
    end;
    bmp1.Canvas.StretchDraw(Rect(0, 0, bmp1.Width, bmp1.Height), bmp);
    FreeAndNil(bmp);
    bmp := bmp1;
    // bmp1 := nil;
  end;
end;

procedure StretchPic(var bmp: TRnQBitmap; maxH, maxW: Integer);
begin
  if not Assigned(bmp) or (bmp.fAnimated and (bmp.FNumFrames > 1)) then
    Exit;

  if Assigned(bmp.fBmp) then
  begin
    ResampleProportional(bmp.fBmp, maxH, maxW);
    bmp.fWidth := bmp.fBmp.Width;
    bmp.fHeight := bmp.fBmp.Height;
  end;
end;

procedure DrawRbmp(DC: HDC; var bmp: TRnQBitmap; DestR, SrcR: TGPRect); OverLoad;
var
  pt: TPoint;
begin
  if (DestR.Width <> SrcR.Width) or (DestR.Height <> SrcR.Height) then
  begin
    GetBrushOrgEx(DC, pt);
    SetStretchBltMode(DC, HALFTONE);
    SetBrushOrgEx(DC, pt.X, pt.Y, @pt);
  end;
  // SetStretchBltMode(DC, HALFTONE);
  bmp.Draw(DC, DestR, SrcR);
end;

procedure DrawRbmp(DC: HDC; var bmp: TRnQBitmap; DestR: TGPRect); OverLoad;
var
  pt: TPoint;
begin
  if (DestR.Width <> bmp.Width) or (DestR.Height <> bmp.Height) then
  begin
    GetBrushOrgEx(DC, pt);
    SetStretchBltMode(DC, HALFTONE);
    SetBrushOrgEx(DC, pt.X, pt.Y, @pt);
  end;
  bmp.Draw(DC, DestR);
end;

procedure DrawRbmp(var Canvas: TCanvas; var bmp: TRnQBitmap; DestR: TGPRect); OverLoad;
var
  Factory: IWICImagingFactory;
  Source: TWICImage;
  Scaler: IWICBitmapScaler;
begin
  Source := nil;
  if (DestR.Width <> bmp.Width) and (DestR.Height <> bmp.Height) then
  try
    Source := TWICImage.Create;
    Factory := TWICImage.ImagingFactory;
    if bmp.fBmp.AlphaFormat = afPremultiplied then
    begin
      bmp.fBmp.AlphaFormat := afDefined;
      Source.Assign(bmp.fBmp);
      bmp.fBmp.AlphaFormat := afPremultiplied;
    end else
      Source.Assign(bmp.fBmp);
    Factory.CreateBitmapScaler(Scaler);
    Scaler.Initialize(Source.Handle, DestR.Width, DestR.Height, RDUtils.IfThen(TOSVersion.Check(10), 4, WICBitmapInterpolationModeFant));
    Source.Handle := IWICBitmap(Scaler);
    Canvas.Draw(DestR.X, DestR.Y, Source);
    Scaler := nil;
    Factory := nil;
  finally
    FreeAndNil(Source);
  end else
    bmp.Draw(Canvas.Handle, DestR);
end;

procedure DrawRbmp(DC: HDC; var bmp: TRnQBitmap); OverLoad;
begin
  bmp.Draw(DC, 0, 0);
end;

procedure DrawRbmp(DC: HDC; var bmp: TRnQBitmap; X, Y: Integer); OverLoad;
begin
  bmp.Draw(DC, X, Y);
end;

procedure DrawRbmp(DC: HDC; var bmp: TRnQBitmap; DestR, SrcR: TGPRect; pEnabled: boolean = True; IsCopy: boolean = false);
var
  pt: TPoint;
begin
  if (DestR.Width <> SrcR.Width) and (DestR.Height <> SrcR.Height) then
  begin
    GetBrushOrgEx(DC, pt);
    SetStretchBltMode(DC, HALFTONE);
    SetBrushOrgEx(DC, pt.X, pt.Y, @pt);
  end;
  bmp.Draw(DC, DestR, SrcR, pEnabled, IsCopy);
end;

//procedure DrawRbmp(var Canvas: TCanvas; var bmp: TRnQBitmap; DestR, SrcR: TGPRect; pEnabled: boolean = True; IsCopy: boolean = false); OverLoad;
//var
//  Factory: IWICImagingFactory;
//  Source: TWICImage;
//  Scaler: IWICBitmapScaler;
//  Clipper: IWICBitmapClipper;
//  ClipRect: WICRect;
//begin
//  if (DestR.Width <> SrcR.Width) and (DestR.Height <> SrcR.Height) then
//  try
//    Source := TWICImage.Create;
//    Factory := TWICImage.ImagingFactory;
//    if bmp.fBmp.AlphaFormat = afPremultiplied then
//    begin
//      bmp.fBmp.AlphaFormat := afDefined;
//      Source.Assign(bmp.fBmp);
//      bmp.fBmp.AlphaFormat := afPremultiplied;
//    end else
//      Source.Assign(bmp.fBmp);
//    Factory.CreateBitmapClipper(Clipper);
//    ClipRect.X := SrcR.X;
//    ClipRect.Y := SrcR.Y;
//    ClipRect.Width := SrcR.Width;
//    ClipRect.Height := SrcR.Height;
//    Clipper.Initialize(Source.Handle, ClipRect);
//    Factory.CreateBitmapScaler(Scaler);
//    Scaler.Initialize(Clipper, DestR.Width, DestR.Height, RDUtils.IfThen(TOSVersion.Check(10), 4, WICBitmapInterpolationModeFant));
//    Source.Handle := IWICBitmap(Scaler);
//
//    Canvas.Draw(DestR.X, DestR.Y, Source);
//    Scaler := nil;
//    Factory := nil;
//  finally
//    Source.Free;
//  end else
//    bmp.Draw(Canvas.Handle, DestR, SrcR, pEnabled, IsCopy);
//end;

function FillGradientInternal(DC: HDC; ARect: TRect; ColorCount: Integer; StartColor, EndColor: cardinal;
  ADirection: TGradientDirection): boolean;
  function GetAValue(rgb: DWord): Byte;
  begin
    Result := Byte(rgb shr 24);
  end;
  function RGBA(R, G, b, A: Byte): COLORREF; {$IFDEF HAS_INLINE}inline; {$ENDIF HAS_INLINE}
  begin
    Result := (R or (G shl 8) or (b shl 16) or (A shl 24));
  end;

var
  StartRGB: array [0 .. 3] of Byte;
  RGBKoef: array [0 .. 3] of double;
  Brush: HBRUSH;
  AreaWidth, AreaHeight, I: Integer;
  ColorRect: TRect;
  RectOffset: double;
begin
  RectOffset := 0;
  Result := false;
  if ColorCount < 1 then
    Exit;
  // StartColor := StartColor;
  // EndColor := EndColor;
  StartRGB[0] := GetRValue(StartColor);
  StartRGB[1] := GetGValue(StartColor);
  StartRGB[2] := GetBValue(StartColor);
  StartRGB[3] := GetAValue(StartColor);
  RGBKoef[0] := (GetRValue(EndColor) - StartRGB[0]) / ColorCount;
  RGBKoef[1] := (GetGValue(EndColor) - StartRGB[1]) / ColorCount;
  RGBKoef[2] := (GetBValue(EndColor) - StartRGB[2]) / ColorCount;
  RGBKoef[3] := (GetAValue(EndColor) - StartRGB[3]) / ColorCount;
  AreaWidth := ARect.Right - ARect.left;
  AreaHeight := ARect.Bottom - ARect.Top;
  case ADirection of
    gdHorizontal:
      RectOffset := AreaWidth / ColorCount;
    gdVertical:
      RectOffset := AreaHeight / ColorCount;
  end;
  for I := 0 to ColorCount - 1 do
  begin
    // Brush := CreateHatchBrush(HS_BDIAGONAL,
    Brush := CreateSolidBrush(RGBA(StartRGB[0] + round((I + 1) * RGBKoef[0]), StartRGB[1] + round((I + 1) * RGBKoef[1]),
      StartRGB[2] + round((I + 1) * RGBKoef[2]), StartRGB[3] + round((I + 1) * RGBKoef[3])));
    case ADirection of
      gdHorizontal:
        SetRect(ColorRect, round(RectOffset * I), 0, round(RectOffset * (I + 1)), AreaHeight);
      gdVertical:
        SetRect(ColorRect, 0, round(RectOffset * I), AreaWidth, round(RectOffset * (I + 1)));
    end;
    System.Types.OffsetRect(ColorRect, ARect.left, ARect.Top);
    FillRect(DC, ColorRect, Brush);
    DeleteObject(Brush);
  end;
  Result := True;
end;

function WinGradientFill; external msimg32 name 'GradientFill';

type
  COLOR16_RD = Smallint;

  PTriVertex_RD = ^TTriVertex;

  { $EXTERNALSYM _TRIVERTEX_RD }
  _TRIVERTEX_RD = packed record
    X: Longint;
    Y: Longint;
    Red: COLOR16_RD;
    Green: COLOR16_RD;
    Blue: COLOR16_RD;
    Alpha: COLOR16_RD;
  end;

  TTriVertex_RD = _TRIVERTEX_RD;
  { $EXTERNALSYM TRIVERTEX_RD }
  TRIVERTEX_RD = _TRIVERTEX_RD;

procedure FillGradient(DC: HDC; ARect: TRect; // ColorCount: Integer;
  StartColor, EndColor: cardinal; ADirection: TGradientDirection; Alpha: Byte = $FF);
var
  udtVertex: array [0 .. 1] of TTriVertex;
  rectGradient: TGradientRect;
  Mode: cardinal;

  tempDC: HDC;
  ABitmap, HOldBmp: HBitmap;
  BI: TBitmapInfo;
  blend: BLENDFUNCTION;
begin
  // StartColor := ColorToRGB(StartColor);
  // EndColor := ColorToRGB(EndColor);
  if ((StartColor and AlphaMask) = (EndColor and AlphaMask)) and ((StartColor and AlphaMask) <> AlphaMask) then
  begin
    Alpha := Alpha * Byte(EndColor shr 24) div $FF;
    StartColor := StartColor or AlphaMask;
    EndColor := EndColor or AlphaMask;
  end;
  with udtVertex[0] do
  begin
    X := ARect.left;
    Y := ARect.Top;
    Red := Byte(StartColor) shl 8;
    Blue := Byte(StartColor shr 16) shl 8;
    Green := Byte(StartColor shr 8) shl 8;
    Alpha := Byte(StartColor shr 24) shl 8;
  end;

  with udtVertex[1] do
  begin
    X := ARect.Right;
    Y := ARect.Bottom;
    Red := Byte(EndColor) shl 8;
    Blue := Byte(EndColor shr 16) shl 8;
    Green := Byte(EndColor shr 8) shl 8;
    Alpha := Byte(EndColor shr 24) shl 8;
  end;

  rectGradient.UpperLeft := 0;
  rectGradient.LowerRight := 1;
  if ADirection = gdVertical then
    Mode := GRADIENT_FILL_RECT_V
  else
    Mode := GRADIENT_FILL_RECT_H;
  tempDC := DC;
  ABitmap := 0;
  if // (Win32MajorVersion >=6) and
    (((StartColor and AlphaMask) <> AlphaMask) or ((EndColor and AlphaMask) <> AlphaMask)) or (Alpha < $FF) then
  begin
    HOldBmp := 0;
    try
      with udtVertex[1] do
      begin
        dec(X, udtVertex[0].X);
        dec(Y, udtVertex[0].Y);
      end;
      with udtVertex[0] do
      begin
        X := 0;
        Y := 0;
      end;
      tempDC := CreateCompatibleDC(DC);

      // HOldBmp := 0;
      with ARect do
      if ((udtVertex[1].X) > 0) and ((udtVertex[1].Y) > 0) then
      begin
        BI.bmiHeader.biSize := SizeOf(TBitmapInfoHeader);
        BI.bmiHeader.biWidth := udtVertex[1].X;
        BI.bmiHeader.biHeight := udtVertex[1].Y;
        BI.bmiHeader.biPlanes := 1;
        BI.bmiHeader.biBitCount := 32;
        BI.bmiHeader.biCompression := BI_RGB;
        ABitmap := CreateDIBitmap(DC, BI.bmiHeader, 0, NIL, BI, DIB_RGB_COLORS);
        // CreateDIBSection(DC, BI, DIB_RGB_COLORS, )
        // ABitmap := CreateCompatibleBitmap(DC, udtVertex[1].x, udtVertex[1].y);
        if (ABitmap = 0) and (udtVertex[1].X > 0) and (udtVertex[1].Y > 0) then
        begin
          DeleteDC(tempDC);
          tempDC := 0;
          raise EOutOfResources.Create('Out of Resources');
        end;
        HOldBmp := SelectObject(tempDC, ABitmap);
        // SetWindowOrgEx(tempDC, Left, Top, Nil);
      end else
        ABitmap := 0;

      if GradientFill(tempDC, @udtVertex, 2, @rectGradient, 1, Mode) then
      begin
        blend.AlphaFormat := AC_SRC_ALPHA;
        blend.BlendOp := AC_SRC_OVER;
        blend.BlendFlags := 0;
        blend.SourceConstantAlpha := Alpha;
        AlphaBlend(DC, ARect.Left, ARect.Top, ARect.Right - ARect.left, ARect.Bottom - ARect.Top, tempDC, 0, 0,
                       udtVertex[1].X, udtVertex[1].Y, blend)
      end;
    finally
      SelectObject(tempDC, HOldBmp);
      DeleteObject(ABitmap);
      if tempDC <> DC then
        DeleteDC(tempDC);
    end;
  end else
    GradientFill(DC, @udtVertex, 2, @rectGradient, 1, Mode);
end;

procedure FillRoundRectangle(DC: HDC; ARect: TRect; clr: cardinal);
var
  oldBr, brF: HBRUSH;
  oldPen, Hp: HPEN;
begin
  if (clr and AlphaMask) = AlphaMask then
    Exit;

  brF := CreateSolidBrush(clr);
  Hp := CreatePen(PS_SOLID, 1, addLuminosity(clr, -0.2));
  oldPen := SelectObject(DC, Hp);
  oldBr := SelectObject(DC, brF);
  RoundRect(DC, ARect.left, ARect.Top, ARect.Right, ARect.Bottom, 3, 3);
  SelectObject(DC, oldPen);
  DeleteObject(Hp);
  SelectObject(DC, oldBr);
  // FrameRect(DC, rB, brF);
  DeleteObject(brF);
end;

procedure DrawTextTransparent(DC: HDC; X, Y: Integer; const Text: String; Font: TFont; Alpha: Byte; fmt: Integer);
var
  tempDC: HDC;
  tempBitmap: TBitmap;
  blend: BLENDFUNCTION;
  oldFont: HFONT;
  R: TRect;
  res: TSize;
  I, k, h, w: Integer;
  Scan32: pColor32Array;
begin
  // SetBKMode(cnv.Handle, oldMode);
  R.left := 0;
  R.Top := 0;
  R.Right := MAXWORD;
  R.Bottom := MAXWORD;
  oldFont := SelectObject(DC, Font.Handle);
  DrawText(DC, PChar(Text), -1, R, DT_CALCRECT or fmt);
  GetTextExtentPoint32(DC, PChar(Text), Length(Text), res);
  SelectObject(DC, oldFont);
  R.Right := res.cx;
  R.Bottom := res.cy;
  // tempBitmap := createBitmap(res.cx, res.cy);
  tempBitmap := TBitmap.Create;
  tempBitmap.PixelFormat := pf32bit;
  tempBitmap.SetSize(res.cx, res.cy);
  tempDC := tempBitmap.Canvas.Handle;

  oldFont := SelectObject(tempDC, Font.Handle);
  SetTextColor(tempDC, ColorToRGB(Font.Color));
  SetBKMode(tempDC, Transparent);
  FillRect(tempDC, R, GetStockObject(WHITE_BRUSH));
  DrawText(tempDC, PChar(Text), Length(Text), R, fmt);
  SelectObject(tempDC, oldFont);
  h := res.cy - 1; // <20><> <20><> 1 !!!
  w := res.cx - 1; // <20><> <20><> 1 !!!

  for I := 0 to h do
  begin
    Scan32 := tempBitmap.ScanLine[I];
    for k := 0 to w do
    begin
      with Scan32^[k] do
      begin
        if (Color and $FFFFFF) <> $FFFFFF then
          A := $FF
        else
          A := 0;
      end;
    end;
  end;
  try
    begin
      blend.AlphaFormat := AC_SRC_ALPHA;
      blend.BlendOp := AC_SRC_OVER;
      blend.BlendFlags := 0;
      blend.SourceConstantAlpha := Alpha;
      AlphaBlend(DC, X, Y, res.cx, res.cy, tempDC, 0, 0, res.cx, res.cy, blend);
    end;
  finally
    FreeAndNil(tempBitmap);
  end
end;

//procedure DrawText32(DC: HDC; TextRect: TRect; const Text: String; Font: TFont; TextFlags: cardinal);
//var
//  TextLen: Integer;
//  Options: TDTTOpts;
//  MemDC: HDC;
//  PaintBuffer: HPAINTBUFFER;
//  oldF: HFONT;
//begin
//  TextLen := Length(Text);
//  FillChar(Options, SizeOf(Options), 0);
//  Options.dwSize := SizeOf(Options);
//  Options.dwFlags := DTT_COMPOSITED or DTT_GLOWSIZE or DTT_TEXTCOLOR;
//  // Options.dwFlags := DTT_GLOWSIZE or DTT_TEXTCOLOR;
//  // Options.dwFlags := DTT_COMPOSITED or DTT_GLOWSIZE;
//  Options.iGlowSize := 5;
//  Options.crText := ColorToRGB(Font.Color);
//  PaintBuffer := BeginBufferedPaint(DC, TextRect, BPBF_TOPDOWNDIB, nil, MemDC);
//  try
//    BufferedPaintClear(PaintBuffer, @TextRect);
//    // SetBKMode(MemDC, TRANSPARENT);
//    oldF := SelectObject(MemDC, Font.Handle);
//    // FillRect(MemDC, R, GetStockObject(BLACK_BRUSH));
//    // FillRect(MemDC, R, GetStockObject(LTGRAY_BRUSH));
//    // DrawText(MemDC, PChar(Text), Length(Text), R, fmt);
//    // with StyleServices.GetElementDetails(twCaptionActive) do
//    // DrawThemeTextEx(StyleServices.Theme[element], MemDC, Part, State,
//    // DrawThemeTextEx(StyleServices.Theme[teWindow], MemDC, 0, 0,
//    DrawThemeTextEx(StyleServices.Theme[teWindow], MemDC, 0, 0, PWideChar(wideString(Text)), TextLen, TextFlags,
//      @TextRect, Options);
//    SelectObject(MemDC, oldF);
//    // DeleteObject(oldF);
//    // BufferedPaintMakeOpaque(PaintBuffer, @R);
//  finally
//    EndBufferedPaint(PaintBuffer, True);
//  end;
//end;

function LoadAGifFromStream(var NonAnimated: boolean; Stream: TStream): TRnQBitmap;
var
  AGif: TGIF;
//  AGifChat: TGIFImage;
//  AGifFrame: TGIFFrame;
  frame: TAniFrame;
  I: Integer;
  ABitmap, AMask: TBitmap;
begin
  Result := Nil;
  if not Assigned(Stream) then
    Exit;
  with Result do
    try
      NonAnimated := True;
      Result := TRnQBitmap.Create;
      Result.fFormat := PA_FORMAT_GIF;
      fBmp := TBitmap.Create;

//      if resample then
//      begin
//        AGifChat := TGIFImage.Create;
//        AGifChat.LoadFromStream(Stream);
//        AGifFrame := AGifChat.Images.Frames[0];
//        fWidth := AGifFrame.Width;
//        fHeight := AGifFrame.Height;
//        FNumFrames := 1;
//        fAnimated := false;
//        FNumIterations := 0;
//        htTransparent := AGifChat.Transparent;
//
//        ABitmap := TBitmap.Create;
//        ABitmap.Assign(AGifFrame.bitmap);
//
//        AMask := TBitmap.Create;
//        AMask.Handle := AGifFrame.Mask;
//        AMask.Dormant;
//
//        try
//          ResampleProportional(ABitmap);
//          fWidth := ABitmap.Width;
//          fHeight := ABitmap.Height;
//          fBmp.Assign(ABitmap);
//
//          htTransparent := AMask.Handle > 0;
//          if (htTransparent) then
//          begin
//            AMask.PixelFormat := pf1bit;
//            ResampleProportional(AMask);
//            AMask.PixelFormat := pf1bit;
//            htMask := AMask;
//          end;
//        finally
//          ABitmap.Free;
//          AGifChat.Free;
//        end;
//      end
//      else
//      begin
        AGif := TGIF.Create;
        AGif.LoadFromStream(Stream);
        Result.FNumFrames := AGif.ImageCount;
        Result.fAnimated := Result.FNumFrames > 1;
        NonAnimated := not Result.fAnimated;
        Result.fWidth := AGif.Width;
        Result.fHeight := AGif.Height;
        Result.FNumIterations := AGif.LoopCount;
        if Result.FNumIterations < 0 then { -1 means no loop block }
          Result.FNumIterations := 1
        else if Result.FNumIterations > 0 then
          inc(Result.FNumIterations); { apparently this is the convention }
        Result.htTransparent := AGif.Transparent;
        ABitmap := AGif.GetStripBitmap(AMask);

        try
          fBmp.Assign(ABitmap);
          htMask := AMask;
          htTransparent := Assigned(AMask);
        finally
          ABitmap.Free;
        end;

        if fBmp.Palette <> 0 then
          DeleteObject(fBmp.ReleasePalette);
        fBmp.Palette := CopyPalette(ThePalette);

        if Result.fAnimated then
        begin
          if not Assigned(Result.fFrames) then
            Result.fFrames := TAniFrameList.Create;
          for I := 0 to Result.FNumFrames - 1 do
          begin
            frame := TAniFrame.Create;
            try
              frame.frDisposalMethod := TAniDisposalType(AGif.ImageDisposal[I]);
              frame.frLeft := AGif.ImageLeft[I];
              frame.frTop := AGif.ImageTop[I];
              frame.frWidth := AGif.ImageWidth[I];
              frame.frHeight := AGif.ImageHeight[I];
              // Frame.frDelay := IntMax(30, AGif.ImageDelay[I] * 10);
              frame.frDelay := IntMax(100, AGif.ImageDelay[I] * GIFDelayExp);
            except
              frame.Free;
              Raise;
            end;
            Result.fFrames.Add(frame);
          end;
          Result.WasDisposal := dtToBackground;
        end;
        AGif.Free;
//      end;
    except
      FreeAndNil(Result);
    end;
end;

{ ----------------TRnQBitmap.NextFrame }
procedure TRnQBitmap.NextFrame(OldFrame: Integer);
begin
  WasDisposal := fFrames[OldFrame].frDisposalMethod;
end;

{ ----------------TRnQBitmap.SetCurrentFrame }
procedure TRnQBitmap.SetCurrentFrame(AFrame: Integer);
begin
  if AFrame = FCurrentFrame then
    Exit;

  NextFrame(FCurrentFrame);
  if AFrame > FNumFrames then
    FCurrentFrame := 1
  else if AFrame < 1 then
    FCurrentFrame := FNumFrames
  else
    FCurrentFrame := AFrame;
  if fAnimated then
    WasDisposal := dtToBackground;
end;

{ ----------------TRnQBitmap.RnQCheckTime }
function TRnQBitmap.RnQCheckTime: boolean;
var
  ThisTime: DWord;
begin
  Result := false;
  if not fAnimated then
    Exit;

  // FCurrentFrame := 6; exit;

  ThisTime := timeGetTime;
  if ThisTime - LastTime < CurrentInterval then
    Exit;

  LastTime := ThisTime;

  if (FCurrentFrame = FNumFrames) then
  begin
    if (FNumIterations > 0) and (CurrentIteration >= FNumIterations) then
    begin
      // SetAnimate(False);
      Exit;
    end;
    inc(CurrentIteration);
  end;
  NextFrame(FCurrentFrame);
  inc(FCurrentFrame);
  Result := True;
  if (FCurrentFrame > FNumFrames) or (FCurrentFrame <= 0) then
    FCurrentFrame := 1;

  // InvalidateRect(WinControl.Handle, @FStretchedRect, True);

  CurrentInterval := IntMax(fFrames[FCurrentFrame].frDelay, 1);
end;

//function CreateAni(const fn: String; var b: boolean): TRnQBitmap; {$IFDEF HAS_INLINE} inline; {$ENDIF HAS_INLINE}
//var
//  Stream: TFileStream;
//begin
//  Result := Nil;
//  // result := CreateAGif(fn, b);
//  try
//    Stream := TFileStream.Create(fn, fmOpenRead or fmShareDenyWrite);
//    try
//      Result := LoadAGifFromStream(b, Stream);
//    finally
//      Stream.Free;
//    end;
//  except
//  end;
//end;
//
//function CreateAni(fs: TStream; var b: boolean): TRnQBitmap; {$IFDEF HAS_INLINE} inline; {$ENDIF HAS_INLINE}
//begin
//  Result := LoadAGifFromStream(b, fs);
//end;

function gpColorFromAlphaColor(Alpha: Byte; Color: TColor): cardinal;
begin
  Result := (Alpha shl 24) or (ABCD_ADCB(ColorToRGB(Color)) and $FFFFFF);
end;

function color2hls(clr: TColor): Thls;
var
  R, G, b, A, z, d: double;
begin
  clr := ColorToRGB(clr);
  R := GetRValue(clr) / 255;
  G := GetGValue(clr) / 255;
  b := GetBValue(clr) / 255;
  A := Min(Min(R, G), b);
  z := Max(Max(R, G), b);
  d := z - A;
  with Result do
  begin
    l := z;
    if d = 0 then
    begin
      h := 0;
      s := 0;
      Exit;
    end;
    // if l < 0.5 then s:=d/(z+a) else s:=d/(2-z-a);
    if z = 0 then
      s := 0
    else
      Result.s := d / z;
    if R = z then
      h := (G - b) / d;
    if G = z then
      h := 2 + (b - R) / d;
    if b = z then
      h := 4 + (R - G) / d;
  end;
end; // color2hls

function hls2color(hls: Thls): TColor;
var
  R, G, b, p, q, t: double;
begin
  with hls do
    if s = 0 then
    begin
      R := l;
      G := l;
      b := l;
    end
    else
    begin
      p := l * (1.0 - s);
      q := l * (1.0 - (s * frac(h)));
      t := l * (1.0 - (s * (1.0 - frac(h))));

      case trunc(h) of
        0:
          begin
            R := l;
            G := t;
            b := p
          end;
        1:
          begin
            R := q;
            G := l;
            b := p
          end;
        2:
          begin
            R := p;
            G := l;
            b := t
          end;
        3:
          begin
            R := p;
            G := q;
            b := l
          end;
        4:
          begin
            R := t;
            G := p;
            b := l
          end;
      else
        begin
          R := l;
          G := p;
          b := q
        end;
      end;
    end;
  Result := round(R * 255) + round(G * 255) shl 8 + round(b * 255) shl 16;
end; // hls2color

function addLuminosity(clr: TColor; q: real): TColor;
var
  hls: Thls;
begin
  hls := color2hls(clr);
  with hls do
  begin
    l := l + q;
    if l < 0 then
      l := 0;
    if l > 1 then
      l := 1;
  end;
  Result := hls2color(hls);
end; // addLuminosity

function MidColor(clr1, clr2: cardinal): cardinal;
begin
  Result := 0;
  Result := Result + ((Byte(clr1 shr 24) + Byte(clr2 shr 24)) div 2) shl 24;
  Result := Result + ((Byte(clr1 shr 16) + Byte(clr2 shr 16)) div 2) shl 16;
  Result := Result + ((Byte(clr1 shr 8) + Byte(clr2 shr 8)) div 2) shl 8;
  Result := Result + ((Byte(clr1) + Byte(clr2)) div 2);
end;

function MidColor(const clr1, clr2: cardinal; koef: double): cardinal; overLoad;
var
  r1, g1, b1, A1: Byte;
  r2, g2, b2, a2: Byte;
  k1: double;
begin
  r1 := Byte(clr1 shr 24);
  g1 := Byte(clr1 shr 16);
  b1 := Byte(clr1 shr 8);
  A1 := Byte(clr1);
  r2 := Byte(clr2 shr 24);
  g2 := Byte(clr2 shr 16);
  b2 := Byte(clr2 shr 8);
  a2 := Byte(clr2);
  k1 := 1 - koef;
  Result := (trunc(r1 * k1 + r2 * koef)) shl 24 + trunc(g1 * k1 + g2 * koef) shl 16 + trunc(b1 * k1 + b2 * koef) shl 8 +
    trunc(A1 * k1 + a2 * koef);
  { result := 0;
    result := result + trunc((byte(clr1 shr 24)*(1-koef) + byte(clr2 shr 24)*koef) ) shl 24;
    result := result + trunc((byte(clr1 shr 16)*(1-koef) + byte(clr2 shr 16)*koef) ) shl 16;
    result := result + trunc((byte(clr1 shr 8)*(1-koef) + byte(clr2 shr 8)*koef) ) shl 8;
    result := result + trunc((byte(clr1)*(1-koef) + byte(clr2)*koef) );
  }
end;

function bmp2ico2(bitmap: TBitmap): Ticon;
var
  // iconX, iconY : integer;
  IconInfo: TIconInfo;
  IconBitmap, MaskBitmap: TBitmap;
  // dx,dy,
  X, Y: Integer;
  tc: TColor;
begin
  if bitmap = NIL then
  begin
    Result := NIL;
    Exit;
  end;

  IconBitmap := createBitmap(icon_size, icon_size);
  IconBitmap.PixelFormat := bitmap.PixelFormat;
  StretchBlt(IconBitmap.Canvas.Handle, 0, 0, icon_size, icon_size, bitmap.Canvas.Handle, 0, 0, bitmap.Width,
    bitmap.Height, SRCCOPY);
  // iconX := GetSystemMetrics(SM_CXICON);
  // iconY := GetSystemMetrics(SM_CYICON);
  // IconBitmap:= TBitmap.Create;
  // IconBitmap.Width:= iconX;
  // IconBitmap.Height:= iconY;
  IconBitmap.TransparentColor := bitmap.TransparentColor;
  tc := bitmap.TransparentColor and $FFFFFF;
  bitmap.Transparent := false;
  // IconBitmap.Width :=
  { with IconBitmap.Canvas do
    begin
    dx:=bitmap.width*2;
    dy:=bitmap.height*2;
    if (dx < iconX) and (dy < iconY) then
    begin
    brush.color:=tc;
    fillrect(clipRect);
    x:=(iconX-dx) div 2;
    y:=(iconY-dy) div 2;
    StretchDraw(Rect(x,y,x+dx,y+dy), Bitmap);
    end
    else
    IconBitmap.Canvas.StretchDraw(Rect(0, 0, iconX, iconY), Bitmap);
    end; }
  MaskBitmap := TBitmap.Create;
  MaskBitmap.Assign(IconBitmap);
  bitmap.Transparent := True;
  with IconBitmap.Canvas do
    for Y := 0 to icon_size - 1 do
      for X := 0 to icon_size - 1 do
        if Pixels[X, Y] = tc then
          Pixels[X, Y] := clBlack;
  IconInfo.fIcon := True;
  IconInfo.hbmMask := MaskBitmap.MaskHandle;
  IconInfo.hbmColor := IconBitmap.Handle;
  Result := Ticon.Create;
  Result.Handle := CreateIconIndirect(IconInfo);
  MaskBitmap.Free;
  IconBitmap.Free;
end; // bmp2ico

function bmp2ico3(bitmap: TBitmap): Ticon;
var
  il: THandle;
  hi: HICON;
begin
  Result := Ticon.Create;
  il := ImageList_Create(icon_size, icon_size, ILC_COLOR32 or ILC_MASK, 0, 0);
  ImageList_Add(il, bitmap.Handle, bitmap.MaskHandle);
  hi := ImageList_ExtractIcon(0, il, 0);
  Result.Handle := hi;
  // DestroyIcon(hi);
  ImageList_Destroy(il);
end;

function bmp2ico32(bitmap: TBitmap): HICON;
var
  il: THandle;
  I: Integer;
begin
  il := ImageList_Create(Min(bitmap.Width, bitmap.Height), Min(bitmap.Width, bitmap.Height), ILC_COLOR32, 0, 0);
  I := ImageList_Add(il, bitmap.Handle, bitmap.Handle);
  if I >= 0 then
    Result := ImageList_ExtractIcon(0, il, I)
  else
    Result := 0;
  // DestroyIcon(hi);
  ImageList_Destroy(il);
end;

function bmp2ico4M(bitmap: TBitmap): HICON;
var
  il: THandle;
  I: Integer;
begin
  il := ImageList_Create(Min(bitmap.Width, icon_size), Min(bitmap.Height, icon_size), ILC_COLOR32 or ILC_MASK, 0, 0);
  I := ImageList_Add(il, bitmap.Handle, bitmap.MaskHandle);
  if I >= 0 then
    Result := ImageList_ExtractIcon(0, il, I)
  else
    Result := 0;
  // DestroyIcon(hi);
  ImageList_Destroy(il);
end;

function bmp2ico(bitmap: TBitmap): Ticon;
var
  iconX, iconY: Integer;
  IconInfo: TIconInfo;
  IconBitmap, MaskBitmap: TBitmap;
  DX, DY, X, Y: Integer;
  tc: TColor;
begin
  if bitmap = NIL then
  begin
    Result := NIL;
    Exit;
  end;
  iconX := GetSystemMetrics(SM_CXICON);
  iconY := GetSystemMetrics(SM_CYICON);
  IconBitmap := TBitmap.Create;
  IconBitmap.Width := iconX;
  IconBitmap.Height := iconY;
  IconBitmap.TransparentColor := bitmap.TransparentColor;
  tc := bitmap.TransparentColor and $FFFFFF;
  bitmap.Transparent := false;
  // IconBitmap.Width :=
  with IconBitmap.Canvas do
  begin
    DX := bitmap.Width * 2;
    DY := bitmap.Height * 2;
    if (DX < iconX) and (DY < iconY) then
    begin
      Brush.Color := tc;
      FillRect(ClipRect);
      X := (iconX - DX) div 2;
      Y := (iconY - DY) div 2;
      StretchDraw(Rect(X, Y, X + DX, Y + DY), bitmap);
    end
    else
      IconBitmap.Canvas.StretchDraw(Rect(0, 0, iconX, iconY), bitmap);
  end;
  MaskBitmap := TBitmap.Create;
  MaskBitmap.Assign(IconBitmap);
  bitmap.Transparent := True;
  with IconBitmap.Canvas do
    for Y := 0 to iconY - 1 do
      for X := 0 to iconX - 1 do
        if Pixels[X, Y] = tc then
          Pixels[X, Y] := clBlack;
  IconInfo.fIcon := True;
  IconInfo.hbmMask := MaskBitmap.MaskHandle;
  IconInfo.hbmColor := IconBitmap.Handle;
  Result := Ticon.Create;
  Result.Handle := CreateIconIndirect(IconInfo);
  MaskBitmap.Free;
  IconBitmap.Free;
end; // bmp2ico

function pic2ico(pic: TBitmap): Ticon;
begin
  Result := bmp2ico(pic)
end;

procedure ico2bmp(ico: Ticon; bmp: TBitmap);
begin
  bmp.Width := icon_size; // ico.Width;
  bmp.Height := icon_size;
  bmp.PixelFormat := pf24bit;
  bmp.Canvas.Brush.Color := $010100;
  bmp.Canvas.FillRect(bmp.Canvas.ClipRect);
  bmp.Canvas.StretchDraw(Rect(0, 0, icon_size, icon_size), ico);
  bmp.TransparentColor := $010100;
  bmp.Transparent := True;
end;

procedure ico2bmp2(pIcon: HICON; bmp: TBitmap);
var
  ilH: HIMAGELIST;
begin
  bmp.SetSize(icon_size, icon_size);
  bmp.TransparentColor := $010100;
  ilH := ImageList_Create(icon_size, icon_size, ILC_COLOR32 or ILC_MASK, 0, 0);
  ImageList_AddIcon(ilH, pIcon);
  ImageList_DrawEx(ilH, 0, bmp.Canvas.Handle, 0, 0, 0, 0, bmp.TransparentColor, CLR_NONE, ILD_NORMAL);
  ImageList_Destroy(ilH);
  bmp.Transparent := True;
end;

function TrimInt(I, Min, Max: Integer): Integer;
begin
  if I > Max then
    Result := Max
  else if I < Min then
    Result := Min
  else
    Result := I;
end;

function IntToByte(I: Integer): Byte;
begin
  if I > 255 then
    Result := 255
  else if I < 0 then
    Result := 0
  else
    Result := I;
end;

procedure SmoothRotate(var Src, Dst: TBitmap; cx, cy: Integer; Angle: Extended);
type
  TFColor = record
    b, G, R, A: Byte end;

  const
    colorBytes = 4;

  var
    Top, Bottom, eww, nsw, fx, fy: Extended;
    cAngle, sAngle: double;
    xDiff, yDiff, ifx, ify, px, py, ix, iy, X, Y: Integer;
    nw, ne, sw, se: TFColor;
    P1, P2, P3: Pbytearray;
  begin
    Angle := -Angle * Pi / 180;
    sAngle := Sin(Angle);
    cAngle := Cos(Angle);
    xDiff := (Dst.Width - Src.Width) div 2;
    yDiff := (Dst.Height - Src.Height) div 2;
    for Y := 0 to Dst.Height - 1 do
    begin
      P3 := Dst.ScanLine[Y];
      py := 2 * (Y - cy) + 1;
      for X := 0 to Dst.Width - 1 do
      begin
        px := 2 * (X - cx) + 1;
        fx := (((px * cAngle - py * sAngle) - 1) / 2 + cx) - xDiff;
        fy := (((px * sAngle + py * cAngle) - 1) / 2 + cy) - yDiff;
        ifx := round(fx);
        ify := round(fy);

        if (ifx > -1) and (ifx < Src.Width) and (ify > -1) and (ify < Src.Height) then
        begin
          eww := fx - ifx;
          nsw := fy - ify;
          iy := TrimInt(ify + 1, 0, Src.Height - 1);
          ix := TrimInt(ifx + 1, 0, Src.Width - 1);
          P1 := Src.ScanLine[ify];
          P2 := Src.ScanLine[iy];
          nw.R := P1[ifx * colorBytes];
          nw.G := P1[ifx * colorBytes + 1];
          nw.b := P1[ifx * colorBytes + 2];
          nw.A := P1[ifx * colorBytes + 3];

          ne.R := P1[ix * colorBytes];
          ne.G := P1[ix * colorBytes + 1];
          ne.b := P1[ix * colorBytes + 2];
          ne.A := P1[ix * colorBytes + 3];

          sw.R := P2[ifx * colorBytes];
          sw.G := P2[ifx * colorBytes + 1];
          sw.b := P2[ifx * colorBytes + 2];
          sw.A := P2[ifx * colorBytes + 3];

          se.R := P2[ix * colorBytes];
          se.G := P2[ix * colorBytes + 1];
          se.b := P2[ix * colorBytes + 2];
          se.A := P2[ix * colorBytes + 3];

          Top := nw.A + eww * (ne.A - nw.A);
          Bottom := sw.A + eww * (se.A - sw.A);
          P3[X * colorBytes + 3] := IntToByte(round(Top + nsw * (Bottom - Top)));

          Top := nw.b + eww * (ne.b - nw.b);
          Bottom := sw.b + eww * (se.b - sw.b);
          P3[X * colorBytes + 2] := IntToByte(round(Top + nsw * (Bottom - Top)));

          Top := nw.G + eww * (ne.G - nw.G);
          Bottom := sw.G + eww * (se.G - sw.G);
          P3[X * colorBytes + 1] := IntToByte(round(Top + nsw * (Bottom - Top)));

          Top := nw.R + eww * (ne.R - nw.R);
          Bottom := sw.R + eww * (se.R - sw.R);
          P3[X * colorBytes] := IntToByte(round(Top + nsw * (Bottom - Top)));
        end;
      end;
    end;
  end;

  procedure CalcPalette(DC: HDC);

  { calculate a rainbow palette, one with equally spaced colors }
  const
    Values: array [0 .. 5] of Integer = (55, 115, 165, 205, 235, 255);

  var
    LP: ^TLogPalette;
    I, J, k, Sub: Integer;
  begin
    GetMem(LP, SizeOf(TLogPalette) + 256 * SizeOf(TPaletteEntry));
    try
      with LP^ do
      begin
        palVersion := $300;
        palNumEntries := 256;
        GetSystemPaletteEntries(DC, 0, 256, palPalEntry);
        Sub := 10; { start at entry 10 }
        for I := 0 to 5 do
          for J := 0 to 5 do
            for k := 0 to 5 do
              if not((I = 5) and (J = 5) and (k = 5)) then { skip the white }
                with palPalEntry[Sub] do
                begin
                  peBlue := Values[I];
                  peGreen := Values[J];
                  peRed := Values[k];
                  peFlags := 0;
                  inc(Sub);
                end;
        for I := 1 to 24 do
          if not(I in [7, 15, 21]) then { these would be duplicates }
            with palPalEntry[Sub] do
            begin
              peBlue := 130 + 5 * I;
              peGreen := 130 + 5 * I;
              peRed := 130 + 5 * I;
              peFlags := 0;
              inc(Sub);
            end;
        ThePalette := CreatePalette(LP^);
      end;
    finally
      FreeMem(LP, SizeOf(TLogPalette) + 256 * SizeOf(TPaletteEntry));
    end;
  end;

  function blend(c1, c2: TColor; left: real): TColor;

  var
    Right: real;
    // clr1 : Tcolor32;
  begin
    Right := 1 - left;
    c1 := ColorToRGB(c1);
    c2 := ColorToRGB(c2);
    Result := rgb(round(left * (c1 and $FF) + Right * (c2 and $FF)), round(left * (c1 shr 8 and $FF) + Right * (c2 shr 8 and $FF)
      ), round(left * (c1 shr 16) + Right * (c2 shr 16)));
  end; // blend

  function traspBmp1(bmp: TBitmap; bg: TColor; transpLevel: Integer): TBitmap;

  var
    A, t: TColor;
    X, Y, R, G, b: Integer;
  begin
    Result := TBitmap.Create;
    Result.Assign(bmp);
    bg := ColorToRGB(bg);
    R := transpLevel * (bg and $FF);
    G := transpLevel * (bg shr 8 and $FF);
    b := transpLevel * (bg shr 16);
    bg := R + G + b;
    t := Result.TransparentColor and $FFFFFF;
    with Result.Canvas do
      for X := 0 to Result.Width - 1 do
        for Y := 0 to Result.Height - 1 do
        begin
          A := Pixels[X, Y] and $FFFFFF;
          if A = t then
            continue;
          R := A and $FF;
          G := A shr 8 and $FF;
          b := A shr 16;
          A := (R + G + b + bg) div ((transpLevel + 1) * 3);
          Pixels[X, Y] := rgb(A, A, A);
        end;
    Result.Transparent := bmp.Transparent;
    Result.TransparentColor := bmp.TransparentColor;
  end; // traspBmp

  var
    DC: HDC;
    ColorBits: Byte;

initialization

DC := GetDC(0);
try
  ColorBits := GetDeviceCaps(DC, BITSPIXEL) * GetDeviceCaps(DC, PLANES);

  if ColorBits <= 4 then
    ColorBits := 4
  else if ColorBits <= 8 then
    ColorBits := 8
  else
    ColorBits := 24;

  ThePalette := 0;
  if ColorBits = 8 then
    CalcPalette(DC);
finally
  ReleaseDC(0, DC);
end;

finalization

if ThePalette <> 0 then
  DeleteObject(ThePalette);

end.