RnQ/for.RnQ/RTL/RnQGraphics32.pas

unit RnQGraphics32;
{$I ForRnQConfig.inc}

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

interface

uses
  Messages, Windows, SysUtils, Types, Classes,
  Graphics,
  Forms,
  Controls,
  Generics.Collections,
  ActiveX,
{$IFDEF RNQ}
  RDFileUtil,
{$ENDIF RNQ}
  RDGlobal,
  Vcl.Imaging.PNGImage, Vcl.Imaging.GIFImg, cgJpeg,
  GR32, GR32_Resamplers, Murmur2;

{$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);

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

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 Draw32bit(DC: HDC; DX, DY: Integer);
    procedure SetCurrentFrame(AFrame: Integer);
    procedure NextFrame(OldFrame: Integer);
  public
    constructor Create; overload;
    constructor Create(Width, Heigth: Integer); Overload;
    constructor Create(fn: String); Overload;
    constructor Create(hi: HICON); Overload;
    destructor Destroy; override;
    procedure Clear;
    procedure MakeEmpty;
    // procedure   Free; overload;
    // function  loadPic(fn:string):Tbitmap;

    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; DestR : TRect; SrcX, SrcY, SrcW, SrcH : Integer; pEnabled : Boolean= True; isCopy : Boolean= false); Overload;
    procedure Draw(DC: HDC; DestBnd, SrcBnd: TGPRect; pEnabled: boolean = True; isCopy32: boolean = false); Overload;
    // procedure Draw(DC: HDC; DestR, SrcR: TRect); Overload;
    procedure Draw(DC: HDC; DestR: TGPRect); Overload;
    // function  Clone(x, y, pWidth, pHeight: Integer): TRnQBitmap;
    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(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; DestRect : TRect; SrcX, SrcY, SrcW, SrcH : Integer; pEnabled : Boolean= True); OverLoad; 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; name: string = '';
  fromChat: boolean = false): boolean; Overload;
{$IFDEF RNQ}
function loadPic(pt: TThemeSourcePath; fn: string; var bmp: TRnQBitmap; idx: Integer = 0): boolean; overload;
{$ENDIF RNQ}
function loadPic2(const fn: string; var bmp: TRnQBitmap): boolean; // if not loaded then bmp is nil!

{ //function  loadPic(fn:string; bmp:Tbitmap):boolean; overload;
  function  loadPic(fn:string; bmp:Tbitmap; idx : Integer = 0):boolean; overload;
  function  loadPic(fn:string; img:Timage):boolean; overload;
  function  loadPic(fn:string; var bmp:TGpBitmap; idx : Integer = 0):boolean; overload;
  function  loadPic(fs:TStream; bmp:Tbitmap; idx : Integer = 0; name : string = ''):boolean; overload;
  //function  loadPic(fs:TStream; var bmp:TGPbitmap; idx : Integer = 0):boolean; overload;
  function  loadPic(fs:TStream; var bmp:TGPbitmap; idx : Integer = 0; name : string = ''):boolean; overload;
  //procedure loadIco(fn:string; var result:Ticon);
}

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; rnd: Word);
// Procedure FillRectangle(DC: HDC; ARect: TRect; Clr : Cardinal);
procedure DrawTextTransparent(DC: HDC; X, Y: Integer; Text: String; Font: TFont; Alpha: Byte; fmt: Integer);
procedure DrawText32(DC: HDC; TextRect: TRect; 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 GPtranspPColor(cl : Cardinal): Cardinal;
  // function transpColor(cl : TColor; alpha : Byte): TColor;
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;
// function  traspBmp1(bmp:Tbitmap; bg:Tcolor; transpLevel:integer):Tbitmap;

// 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(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; fromChat: boolean = false): TRnQBitmap;
procedure LoadPictureStream(str: TStream; var gpPicture: IPicture);
procedure Premultiply(var bmp: TBitmap);
procedure ConvertToRGBA(var png: TPNGImage);
procedure ResampleSticker(var bmp: TBitmap; MaxStickerHeight: Integer; MaxStickerWidth: Integer);
procedure ResampleFullscreen(var bmp: TBitmap; bRect: TRect; forceCosine: Boolean = False);
procedure ClearChatImageCache;

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;

const
  icon_size = 16;

implementation

uses
  StrUtils,
  math, mmSystem, Themes, UxTheme, UITypes,
  // DwmApi,
{$IFDEF UNICODE}
  AnsiStrings,
{$ENDIF UNICODE}
  // {$IFNDEF RNQ_LITE}
{$IFDEF USE_FLASH}
  ShockwaveFlashObjects_TLB,
  // FlashPlayerControl,
  ExtCtrls,
{$ENDIF USE_FLASH}
  CommCtrl,
  RDUtils,
{$IFDEF RNQ}
  RnQGlobal,
{$ENDIF RNQ}
  litegif1,
  uIconStream;

{
  type
  PColor24 = ^TColor24;
  TColor24 = record
  B, G, R: Byte;
  end;
  PColor24Array = ^TColor24Array;
  TColor24Array = array[0..MaxInt div SizeOf(TColor24) - 1] of TColor24;
}
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 }
  bitmapCache: TDictionary;

  { ----------------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;
  // FreeAndNil(fBMP32);
  inherited;
end;

{ procedure TRnQBitmap.Free;
  begin
  if Self <> nil then
  Destroy;
  end; }

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

  fAnimated := false;
  FCurrentFrame := 1;
  fFrames := NIL;
  FNumFrames := 0;
  // Frames := TAniFrameList.Create;
  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 := createBitmap(Width, Heigth);
  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(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 InitTransAlpha(bmp: TBitmap);
var
  Scan32: pColor32Array;
  I, X: cardinal;
  // A1: Double;
  h, w: Integer;
  bt: boolean;
  Trans: TColor32;
begin
  // if not bmp.Transparent then
  // Exit;
  bt := bmp.Transparent;
  h := bmp.Height - 1; // <20><> <20><> 1 !!!
  w := bmp.Width - 1; // <20><> <20><> 1 !!!

  Trans.Color := ColorToRGB(bmp.TransparentColor) and not AlphaMask;
  for I := 0 to h do
  begin
    Scan32 := bmp.ScanLine[I];
    for X := 0 to w do
    begin
      with Scan32^[X] do
      begin
        if bt and ((Color and not AlphaMask) = Trans.Color) then
          A := 0
        else
          A := $FF;
      end;
    end;
  end;
end;

procedure Premultiply(var bmp: TBitmap);
  function mult1(const A, b: Byte): Byte; {$IFDEF HAS_INLINE}inline; {$ENDIF HAS_INLINE}
  var
    I: Integer;
  begin
    if b = 255 then
      Result := A
    else if b = 0 then
      Result := 0
    else
    begin
      I := A;
      I := (I * b + $7F) shr 8;
      Result := I;
    end;
  end;

var
  Scan32: pColor32Array;
  I, X: cardinal;
  // A1: Double;
  h, w: Integer;
begin
  h := bmp.Height - 1; // <20><> <20><> 1 !!!
  w := bmp.Width - 1; // <20><> <20><> 1 !!!
  for I := 0 to h do
  begin
    Scan32 := bmp.ScanLine[I];
    for X := 0 to w do
    begin
      with Scan32^[X] do
      begin
        // B := (Integer(B)*A + $7F) shl 8;
        // R := (Integer(R)*A + $7F) shl 8;
        // G := (Integer(G)*A + $7F) shl 8;
        b := mult1(b, A);
        R := mult1(R, A);
        G := mult1(G, A);
      end;
    end;
  end;
end;

procedure Demultiply(bmp: TBitmap);
var
  Scan32: pColor32Array;
  I, X: cardinal;
  A1: double;
  h, w: Integer;
begin
  h := bmp.Height - 1;
  w := bmp.Width - 1;
  for I := 0 to h do
  begin
    Scan32 := bmp.ScanLine[I];
    for X := 0 to w do
      with Scan32^[X] do
      begin
        if A > 0 then
        begin
          A1 := A / $FF;
          R := round(R / A1);
          G := round(G / A1);
          b := round(b / A1);
        end;
      end;
  end;
end;

{ procedure LoadPictureFile(Name : String; var gpPicture : IPicture);
  var
  aFile     : HFILE;
  // pstm      : IStream;
  pvData    : Pointer;
  dwBytesRead   : DWORD;
  dwFileSize    : DWORD;
  Global    : HGLOBAL;
  i:longint;
  begin

  aFile := CreateFile(PChar(Name), GENERIC_READ, 0, NIL, OPEN_EXISTING, 0, 0);
  if aFile = INVALID_HANDLE_VALUE then
  Exit;
  dwFileSize := GetFileSize(aFile, NIL);
  if dwFileSize = -1 then
  Exit;

  pvData := NIL;

  Global := GlobalAlloc(GMEM_MOVEABLE, dwFileSize);
  if Global = 0 then
  begin
  CloseHandle(aFile);
  Exit;
  end;

  pvData := GlobalLock(Global);
  if pvData = NIL then
  Exit;

  dwBytesRead := 0;

  if not ReadFile(aFile, pvData^, dwFileSize, dwBytesRead, NIL) then
  Exit;

  GlobalUnlock(Global);
  CloseHandle(aFile);

  pstm := NIL;

  if CreateStreamOnHGlobal(Global, True, pstm) <> S_OK then
  Exit;
  if pstm = NIL then
  Exit;

  if Assigned(gpPicture) then
  gpPicture := NIL;
  if OleLoadPicture(pstm, dwFileSize, False, IID_IPicture, gpPicture) <> S_OK then
  begin
  pstm := NIL;
  Exit;
  end;
  GlobalFree(Global);
  pstm := NIL;
  end; }

procedure LoadPictureStream(str: TStream; var gpPicture: IPicture);
var
  stra: TStreamAdapter;
  dwFileSize: DWord;
  // Global    : HGLOBAL;
  // i:longint;
begin
  str.Position := 0;
  stra := TStreamAdapter.Create(str);
  dwFileSize := str.Size;
  try
    if Assigned(gpPicture) then
      gpPicture := NIL;
    // if OleLoadPicture(pstm, dwFileSize, False, IID_IPicture, gpPicture) <> S_OK then
    if OleLoadPicture(stra, dwFileSize, false, IID_IPicture, gpPicture) <> S_OK then
    begin
      // pstm := NIL;
      // stra.Free;
      // Exit;
    end;
    // GlobalFree(Global);
    // pstm := NIL;
  except
    // stra.Free;
    // stra.
  end;
end;

function loadPic2(const fn: string; var bmp: TRnQBitmap): boolean;
begin
  Result := loadPic(fn, bmp);
  if not Result then
    if Assigned(bmp) then
    begin
      bmp.Free;
      bmp := NIL;
    end;
end;

function loadPic(const fn: string; var bmp: TRnQBitmap; idx: Integer = 0): boolean;
var
  Stream: TStream;
{$IFDEF USE_FLASH}
  swf: TShockwaveFlash;
  // swf : TTransparentFlashPlayerControl;
  // swf : TFlashPlayerControl;
{$ENDIF USE_FLASH}
  // pnl : TPanel;
  // frm: TForm;
  // w, h: double;
  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;
  // Result := False;
  if (lowercase(SysUtils.ExtractFileExt(fn)) = '.ico') or (lowercase(SysUtils.ExtractFileExt(fn)) = '.icon') then
    ff := PA_FORMAT_ICO
    // {$IFNDEF RNQ_LITE}
  else if (lowercase(SysUtils.ExtractFileExt(fn)) = '.swf') then
  begin
{$IFDEF USE_FLASH}
    try
      // swf :=  TTransparentFlashPlayerControl.Create(Application.MainForm);
      // pnl := TPanel.Create(Application.MainForm);
      // pnl.Parent :=Application.MainForm;
      // pnl := TPanel.Create(Application);
      // pnl.Parent :=Application.MainForm;
      frm := TForm.Create(Application);
      frm.Width := maxSWFAVTW;
      frm.Height := maxSWFAVTH;
      try
        swf := TShockwaveFlash.Create(frm);
        // swf :=  TTransparentFlashPlayerControl.Create(pnl);
        // swf :=  TFlashPlayerControl.Create(pnl);
        swf.Visible := false;
        // swf.parent := Application.MainForm;
        swf.parent := frm;
        // swf.align  := alClient;
        swf.Movie := fn;
        // swf.
        // swf.BackgroundColor := clWindow;
        // swf.ClientWidth := 100;
        // pnl.Width := swf.ClientWidth + 2;
        // pnl.Width := 100;
        swf.Width := maxSWFAVTW;
        swf.Height := maxSWFAVTH;
        try
          w := swf.TGetPropertyNum('/', 8); // WIDTH
          h := swf.TGetPropertyNum('/', 9); // HEIGHT
        except
          w := 1;
          h := 1;
        end;
        if w = 0 then
          w := 1;
        if h = 0 then
          h := 1;

        if w * maxSWFAVTH < h * maxSWFAVTW then
        begin
          swf.Width := trunc(maxSWFAVTH * w / h);
          swf.Height := maxSWFAVTH;
        end
        else
        begin
          swf.Width := maxSWFAVTW;
          swf.Height := trunc(maxSWFAVTW * h / w);
        end;

        swf.GotoFrame(idx);
        swf.Repaint;
        // swf.SetVariable('wmode', 'transparent');
        // swf.TSetProperty('wmode', );
        swf.WMode := wideString('TRANSPARENT');
        // s := swf.BGColor;
        // if s = 'Black' then
        // swf.BackgroundColor := $00010101;
        if not Assigned(bmp.fBmp) then
          bmp.fBmp := createBitmap(swf.Width, swf.Height)
        else
        begin
          bmp.fBmp.Handle := 0;
          bmp.fBmp.SetSize(swf.Width, swf.Height);
        end;
        // FreeAndNil(bmp.fBmp);
        // fBmp.Canvas.Brush.Color:= clRed;// $00010101;
        // fBmp.Canvas.FillRect(fBmp.Canvas.ClipRect);
        // fBmp.Canvas.FillRect(fBmp.Canvas.ClipRect);
        // bmp.fBmp.PixelFormat := pf32bit;
        // bmp.fBmp := swf.CreateFrameBitmap;
        // bmp.f32Alpha := True;
        swf.PaintTo(bmp.fBmp.Canvas, 0, 0);
        // bmp.SetTransparentColor($00010101);
        // bmp.fBmp.Transparent := True;

        bmp.fWidth := bmp.fBmp.Width;
        bmp.fHeight := bmp.fBmp.Height;
        FreeAndNil(swf);
      finally
        FreeAndNil(frm);
      end;
      Result := True;
    except
      Result := false;
    end;
{$ELSE USE_FLASH}
    Result := false;
{$ENDIF USE_FLASH}
    Exit;
  end
  { if (lowercase(ExtractFileExt(fn)) = '.gif') then
    ff := PA_FORMAT_GIF
    else
    else
    if (lowercase(ExtractFileExt(fn)) = '.jpeg')
    or (lowercase(ExtractFileExt(fn)) = '.jpg') then
  }
  // {$ENDIF RNQ_LITE}
  else
    ff := PA_FORMAT_UNK;

  Stream := TFileStream.Create(fn, SysUtils.fmOpenRead or SysUtils.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
      if not Assigned(bmp.fBmp) then
        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);
    // fBmp.LoadFromFile();
  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
  MStr : TMemoryStream;
  begin
  if str is TMemoryStream then
  MStr := TMemoryStream( str )
  else
  begin
  MStr := TMemoryStream.Create;
  MStr.LoadFromStream(str);
  end;
  MStr.Position := 0;
  Result := CreateIconFromResourceEx(MStr.Memory, MStr.Size, True, $00030000,
  icon_size, icon_size,
  LR_DEFAULTCOLOR);

  if MStr <> str then
  begin
  MStr.Free;
  end;

  if Result = 0 then
  msgDlg(GetLastErrorText, False, mtError);
}
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;

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; forceCosine: Boolean = False; checkSize: Boolean = True);
begin
  if (ResamplingFilter >= 2) and checkSize and (bmp.Width * bmp.Height * GetBPP(bmp) / 8 > 5 * 1024 * 1024) then
    TDraftResampler.Create(bmpOrig)
  else if (ResamplingFilter >= 3) and forceCosine then
    AddFilter(bmpOrig, TCosineKernel.Create)
  else case ResamplingFilter of
    1:
      TDraftResampler.Create(bmpOrig);
    2:
      AddFilter(bmpOrig, TCosineKernel.Create);
    3:
      AddFilter(bmpOrig, TAlbrechtKernel.Create);
    4:
      AddFilter(bmpOrig, TMitchellKernel.Create);
    5:
      AddFilter(bmpOrig, TCubicKernel.Create);
    6:
      AddFilter(bmpOrig, THermiteKernel.Create);
    7:
      AddFilter(bmpOrig, TGaussianKernel.Create);
    8:
      AddFilter(bmpOrig, TBlackmanKernel.Create);
    9:
      AddFilter(bmpOrig, THannKernel.Create);
    10:
      AddFilter(bmpOrig, THammingKernel.Create);
    11:
      AddFilter(bmpOrig, TSinshKernel.Create);
    12:
      AddFilter(bmpOrig, TLanczosKernel.Create);
  end;
end;

function GetBitmapFromCache(hash: LongWord; var bmp: TRnQBitmap): Boolean;
var
  rnqbmp: TRnQBitmap;
  r: TGPRect;
begin
  Result := False;
  if not Assigned(bitmapCache) then Exit;

  if bitmapCache.TryGetValue(hash, rnqbmp) then
  begin
    bmp := rnqbmp.CloneAll;
    Result := True;
  end;
end;

procedure PutBitmapToCache(hash: LongWord; bmp: TRnQBitmap);
begin
  if not Assigned(bitmapCache) then
    bitmapCache := TDictionary.Create;

  if Assigned(bmp) then
  begin
    bitmapCache.AddOrSetValue(hash, bmp.CloneAll);
  end;
end;

procedure ClearChatImageCache;
var
  Key: Cardinal;
begin
  if Assigned(bitmapCache) then
  begin
    for Key in bitmapCache.Keys do
    if Assigned(bitmapCache[Key]) then
    begin
      if Assigned(bitmapCache[Key].fBmp) then
        FreeAndNil(bitmapCache[Key].fBmp);
      FreeAndNil(bitmapCache[Key].fBmp);
    end;
    bitmapCache.Clear;
    FreeAndNil(bitmapCache);
  end;
end;

procedure ResampleProportional(var bmp: TBitmap; forceCosine: Boolean = false);
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, forceCosine);

    bmp32.Draw(bmp32.BoundsRect, bmpOrig.BoundsRect, bmpOrig);
    bmp.Assign(bmp32);
    bmpOrig.Free;
    bmp32.Free;
  end
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;

procedure ResampleFullscreen(var bmp: TBitmap; bRect: TRect; forceCosine: Boolean = False);
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 > bRect.Height - 50 then
  begin
    newHeight := bRect.Height - 50;
    newWidth := round(newHeight * aspect);
  end;

  if newWidth > bRect.Width - 50 then
  begin
    newWidth := bRect.Width - 50;
    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, forceCosine, False);
    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; name: string = '';
  fromChat: boolean = false): boolean;
var
  // png : TPNGGraphic;
  png: TPNGImage;
  winimg: TWICImage;
  resStr: TResourceStream;
  // scaler: IWICBitmapScaler;
  // aniImg : TRnQAni;
  NonAnimated: boolean;
  forceCosine: boolean;
  // {$IFNDEF RNQ_LITE}
  // vJpg, vJpgBad : TsdJpegFormat;
  // vJpg, vJpgBad : jpeg_decompress_struct;
  // JPegR : TFPReaderJPEG;
  pic: IPicture;
  A, b: Integer;
  h, w: Integer;
  R: TRect;

  vBmp: TBitmap;
  vJpg: TJPEGImage;
  // {$ENDIF RNQ_LITE}
  IcoStream: TIconStream;
  icn: Ticon;
  // I: Integer;
  // frame: TAniFrame;
  // Grph: TGraphic;
  // ff : TPAFormat;
  //Freq, StartCount, StopCount: Int64;
  //TimingSeconds: real;
  hash: LongWord;
begin
  // fBmp := NIL;
  // fBMP32 := NIL;
  // f32Alpha := False;
  Result := false;
  if not Assigned(str) then
    Exit;

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

  str.Position := 0;

  if (fromChat) then
  begin
    hash := 0;
    try
      hash := CalcMurmur2(str);
    except end;

    if not (hash = 0) and GetBitmapFromCache(hash, bmp) then
    begin
      ff := bmp.fFormat;
      Result := True;
      FreeAndNil(str);
      Exit;
    end;
  end;

  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;
        if not Assigned(bmp.fBmp) then
          bmp.fBmp := TBitmap.Create;
        bmp.fBmp.LoadFromStream(str);
        if (fromChat) 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;
    // {$IFNDEF RNQ_LITE}
    PA_FORMAT_JPEG:
      begin
        str.Position := 0;
        vBmp := nil;
        try
          try
            if JPEGTurbo then
            begin
              vJpg := TJPEGImage.Create;
              vJpg.LoadFromStream(str);
              vBmp := TBitmap.Create;
              vBmp.PixelFormat := pf24bit;
              vBmp.Assign(vJpg);
              vJpg.Free;
            end
              else
            begin
              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;
            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 (fromChat) then
            ResampleProportional(bmp.fBmp);
          bmp.fWidth := bmp.fBmp.Width;
          bmp.fHeight := bmp.fBmp.Height;
          Result := True;
          vBmp.Free;
        except end;
      end;
    // {$ENDIF RNQ_LITE}
    PA_FORMAT_GIF:
      try
        // aniImg := CreateAni(str, NonAnimated);
        if Assigned(bmp) then
          bmp.Free;
        // else
        // bmp.Clear;
        bmp := LoadAGifFromStream(NonAnimated, str, fromChat);
        // 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;
          { if Assigned(bmp) then
            bmp.Free;
            bmp := GetRnQBitMap(aniImg);
            bmp.fFormat := ff;
            bmp.fAnimated := not NonAnimated;

            if not Assigned(bmp.fBmp) then
            bmp.fBmp :=TBitmap.Create;
            //        FreeAndNil(fBmp32);
            bmp.fBmp.Assign(aniImg.Bitmap);
            //        bmp.TransparentMode := tmAuto;
            bmp.fBmp.Transparent := aniImg.IsTransparent;
            bmp.fWidth:= bmp.fBmp.Width;
            bmp.fHeight:= bmp.fBmp.Height;
          }

          // aniImg.Free;
          bmp.fTransparentColor := ColorToRGB(bmp.fBmp.TransparentColor);
          bmp.fFormat := ff;
          str.Free;
          str := NIL;
          Result := True;
        end;
      except end;
    PA_FORMAT_PNG:
      try
//QueryPerformanceFrequency(Freq);
//Freq := Freq div 1000;
//QueryPerformanceCounter(StartCount);
        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;

          if not Assigned(bmp.fBmp) then
            bmp.fBmp := TBitmap.Create;
          bmp.fBmp.Assign(png);

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

          if (fromChat) then
            ResampleProportional(bmp.fBmp, forceCosine);

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

          png.Free;
          FreeAndNil(str);
          Result := True;
        end;
//QueryPerformanceCounter(StopCount);
//TimingSeconds := (StopCount - StartCount) / Freq;
//OutputDebugString(PChar('PNG: ' + floattostr(TimingSeconds)));
      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;

          if not Assigned(bmp.fBmp) then
            bmp.fBmp := TBitmap.Create;
          // FreeAndNil(fBmp32);
          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 (fromChat) 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;

          if not Assigned(bmp.fBmp) then
            bmp.fBmp := TBitmap.Create;
          bmp.fBmp.PixelFormat := pf24bit;
          bmp.fBmp.Assign(winimg);
          if (fromChat) 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;

          if not Assigned(bmp.fBmp) then
            bmp.fBmp := TBitmap.Create;
          bmp.fBmp.Assign(winimg);
          bmp.f32Alpha := True;
          bmp.fBmp.PixelFormat := pf32bit;
          bmp.fBmp.AlphaFormat := afPremultiplied;

          if (fromChat) 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;

            if not Assigned(bmp.fBmp) then
              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"');
      // msgDlg(getTranslation('Can''t load file from stream: %s', [name]), mtError);
      Result := false;
    end;
  end;

  if fromChat and Result then
    PutBitmapToCache(hash, bmp);

  // if bmp.fBmp.Transparent then
  // Premultiply(bmp.fBmp);
  // InitTransAlpha(bmp.fBmp);
end;

{$IFDEF RNQ}

function loadPic(pt: TThemeSourcePath; fn: string; var bmp: TRnQBitmap; idx: Integer = 0): boolean;
  function fullpath(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(SysUtils.ExtractFileExt(fn)) = '.ico') or (lowercase(SysUtils.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;
{$ENDIF RNQ}

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

{
  procedure TRnQBitmap.Draw32bit(DC: HDC; DX, DY: Integer);
  //procedure Draw32bit(DC: HDC; DX, DY: Integer; const Bmp: TBitmap);
  var
  tmp_Bmp: TBitmap;
  X, Y: Integer;
  A: Double;
  Scan24: PColor24Array;
  Scan32: GR32.PColor32Array;
  begin
  begin
  tmp_bmp := createBitmap(fWidth, fHeight);
  tmp_bmp.PixelFormat := pf24bit;

  BitBlt(tmp_bmp.Canvas.Handle,
  0, 0, fWidth, fHeight,
  DC, DX, DY, SrcCopy);

  for Y := 0 to fHeight - 1 do
  begin
  Scan24 := PColor24Array(tmp_bmp.ScanLine[Y]);
  Scan32 := GR32.PColor32Array(fBMP32.ScanLine[Y]);

  for X := 0 to fWidth - 1 do
  begin
  A := AlphaComponent(Scan32^[X]);

  if A <> 0 then
  begin
  A := A / 255;
  //          A := (A + A/255) / 256;
  Scan24^[X].R := round(RedComponent(Scan32^[X]) * (A) + Scan24^[X].R * (1 - A));
  Scan24^[X].G := round(GreenComponent(Scan32^[X]) * (A) + Scan24^[X].G * (1 - A));
  Scan24^[X].B := round(BlueComponent(Scan32^[X]) * (A) + Scan24^[X].B * (1 - A));
  end;
  end;
  end;


  BitBlt(DC,
  DX, DY, fWidth, fHeight,
  tmp_bmp.Canvas.Handle, 0, 0, SrcCopy);

  tmp_bmp.Free;
  end;
  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) 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);
      begin
        hBMP := fBmp.Canvas.Handle;
        // fBmp.Canvas.Lock;
        Windows.AlphaBlend(DC, DestBnd.X, DestBnd.Y, DestBnd.Width, DestBnd.Height, hBMP, SrcBnd.X, SrcBnd.Y, SrcBnd.Width,
          SrcBnd.Height, blend);
      end;
      // fBmp.Canvas.Unlock;
    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(fBMP32) then
    begin
    if f32Alpha then
    Draw32Native(DC, Rect(DX, DY, DX+fWidth, DY+fHeight),
    @fBmp32.BitmapInfo, fBmp32.Bits)
    //       Draw32bit(DC, DX, DY)
    else
    fBMP32.DrawTo(DC, DX, DY);
    end
    else }
  if Assigned(fBmp) 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);
      Windows.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(x, y, pWidth, pHeight: Integer): TRnQBitmap;
function TRnQBitmap.Clone(bnd: TGPRect): TRnQBitmap;
var
  {
    PB, //:PByte;
    PC:PColor32;
    r, C:Cardinal;
  }
  // b : Byte;
  // bi : TBitmapInfo;
  // biSize : Cardinal;
  // arr : TMAXBITMAPINFO;
  // blend: BLENDFUNCTION;
  MyDC: HDC;
  I: Integer;
  frame: TAniFrame;
begin
  if Assigned(fBmp) 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
      { case fBmp.PixelFormat of
        pfDevice, pf24bit, pf32bit: b := 24;
        pf1bit: b := 1;
        pf4bit: b := 4;
        pf8bit: b := 8;
        pf15bit: b := 15;
        pf16bit: b := 16;
        end;
        GetDIBSizes(fBmp.Handle, biSize, r);
        // bi.bmiColors := arr;
        // SetLength(bi.bmiColors, (biSize - sizeof(bi.bmiHeader))div SIZEOF(TRGBQuad) );
        // GetDIB(fBmp.Handle, fBmp.Palette, bi)
        // StretchDiBits(Result.fBmp.Canvas.Handle,0,0,width, height,
        //               x,y, width, height, b, bi
        //               pBitmapInfo(@PNG.Header.BitmapInfo)^,DIB_RGB_COLORS,SRCCOPY);
      }
      // blend.AlphaFormat        := AC_SRC_ALPHA;
      // if (not CheckWin32Version(5,1))or not f32Alpha then
      // if ( Win32MajorVersion < 6)or not f32Alpha then
      // if not f32Alpha or
      // not((Win32MajorVersion > 5)or((Win32MajorVersion = 5)and(Win32MinorVersion >= 1))) then
      if 1 = 1 then
      begin
        BitBlt(Result.fBmp.Canvas.Handle, 0, 0, bnd.Width, bnd.Height, MyDC, bnd.X, bnd.Y, SRCCOPY);
        // if PNG.Header.ColorType in [COLOR_GRAYSCALEALPHA,COLOR_RGBALPHA] then
        { if f32Alpha then
          begin
          for R:=0 to bnd.height-1 do
          begin
          PB:=Pointer(Self.fBmp.ScanLine[r+bnd.Y]);
          if PB<>nil then
          begin
          inc(PB, bnd.x);
          PC:=Pointer(Result.fBmp.ScanLine[r]);
          for C:=0 to bnd.width-1 do
          begin
          PC^:=SetAlpha(PC^,PByte(PB)^);
          Inc(PB); Inc(PC);
          end;
          end;
          end;
          end; }
      end
      else
      begin
        { blend.AlphaFormat         := AC_SRC_OVER;
          blend.BlendOp             := AC_SRC_OVER;
          blend.BlendFlags          := 0;
          //       if not pEnabled then
          //         blend.SourceConstantAlpha := 100
          //        else
          blend.SourceConstantAlpha := $FF;

          Windows.AlphaBlend(Result.fBmp.Canvas.Handle, 0, 0, bnd.width, bnd.height,
          MyDC, bnd.X, bnd.y, bnd.width, bnd.height, blend);
        }
      end;
    // if f32Alpha then
    // else
    // BitBlt(Result.fBmp.Canvas.Handle, 0, 0, width, height,
    // fBmp.Canvas.Handle, x, 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
  // PB, //  :PByte;
  // PC:PColor32;
  // b : Byte;
  // bi : TBitmapInfo;
  // biSize : Cardinal;
  // arr : TMAXBITMAPINFO;
  // C:Cardinal;
  // r : Integer;
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;
  // Result := TRnQBitmap.Create;
  // Result.f32Alpha := f32Alpha;
  // Result.fBmp :=  (fHI);
  // Result.fWidth := fWidth;
  // Result.fHeight := fHeight;
  if Assigned(fBmp) 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;
    { case fBmp.PixelFormat of
      pfDevice, pf24bit, pf32bit: b := 24;
      pf1bit: b := 1;
      pf4bit: b := 4;
      pf8bit: b := 8;
      pf15bit: b := 15;
      pf16bit: b := 16;
      end;
      GetDIBSizes(fBmp.Handle, biSize, r);
      // bi.bmiColors := arr;
      // SetLength(bi.bmiColors, (biSize - sizeof(bi.bmiHeader))div SIZEOF(TRGBQuad) );
      // GetDIB(fBmp.Handle, fBmp.Palette, bi)
      // StretchDiBits(Result.fBmp.Canvas.Handle,0,0,width, height,
      //               x,y, width, height, b, bi
      //               pBitmapInfo(@PNG.Header.BitmapInfo)^,DIB_RGB_COLORS,SRCCOPY);
    }
    // if PNG.Header.ColorType in [COLOR_GRAYSCALEALPHA,COLOR_RGBALPHA] then
    if f32Alpha then
    begin
      // blend.AlphaFormat        := AC_SRC_ALPHA;
      blend.AlphaFormat := AC_SRC_OVER;
      blend.BlendOp := AC_SRC_OVER;
      blend.BlendFlags := 0;
      // if not pEnabled then
      // blend.SourceConstantAlpha := 100
      // else
      blend.SourceConstantAlpha := $FF;
      Windows.AlphaBlend(Result.fBmp.Canvas.Handle, 0, 0, Width, Height, fBmp.Canvas.Handle, LeftTop.X, LeftTop.Y, Width,
        Height, blend);
      { BitBlt(Result.fBmp.Canvas.Handle, 0, 0, width, height,
        fBmp.Canvas.Handle, LeftTop.X, LeftTop.y, SRCCOPY);
        for R:=LeftTop.y to LeftTop.y+Height-1 do
        begin
        PB:=Pointer(Self.fBmp.ScanLine[r]);
        if PB<>nil then
        begin
        inc(PB, LeftTop.X);
        PC:=Pointer(Result.fBmp.ScanLine[r-LeftTop.y]);
        for C:=0 to width-1 do
        begin
        PC^:=SetAlpha(PC^,PByte(PB)^);
        Inc(PB); Inc(PC);
        end;
        end;
        end; }
    end
    // if f32Alpha then
    else
    begin

      // FMaskedBitmap := TBitmap.Create;
      // FMaskedBitmap.Assign(Strip);

      SRect := Rect(LeftTop, Point(LeftTop.X + Width, LeftTop.Y + Height)); { current frame location in Strip bitmap }
      {
        Result.fBmp.Assign(fBmp);
        Result.fBmp.Canvas.CopyRect(Rect(0, 0, Width, Height), Result.fBmp.Canvas, SRect);
        Result.fBmp.Width := FWidth;
      }
      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.Assign(htMask);
          Result.htMask.Canvas.CopyRect(Rect(0, 0, Width, Height), Result.htMask.Canvas, SRect);
          Result.htMask.Width := FWidth;
        }
        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;

      // fBmp.PixelFormat := ani.MaskedBitmap.PixelFormat;
      // fBmp.Width := ani.Width;
      // fBmp.Height := ani.Height;
      // fBmp.Assign(ani.MaskedBitmap);
      // ani.Draw(fBmp.Handle, 0, 0);

      Result.fFormat := PA_FORMAT_GIF;
      Result.htTransparent := htTransparent and Assigned(htMask);
    end;
    // BitBlt(Result.fBmp.Canvas.Handle, 0, 0, width, height,
    // fBmp.Canvas.Handle, x, y, SRCCOPY);
    // 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;

(*
  //procedure wbmp2bmp(s: String; pic : TBitmap);
  //procedure wbmp2bmp(Stream: TStream; var pic : TBitmap);
  function wbmp2bmp(Stream: TStream; var pic : TBitmap; CalcOnly : Boolean = false) : TSize;
  var
  Bts : Integer;
  w, h : Integer;
  l, i : Word;
  //  , k, j : Word;
  b : Byte;
  var
  Pal: TMaxLogPalette;
  begin
  //  if not FileExists('pic00.wbmp') then
  //    appendFile('pic00.wbmp', s);
  //  Bts := 4;
  l := 5;
  stream.position := 2;
  Stream.Read(B, SizeOf(Byte));
  w := 0;
  h := 0;

  try
  if b = 128 then
  begin
  Stream.Read(w, SizeOf(Byte));
  //     ACols := Ord(s[4]);
  inc(l, 2);
  Stream.Read(b, SizeOf(Byte));
  //     ARows := Ord(s[4+2]);
  Stream.Read(h, SizeOf(Byte));
  end
  else
  begin
  w := b;
  //     ARows := Ord(s[4]);
  Stream.Read(h, SizeOf(Byte));
  end;
  Bts := w div 8;
  if w mod 8 > 0 then inc(Bts);

  Result.cx := w;
  Result.cy := h;

  if (w = 0) or (h = 0) then
  begin
  FreeAndNil(pic);
  exit;
  end;
  if CalcOnly then
  FreeAndNil(pic)
  else
  begin
  if not Assigned(pic) then
  pic := createBitmap(w, h)
  else
  begin
  pic.Width  := w;
  pic.Height := h;
  end;

  //  pic.Monochrome := True;
  pic.Transparent := false;

  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)^);
  pic.PixelFormat := pf1bit;
  for i := 0 to H - 1 do
  Stream.Read(pic.ScanLine[i]^, Bts);

  {  for i := 0 to ARows-1 do
  begin
  For k := 0 to Bts-1 do
  for j := 0 to 7 do
  begin
  if (7 - j + 8 * k) < Acols then
  if (Ord(s[l+k]) and (1 shl j)) = 0 then
  pic.Canvas.Pixels[7 - j + 8 * k, i] := clBlack
  else
  pic.Canvas.Pixels[7 - j + 8 * k, i] := clWhite;
  end;
  inc(l, Bts)
  end;}
  end;
  except
  if Assigned(pic) then
  begin
  pic.Height := 1;
  pic.Width := 1;
  pic.Canvas.Pixels[1, 1] := clBlack
  end;
  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 bmp2wbmp(bmp : TBitmap) : String;
  var
  Bts : Byte;
  ACols, ARows : word;
  i, j, k, l : word;
  //  clr : TColor;
  //Chs : Array[0..15] of Char;
  begin
  ACols := bmp.Width;
  ARows := bmp.Height;
  Bts := ACols div 8;
  if ACols mod 8 > 0 then inc(Bts);

  //  for i := 1 to Bmp.Height do
  //    for j := 1 to Bmp.Width do
  //      if Bmp.Canvas.Pixels[j, i] = clBlack then
  //        SEPic[i, j] := true;
  result := #0#0 + Chr(ACols) + Chr(ARows);
  SetLength(result, ARows*bts+4);
  l := 5;
  if (ACols=0) or (ARows=0) then exit;
  for i := 0 to ARows-1 do
  begin
  For k := 0 to Bts-1 do
  begin
  result[l+k] := #255;
  for j := 0 to 7 do
  begin
  if (Rgb2Gray(Bmp.Canvas.Pixels[7 - j + 8 * k, i]) < 128) or
  //        if SEPic[i, 7 - j + 8 * k] or
  ((7 - j + 8 * k) > Acols) then
  result[l+k] := Chr(ord(result[l+k]) AND not (1 shl j));
  //         if (7 - j + 8 * k) < Acols then
  end;
  end;
  inc(l, bts);
  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;
// var
// Extensions: TStringList;
// i : Integer;
begin
  // result:=true;
  Result := false;
  fn := lowercase(SysUtils.ExtractFileExt(fn));
  // if fn <> '' then
  if Length(fn) > 3 then // dot + extension
  begin
    fn := Copy(fn, 2, Length(fn) - 1);
    if (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') or (fn = 'dll') then
    begin
      Result := True;
      Exit;
    end
    { try
      Extensions := TStringList.Create;
      FileFormatList.GetExtensionList(Extensions);
      i := Extensions.IndexOf(fn);
      if i>=0 then
      result:=true
      else
      result:=false
      finally
      Extensions.Free;
      end;
      end }
    else
      Result := false;
  end;
end; // isSupportedPicFile

function DetectFileFormatStream(str: TStream): TPAFormat;
var
  // s : String;
  s: array [0 .. 3] of AnsiChar;
  // X: string;
begin
  str.Seek(0, soFromBeginning);
  // str.Position := 0;
  str.Read(s, 4);
  // X := inttostr(ord(s[0])) + ' ' + inttostr(ord(s[1])) + ' ' + inttostr(ord(s[2])) + ' ' + inttostr(ord(s[3]));
  // OutputDebugString(PWideChar(X));
  // 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 (s = ICON) then
    Result := PA_FORMAT_ICO
  else if (s = TIF) then
    Result := PA_FORMAT_TIF
  else if (s = WEBP) then
    Result := PA_FORMAT_WEBP
  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);
// var
// bmp1 : TBitmap;
// newBmp: TRnQBitmap;
// w, h : Integer;
// gr : TGPGraphics;
begin
  if not Assigned(bmp) or (bmp.fAnimated and (bmp.FNumFrames > 1)) then
    Exit;
  { w := bmp.GetWidth;
    h := bmp.GetHeight;
    if (w > maxW )
    or (h > maxH) then
    begin }
  // bmp1 := TBitmap.Create;
  if Assigned(bmp.fBmp) then
  begin
    StretchPic(bmp.fBmp, maxH, maxW);
    bmp.fWidth := bmp.fBmp.Width;
    bmp.fHeight := bmp.fBmp.Height;
  end;

  { if w * maxH < h * maxW then
    newBmp := TRnQBitmap.Create(maxH*w div h, maxH)
    else
    newBmp := TRnQBitmap.Create(maxW, maxW*h div w);
    {   gr := TGPGraphics.Create(newBmp);
    gr.SetInterpolationMode(InterpolationModeHighQualityBicubic);
    gr.SetSmoothingMode(SmoothingModeHighQuality);
    gr.DrawImage(bmp, 0,0, newBmp.GetWidth, newBmp.GetHeight);
    gr.Free;
    FreeAndNil(bmp);
    //   bmp := newBmp;
    //   newBmp := nil;
    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.fWidth)) and ((DestR.Height) <> (bmp.fHeight)) then
  begin
    GetBrushOrgEx(DC, pt);
    SetStretchBltMode(DC, HALFTONE);
    SetBrushOrgEx(DC, pt.X, pt.Y, @pt);
  end;
  bmp.Draw(DC, 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; DestRect : TRect; SrcX, SrcY, SrcW, SrcH : Integer; pEnabled : Boolean= True);
  var
  Pt: TPoint;
  begin
  if ((DestRect.Right - DestRect.Left) <> (SrcW))
  and ((DestRect.Bottom - DestRect.Top) <> (SrcH)) then
  begin
  GetBrushOrgEx(dc, pt);
  SetStretchBltMode(dc, HALFTONE);
  SetBrushOrgEx(dc, pt.x, pt.y, @pt);
  end;
  bmp.Draw(DC, DestRect, SrcX, SrcY, SrcW, SrcH, pEnabled);
  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;

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;
    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;
  // BIH: TBitmapInfoHeader;
  BI: TBitmapInfo;
  blend: BLENDFUNCTION;
  // oldBr, brF : HBRUSH;
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 := GetRValue(StartColor) shl 8;
      Blue := GetBValue(StartColor) shl 8;
      Green := GetGValue(StartColor) shl 8;
      Alpha := Byte(StartColor shr 24) shl 8;
    }
    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 := GetRValue(EndColor) shl 8;
    // Blue := GetBValue(EndColor) shl 8;
    // Green := GetGValue(EndColor) shl 8;
    // Alpha := Byte(EndColor shr 24) shl 8;
    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
  // if
    (((StartColor and AlphaMask) <> AlphaMask) or ((EndColor and AlphaMask) <> AlphaMask)) or (Alpha < $FF) then
  begin
    HOldBmp := 0;
    try
      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;
      finally

      end;

      // FillGradientInternal(tempDC,
      // Rect(udtVertex[0].x, udtVertex[0].Y,udtVertex[1].x, udtVertex[1].Y),
      // 128, StartColor, EndColor, ADirection);
      if GradientFill(tempDC, @udtVertex, 2, @rectGradient, 1, Mode) then
      begin
        blend.AlphaFormat := AC_SRC_ALPHA
        // else
        // blend.AlphaFormat         := AC_SRC_OVER
          ;
        blend.BlendOp := AC_SRC_OVER;
        blend.BlendFlags := 0;
        blend.SourceConstantAlpha := Alpha;

        { brF := CreateSolidBrush(ColorToRGB(theme.GetColor('menu.selected', clMenuHighlight)));
          FillRect(tempDC, Rect(0, 0, udtVertex[1].x, udtVertex[1].y), brF);
          DeleteObject(brF);
        }
        // GdiFlush;
        // if not
        Windows.AlphaBlend(DC, ARect.left, ARect.Top, ARect.Right - ARect.left, ARect.Bottom - ARect.Top, tempDC, 0, 0,
          udtVertex[1].X, udtVertex[1].Y, blend)
        { then
          loggaEvt('Coudn''t draw AlphaBlend :(', 'draw');
        }
      end
      // else
      // loggaEvt('Coudn''t draw gradient :(', 'draw');
        ;
      // else
      // BitBlt(DC, ARect.Left, ARect.Top, udtVertex[1].x, udtVertex[1].y, tempDC, 0, 0, SRCCOPY)
    finally
      SelectObject(tempDC, HOldBmp);
      DeleteObject(ABitmap);
      if tempDC <> DC then
        DeleteDC(tempDC);
    end;
  end
  else
    GradientFill(DC, @udtVertex, 2, @rectGradient, 1, Mode);

  // GdiFlush;
end;

procedure FillRoundRectangle(DC: HDC; ARect: TRect; clr: cardinal; rnd: Word);
var
  oldBr, brF: HBRUSH;
  oldPen, Hp: HPEN;
begin
  if ((clr and AlphaMask) <> AlphaMask) then
  begin
  end
  else
  begin
    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;
end;

procedure DrawTextTransparent(DC: HDC; X, Y: Integer; Text: String; Font: TFont; Alpha: Byte; fmt: Integer);
var
  tempDC: HDC;
  // ABitmap, HOldBmp : HBITMAP;
  // BIH: TBitmapInfoHeader;
  // BI : TBitmapInfo;
  tempBitmap: TBitmap;
  blend: BLENDFUNCTION;
  oldFont: HFONT;
  R: TRect;
  res: TSize;
  I, k, h, w: Integer;
  Scan32: pColor32Array;
  // oldBr, brF : HBRUSH;
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;
  { tempDC := CreateCompatibleDC(DC);
    HOldBmp := 0;
    try
    with R do
    begin
    BI.bmiHeader.biSize := SizeOf(TBitmapInfoHeader);
    BI.bmiHeader.biWidth  := res.cx;
    BI.bmiHeader.biHeight := res.cy;
    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()
    //            ABitmap := CreateCompatibleBitmap(DC, udtVertex[1].x, udtVertex[1].y);
    if (ABitmap = 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;
    finally

    end; }
  oldFont := SelectObject(tempDC, Font.Handle);
  // oldColor :=
  SetTextColor(tempDC, ColorToRGB(Font.Color));
  // SetTextColor(tempDC, $FFFFFFFF);
  // oldMode:=
  SetBKMode(tempDC, Transparent);
  // FillRect(tempDC, R, GetStockObject(BLACK_BRUSH));
  FillRect(tempDC, R, GetStockObject(WHITE_BRUSH));
  // FillRect(tempDC, R, GetStockObject(LTGRAY_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 !!!

  // Trans.c := ColorToRGB(bmp.TransparentColor) and not AlphaMask;
  for I := 0 to h do
  begin
    // if biHeight > 0 then  // bottom-up DIB
    // Row := biHeight - Row - 1;
    // Integer(Scan32) := Integer(BI.bmiHeader.bmBits) +
    // i * BytesPerScanline(res.cx, 32, 32);

    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
      // else
      // blend.AlphaFormat         := AC_SRC_OVER
        ;
      blend.BlendOp := AC_SRC_OVER;
      blend.BlendFlags := 0;
      blend.SourceConstantAlpha := Alpha;

      { brF := CreateSolidBrush(ColorToRGB(theme.GetColor('menu.selected', clMenuHighlight)));
        FillRect(tempDC, Rect(0, 0, udtVertex[1].x, udtVertex[1].y), brF);
        DeleteObject(brF);
      }
      // GdiFlush;
      // if not
      Windows.AlphaBlend(DC, X, Y, res.cx, res.cy, tempDC, 0, 0, res.cx, res.cy, blend)
      { then
        loggaEvt('Coudn''t draw AlphaBlend :(', 'draw');
      }
    end
    // else
    // loggaEvt('Coudn''t draw gradient :(', 'draw');
      ;
    // else
    // BitBlt(DC, x,y, res.cx, res.cy,  tempDC, 0, 0, SRCCOPY)
  finally
    // SelectObject(tempDC, HOldBmp);
    // DeleteObject(ABitmap);
    // DeleteDC(tempDC);
    FreeAndNil(tempBitmap);
  end
end;

// procedure DrawTextTransparent2(DC : HDC; x, y : Integer; Text : String; Font : TFont; Alpha : Byte; fmt : Integer);
procedure DrawText32(DC: HDC; TextRect: TRect; Text: String; Font: TFont; TextFlags: cardinal);
var
  TextLen: Integer;
  // TextRect: TRect;
  // TextFlags: ;
  Options: TDTTOpts;
  // pmtParams : TBPPaintParams;
  // blend: BLENDFUNCTION;
  // PaintOnGlass : Boolean;
  MemDC: HDC;
  PaintBuffer: HPAINTBUFFER;
  // br : HBRUSH;
  oldF: HFONT;
  // s : String;
begin
  TextLen := Length(Text);
  // TextFlags := DT_CENTER or DT_VCENTER;
  // TextRect := r;
  // TextRect.Left := r.Right - x - 4;
  // TextRect.Top := y-1;
  // inc(TextRect.Bottom, 1);
  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);
  // FillRect(cnv.Handle, TextRect, GetStockObject(BLACK_BRUSH));
  {
    pmtParams.cbSize := SizeOf(TBPPaintParams);
    pmtParams.dwFlags := //BPPF_NONCLIENT;
    0;
    //         BPPF_ERASE;
    //        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 := 100
    //        else
    blend.SourceConstantAlpha := $FF;
    //      pmtParams.pBlendFunction := @blend;
    pmtParams.pBlendFunction := nil;
    //      PaintBuffer := BeginBufferedPaint(DC, TextRect, BPBF_TOPDOWNDIB, @pmtParams, MemDC);
  }
  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; fromChat: boolean = false): 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 fromChat 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(fn: String; var b: boolean): TRnQBitmap; {$IFDEF HAS_INLINE} inline; {$ENDIF HAS_INLINE}
var
  Stream: TFileStream;
begin
{$IFDEF NOT_USE_GDIPLUS}
  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;
{$ELSE NOT_USE_GDIPLUS}
  Result := TRnQAni.Create(fn);
  // NewGPImage(fn);
  // b := not result.CanAnimate;
  b := not Result.fAnimated;
{$ENDIF NOT_USE_GDIPLUS}
end;

function CreateAni(fs: TStream; var b: boolean): TRnQBitmap; {$IFDEF HAS_INLINE} inline; {$ENDIF HAS_INLINE}
begin
{$IFDEF NOT_USE_GDIPLUS}
  Result := LoadAGifFromStream(b, fs);
{$ELSE NOT_USE_GDIPLUS}
  Result := TRnQAni.Create(fn);
  // NewGPImage(fn);
  // b := not result.CanAnimate;
  b := not Result.fAnimated;
{$ENDIF NOT_USE_GDIPLUS}
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;
  // mask : TBitmap;
  // hi : HICON;
begin
  // Result := TIcon.Create;
  // bitmap.PixelFormat := pf32bit;
  // il := ImageList_Create(icon_size, icon_size, ILC_COLOR32 or ILC_MASK, 0, 0);
  // il := ImageList_Create(Min(bitmap.Width, icon_size), Min(bitmap.Height, icon_size), ILC_COLOR32 or ILC_MASK, 0, 0);
  il := ImageList_Create(Min(bitmap.Width, bitmap.Height), Min(bitmap.Width, bitmap.Height), ILC_COLOR32, 0, 0);
  // ImageList_SetBkColor(il, $00FFFF00);
  { Mask := TBitmap.Create;
    try
    Mask.Assign(bitmap);
    mask.Monochrome := True;
    Mask.TransparentColor := bitmap.TransparentColor;
    Mask.Transparent := True;
    ImageList_AddMasked(il, bitmap.Handle, Mask.MaskHandle);
    finally
    mask.Free;
    end; }
  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;
  // mask : TBitmap;
  // hi : HICON;
begin
  // Result := TIcon.Create;
  // bitmap.PixelFormat := pf32bit;
  // il := ImageList_Create(icon_size, icon_size, ILC_COLOR32 or ILC_MASK, 0, 0);
  il := ImageList_Create(Min(bitmap.Width, icon_size), Min(bitmap.Height, icon_size), ILC_COLOR32 or ILC_MASK, 0, 0);
  { if ((Win32MajorVersion > 5)or((Win32MajorVersion = 5)and(Win32MinorVersion >= 1))) then
    i := ILC_HIGHQUALITYSCALE or ILC_COLOR32 or ILC_MASK
    else
    i := ILC_COLOR24 or ILC_MASK;

    il := ImageList_Create(min(bitmap.Width,bitmap.Height), min(bitmap.Width,bitmap.Height), i, 0, 0);
  }
  // il := ImageList_Create(icon_size, icon_size, i, 0, 0);
  // il := ImageList_Create(icon_size, icon_size, ILC_COLOR32 or ILC_MASK, 0, 0);
  // ImageList_SetBkColor(il, $00FFFF00);
  { Mask := TBitmap.Create;
    try
    Mask.Assign(bitmap);
    mask.Monochrome := True;
    Mask.TransparentColor := bitmap.TransparentColor;
    Mask.Transparent := True;
    ImageList_AddMasked(il, bitmap.Handle, Mask.MaskHandle);
    finally
    mask.Free;
    end; }
  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);
// var
// IcoStream : TIconStream;
// str: TMemoryStream;
// idx : Integer;
// il : TCustomImageList;
// ilH: HIMAGELIST;
// R : TRect;
begin
  // il := TCustomImageList.Create(NIL);
  { ilH:=  ImageList_Create(icon_size, icon_size, ILC_COLOR32// or ILC_MASK
    , 0, 0);
    ImageList_AddIcon(ilH, ico.Handle);
    bmp.Width := icon_size;
    bmp.Height := icon_size;
    ImageList_Draw(ilH, 0, bmp.Canvas.Handle, 0, 0, ILD_NORMAL);
    ImageList_Destroy(ilh); }
  // il.AddIcon(ico);
  // il.GetBitmap(0, bmp);
  bmp.Width := icon_size; // ico.Width;
  bmp.Height := icon_size;
  bmp.PixelFormat := pf24bit;
  bmp.Canvas.Brush.Color := $010100;
  bmp.Canvas.FillRect(bmp.Canvas.ClipRect);

  // DrawIconEx(bmp.Canvas.Handle, 0, 0, ico.Handle, icon_size, icon_size, 0, 0, DI_NORMAL);

  // ico := TIcon.Create;
  // ico.Handle := hi;
  // pic.Width := ico.Width;
  // pic.Height := ico.Height;
  bmp.Canvas.StretchDraw(Rect(0, 0, icon_size, icon_size), ico);
  // bmp.Canvas.Draw(0, 0, ico);
  // pic.Assign(ico); //CopyImage(hi, IMAGE_ICON, 0, 0, LR_CREATEDIBSECTION)
  // DestroyIcon(hi);
  // ico.Free;

  bmp.TransparentColor := $010100;
  bmp.Transparent := True;
  {
    IcoStream := TIconStream.Create;
    str := TMemoryStream.Create;
    ico.SaveToStream(str);
    IcoStream.LoadFromStream(str);
    idx := 0;
    //  if (idx < 1) or (idx > IcoStream.Count) then
    //    idx := 1;
    //  dec(idx);
    //        bmp:= TBitmap.Create;
    bmp.Height:= IcoStream[Idx].bHeight;
    bmp.Width := IcoStream[Idx].bWidth;
    if IcoStream[idx].wBitCount = 32 then
    bmp.PixelFormat := pf32bit
    else
    bmp.PixelFormat := pf24bit;
    //        bmp.Canvas.Brush.Color:= clBtnFace;
    bmp.Canvas.Brush.Color:= $FF010101;
    bmp.Canvas.FillRect(bmp.Canvas.ClipRect);

    IcoStream.Draw(bmp.Canvas.Handle, 0,0, Idx);
    bmp.TransparentColor := $FF010101;
    bmp.Transparent := True;
    IcoStream.Free;
    str.Free; }
end;

procedure ico2bmp2(pIcon: HICON; bmp: TBitmap);
var
  // IcoStream : TIconStream;
  // str: TMemoryStream;
  // idx : Integer;
  // il : TCustomImageList;
  ilH: HIMAGELIST;
  // hi : HICON;
  // ico : TIcon;
  // R : TRect;
begin
  // il := TCustomImageList.Create(NIL);
  { ilH:=  ImageList_Create(icon_size, icon_size, ILC_COLOR32// or ILC_MASK
    , 0, 0);
    ImageList_AddIcon(ilH, ico.Handle);
    ImageList_Draw(ilH, 0, bmp.Canvas.Handle, 0, 0, ILD_NORMAL);
    ImageList_Destroy(ilh); }
  bmp.SetSize(icon_size, icon_size);
  bmp.TransparentColor := $010100;
  // il.AddIcon(ico);
  // il.GetBitmap(0, bmp);
  // bmp.Canvas.Brush.Color:= bmp.TransparentColor;
  // bmp.Canvas.FillRect(bmp.Canvas.ClipRect);
  // hi := CopyImage(pIcon, IMAGE_ICON, icon_size, icon_size, 0);
  // hi := CopyImage(pIcon, IMAGE_ICON, icon_size, icon_size, LR_CREATEDIBSECTION);
  // DrawIconEx(bmp.Canvas.Handle, 0, 0, hi, icon_size, icon_size, 0, 0, DI_NORMAL);
  // DrawIconEx(bmp.Canvas.Handle, 0, 0, pIcon, icon_size, icon_size, 0, 0, DI_NORMAL);
  ilH := ImageList_Create(icon_size, icon_size, ILC_COLOR32 or ILC_MASK, 0, 0);
  ImageList_AddIcon(ilH, pIcon);
  // hi := ImageList_ExtractIcon(0, ilH, 0);
  // ImageList_Draw(ilH, 0, bmp.Canvas.Handle, 0, 0, ILD_TRANSPARENT);
  // ImageList_DrawEx(ilH, 0, bmp.Canvas.Handle, 0, 0, 0, 0, bmp.TransparentColor, CLR_NONE, ILD_TRANSPARENT);
  ImageList_DrawEx(ilH, 0, bmp.Canvas.Handle, 0, 0, 0, 0, bmp.TransparentColor, CLR_NONE, ILD_NORMAL);
  ImageList_Destroy(ilH);
  // ico := TIcon.Create;
  // ico.Handle := hi;
  // DrawIconEx()
  // bmp.Width := ico.Width;
  // bmp.Height := ico.Height;
  // bmp.Canvas.Brush.Color:= $010100;
  // bmp.Canvas.FillRect(bmp.Canvas.ClipRect);
  // bmp.Canvas.Draw(0, 0, ico);

  // pic.Assign(ico); //CopyImage(hi, IMAGE_ICON, 0, 0, LR_CREATEDIBSECTION)
  // ico.Free;
  // DestroyIcon(hi);
  {
    bmp.PixelFormat := pf24bit;


    //          ico := TIcon.Create;
    //          ico.Handle := hi;
    //          pic.Width := ico.Width;
    //          pic.Height := ico.Height;
    bmp.Canvas.StretchDraw(Rect(0, 0, icon_size, icon_size), ico);
    //          bmp.Canvas.Draw(0, 0, ico);
    //          pic.Assign(ico); //CopyImage(hi, IMAGE_ICON, 0, 0, LR_CREATEDIBSECTION)
    //          DestroyIcon(hi);
    //          ico.Free;
  }
  // bmp.Transparent := True;
  // bmp.TransparentMode := tmAuto;
  bmp.Transparent := True;
  // bmp.Transparent := False;
  {
    IcoStream := TIconStream.Create;
    str := TMemoryStream.Create;
    ico.SaveToStream(str);
    IcoStream.LoadFromStream(str);
    idx := 0;
    //  if (idx < 1) or (idx > IcoStream.Count) then
    //    idx := 1;
    //  dec(idx);
    //        bmp:= TBitmap.Create;
    bmp.Height:= IcoStream[Idx].bHeight;
    bmp.Width := IcoStream[Idx].bWidth;
    if IcoStream[idx].wBitCount = 32 then
    bmp.PixelFormat := pf32bit
    else
    bmp.PixelFormat := pf24bit;
    //        bmp.Canvas.Brush.Color:= clBtnFace;
    bmp.Canvas.Brush.Color:= $FF010101;
    bmp.Canvas.FillRect(bmp.Canvas.ClipRect);

    IcoStream.Draw(bmp.Canvas.Handle, 0,0, Idx);
    bmp.TransparentColor := $FF010101;
    bmp.Transparent := True;
    IcoStream.Free;
    str.Free; }
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;
    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.