{==============================================================================

  Base Bitmap               
  Copyright (C) 2000-2001 by Evgeny Kryukov
  All rights reserved

  All contents of this file and all other files included in this archive
  are Copyright (C) 2001 Evgeny Kryukov. Use and/or distribution of
  them requires acceptance of the License Agreement.

  See License.txt for licence information

===============================================================================}

unit KsBitmap;

{$I KsCommonVer.Inc}
{$O+}

interface

uses Sysutils, Classes, Windows, Graphics;

type

  { Color type }

  PKColor = ^TKColor;
  TKColor = type cardinal;

  PKColorRec =^TKColorRec;
  TKColorRec = packed record
    case Cardinal of
      0: (Color: Cardinal);
      2: (HiWord, LoWord: Word);
      3: (B, G, R, A: Byte);
    end;

  PKColorArray = ^TKColorArray;
  TKColorArray = array [0..0] of TKColor;

  PKColorRecArray = ^TKColorRecArray;
  TKColorRecArray = array [0..0] of TKColorRec;

const

  ckBlack               : TKColor = $FF000000;
  ckGray                : TKColor = $FF7F7F7F;
  ckWhite               : TKColor = $FFFFFFFF;
  ckMaroon              : TKColor = $FF7F0000;
  ckGreen               : TKColor = $FF007F00;
  ckOlive               : TKColor = $FF7F7F00;
  ckNavy                : TKColor = $FF00007F;
  ckPurple              : TKColor = $FF7F007F;
  ckTeal                : TKColor = $FF007F7F;
  ckRed                 : TKColor = $FFFF0000;
  ckLime                : TKColor = $FF00FF00;
  ckYellow              : TKColor = $FFFFFF00;
  ckBlue                : TKColor = $FF0000FF;
  ckFuchsia             : TKColor = $FFFF00FF;
  ckAqua                : TKColor = $FF00FFFF;

  ckMenu                : TKColor = $FFEDEDEE;
  ckBorder              : TKColor = $FF003399;
  ckWindow              : TKColor = $FFEBEBEE;
  ckBtnFace             : TKColor = $FFD2D2D2;
  ckBtnShadow           : TKColor = $FFA8A8A8;
  ckHotHighlight        : TKColor = $FFF8C751;
  ckHighlight           : TKColor = $FF64A0FF;
  ckHintBack            : TKColor = $FFEBEBEE;

  ckTransparent         : TKColor = $007F007F;

type

  TKsBitmapLink = class;

{ TKsBitmap the main class }

  TKsBitmap = class(TPersistent)
  private
    FBitmapInfo: TBitmapInfo;
    FHandle: HBITMAP;
    FDC: HDC;
    FBits: PKColorArray;
    FTag: integer;
    FHeight: integer;
    FWidth: integer;
    FOnChanged: TNotifyEvent;
    FName: string;
    FBlend: boolean;
    FFont: TFont;
    FLinePos: TPoint;
    function  GetPixel(X, Y: Integer): TKColor;
    procedure SetPixel(X, Y: Integer; Value: TKColor);
    procedure SetHeight(const Value: integer);
    procedure SetFont(const Value: TFont);
    procedure SetWidth(const Value: integer);
    procedure DrawMarginRect(Buffer: TKsBitmap; MarginRect,
      MarginDstRect: TRect; Stretch: boolean);
  protected
    procedure AssignTo(Dst: TPersistent); override;
  public
    constructor Create; virtual;
    destructor Destroy; override;

    procedure Assign(Source: TPersistent); override;
    procedure SetSize(AWidth, AHeight: Integer);

    function  Empty: Boolean;
    procedure Changed;

    procedure Clear(Color: TKColor);
    procedure PerformTransparent(Color: TKColor);

    procedure FillRect(R: TRect; Color: TKColor);
    procedure FillRoundRect(R: TRect; Radius: integer; Color: TKColor);
    procedure FillHalftoneRect(R: TRect; Color, HalfColor: TKColor);
    procedure FillGradientRect(Rect: TRect; BeginColor, EndColor: TKColor;
      Vertical: boolean);
    procedure FillRadialGradientRect(Rect: TRect; BeginColor, EndColor: TKColor;
      Pos: TPoint);
    procedure FillEllipse(R: TRect; Color: TKColor);

    procedure DrawEdge(R: TRect; RaisedColor, SunkenColor: TKColor);
    procedure DrawBevel(R: TRect; Color: TKColor; Width: integer; Down: boolean);
    procedure DrawRect(R: TRect; Color: TKColor);
    procedure DrawFocusRect(R: TRect; Color: TKColor);
    procedure DrawRoundRect(R: TRect; Radius: integer; Color: TKColor);
    procedure DrawLine(R: TRect; Color: TKColor);
    procedure DrawEllipse(R: TRect; Color: TKColor);

    procedure MoveTo(X, Y: integer);
    procedure LineTo(X, Y: integer; Color: TKColor);
    procedure DrawPolygon(Points: array of TPoint; Color: TColor);
    procedure FillPolygon(Points: array of TPoint; Color: TColor);
    procedure FillHalftonePolygon(Points: array of TPoint; Color, HalfColor: TKColor);

    function DrawText(AText: string; var Bounds: TRect; Flag: cardinal): integer; overload;
    function DrawText(AText: string; X, Y: integer): integer; overload;
    procedure DrawVerticalText(AText: string; Bounds: TRect; Flag: cardinal;
      FromTop: boolean);
    function TextWidth(AText: string; Flags: Integer = 0): integer;
    function TextHeight(AText: string): integer;

    procedure Draw(DC: HDC; X, Y: integer); overload;
    procedure Draw(DC: HDC; X, Y: integer; SrcRect: TRect); overload;
    procedure Draw(DC: HDC; DstRect, SrcRect: TRect); overload;
    procedure Draw(Canvas: TCanvas; X, Y: integer); overload;
    procedure Draw(Canvas: TCanvas; X, Y: integer; SrcRect: TRect); overload;
    procedure Draw(Canvas: TCanvas; DstRect, SrcRect: TRect); overload;
    procedure Draw(Bitmap: TKsBitmap; X, Y: integer); overload;
    procedure Draw(Bitmap: TKsBitmap; X, Y: integer; SrcRect: TRect); overload;
    procedure Draw(Bitmap: TKsBitmap; DstRect, SrcRect: TRect); overload;

    procedure DrawTile(Bitmap: TKsBitmap; DstRect, SrcRect: TRect); overload;
    procedure DrawStretch(Bitmap: TKsBitmap; DstRect, SrcRect: TRect);

    procedure DrawMargin(Bitmap: TKsBitmap; DstRect, SrcRect: TRect;
      MarginLeft, MarginTop, MarginRight, MarginBottom: integer; Stretch: boolean); 

    procedure MergeDraw(Bitmap: TKsBitmap; X, Y: integer; SrcRect: TRect); overload;

    procedure SetAlpha(Alpha: byte); overload;
    procedure SetAlpha(Alpha: byte; Rect: TRect); overload;

    procedure ChangeHue(DeltaHue: integer);
    procedure ChangeBrightness(DeltaBrightness: integer);

    procedure LoadFromStream(Stream: TStream);
    procedure SaveToStream(Stream: TStream);
    procedure LoadFromFile(const FileName: string);
    procedure SaveToFile(const FileName: string);
    procedure LoadFromBmpFile(const FileName: string);
    procedure SaveToBmpFile(const FileName: string);
    procedure LoadFromBmpStream(Stream: TStream);

    function GetBitmapLink(Rect: TRect): TKsBitmapLink; overload;
    function GetBitmapLink(Rect: string): TKsBitmapLink; overload;

    property Pixels[X, Y: Integer]: TKColor read GetPixel write SetPixel; default;
    property Bits: PKColorArray read FBits;

    property Font: TFont read FFont write SetFont;

    property Width: integer read FWidth write SetWidth;
    property Height: integer read FHeight write SetHeight;

    property Name: string read FName write FName;

    property Blend: boolean read FBlend write FBlend;

    property Handle: HBITMAP read FHandle;
    property BitmapInfo: TBitmapInfo read FBitmapInfo;
    property DC: HDC read FDC;
    property Tag: integer read FTag write FTag;

    property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
  published
  end;


{ TKsBitmapLink }

  TKsBitmapLink = class(TPersistent)
  private
    FBitmap: TKsBitmap;
    FRect: TRect;
    FName: string;
    function GetBottom: integer;
    function GetLeft: integer;
    function GetRight: integer;
    function GetTop: integer;
    procedure SetBottom(const Value: integer);
    procedure SetLeft(const Value: integer);
    procedure SetRight(const Value: integer);
    procedure SetTop(const Value: integer);
    function GetAssigned: boolean;
  public
    constructor Create;
    destructor Destroy; override;

    procedure Assign(Source: TPersistent); override;

    procedure Draw(Canvas: TCanvas; X, Y: integer); overload;
    procedure Draw(Bitmap: TKsBitmap; X, Y: integer); overload;

    property Assigned: boolean read GetAssigned;
    property Bitmap: TKsBitmap read FBitmap write FBitmap;
    property Rect: TRect read FRect write FRect;
  published
    property Name: string read FName write FName;
    property Left: integer read GetLeft write SetLeft;
    property Top: integer read GetTop write SetTop;
    property Right: integer read GetRight write SetRight;
    property Bottom: integer read GetBottom write SetBottom;
  end;

{ TKsBitmapList }

  TKsBitmapList = class(TList)
  private
    function GetBitmap(index: integer): TKsBitmap;
    function GetBitmapByName(index: string): TKsBitmap;
  protected
  public
    constructor Create; virtual;
    destructor Destroy; override;

    procedure Clear; override;

    function GetBitmapLink(Bitmap: TKsBitmap; Rect: TRect): TKsBitmapLink; overload;
    function GetBitmapLink(Name: string; Rect: TRect): TKsBitmapLink; overload;
    function GetBitmapLink(Name, Rect: string): TKsBitmapLink; overload;

    property Bitmaps[index: integer]: TKsBitmap read GetBitmap; default;
    property BitmapByName[index: string]: TKsBitmap read GetBitmapByName; 
  end;

{ Color functions }

function KColor(Color: TColor; A: Byte = $FF): TKColor; overload;
function KColor(R, G, B: SmallInt; A: Byte = $FF): TKColor; overload;
function KColor(ColorRec: TKColorRec): TKColor; overload;

function KColorToColor(Color: TKColor): TColor;

function RaisedColor(Color: TKColor; DR, DG, DB: byte; DA: byte = 0): TKColor; overload;
function SunkenColor(Color: TKColor; DR, DG, DB: byte; DA: byte = 0): TKColor; overload;
function RaisedColor(Color: TKColor; Dx: byte): TKColor; overload;
function SunkenColor(Color: TKColor; Dx: byte): TKColor; overload;

function HSLtoRGB(H, S, L: Single): TKColor;
procedure RGBtoHSL(RGB: TKColor; out H, S, L: single);

function ChangeHue(Color: TKColor; DeltaHue: integer): TKColor;
function ChangeBrightness(Color: TKColor; DeltaBrightness: integer): TKColor;

{ Windows Blending }

const

  EnableWindowsBlend = false;

type

  TBlendFunction = record
    BlendOp,BlendFlags,Alpha,Format: Byte;
  end;

var

  AlphaBlend: function (hdcDest: HDC; nXOriginDest, nYOriginDest, nWidthDest,
    nHeightDest: Integer; hdcSrc: HDC; nXOriginSrc, nYOriginSrc, nWidthSrc,
    nHeightSrc: Integer; blendFunction: TBlendFunction): BOOL; stdcall;

  TransparentBlt: function (hdcSrc: HDC; nXOriginSrc, nYOriginSrc, nWidthSrc,
    nHeightSrc: Integer; hdcDest: HDC; nXOriginDest, nYOriginDest, nWidthDest,
    nHeightDest: Integer; blendFunction: TBlendFunction): BOOL; stdcall;

implementation {===============================================================}

uses
  KsUtils, KsLowLevel, ClipBrd, Math, KsWinXP;

type
  TGraphicAccess = class(TGraphic);

  PPoints = ^TPoints;
  TPoints = array[0..0] of TPoint;

const
  MSImg32Lib: THandle = 0;

{ Color function }

function KColor(Color: TColor; A: Byte = $FF): TKColor;
var
  C: TColor;
begin
  C := ColorToRGB(Color);
  TKColorRec(Result).R := GetRValue(C);
  TKColorRec(Result).G := GetGValue(C);
  TKColorRec(Result).B := GetBValue(C);
  TKColorRec(Result).A := A;
end;

function KColor(R, G, B: SmallInt; A: Byte = $FF): TKColor;
begin
  if R > $FF then R := $FF;
  if G > $FF then G := $FF;
  if B > $FF then B := $FF;
  if R < 0 then R := 0;
  if G < 0 then G := 0;
  if B < 0 then B := 0;

  TKColorRec(Result).R := R;
  TKColorRec(Result).G := G;
  TKColorRec(Result).B := B;
  TKColorRec(Result).A := A;
end;

function KColor(ColorRec: TKColorRec): TKColor;
begin
  Result := TKColor(ColorRec);
end;

function KColorToColor(Color: TKColor): TColor;
begin
  with TKColorRec(Color) do
    Result := RGB(R, G, B);
end;

function RaisedColor(Color: TKColor; DR, DG, DB: byte; DA: byte = 0): TKColor;
begin
  with TKColorRec(Color) do
    Result := KColor(R + DR, G + DG, B + DB, A + DA);
end;

function SunkenColor(Color: TKColor; DR, DG, DB: byte; DA: byte = 0): TKColor;
begin
  with TKColorRec(Color) do
    Result := KColor(R - DR, G - DG, B - DB, A - DA);
end;

function RaisedColor(Color: TKColor; Dx: byte): TKColor;
begin
  Result := RaisedColor(Color, Dx, Dx, Dx);
end;

function SunkenColor(Color: TKColor; Dx: byte): TKColor;
begin
  Result := SunkenColor(Color, Dx, Dx, Dx);
end;

{ Color space conversions }

function HSLtoRGB(H, S, L: Single): TKColor;
var
  M1, M2: Single;
  R, G, B: Byte;

  function HueToColor(Hue: Single): Byte;
  var
    V: Double;
  begin
    Hue := Hue - Floor(Hue);

    if 6 * Hue < 1 then V := M1 + (M2 - M1) * Hue * 6
    else if 2 * Hue < 1 then V := M2
    else if 3 * Hue < 2 then V := M1 + (M2 - M1) * (2 / 3 - Hue) * 6
    else V := M1;
    Result := Round(255 * V);
  end;
begin
  if S = 0 then
  begin
    R := Round(255 * L);
    G := R;
    B := R;
  end
  else
  begin
    if L <= 0.5 then M2 := L * (1 + S)
    else M2 := L + S - L * S;
    M1 := 2 * L - M2;
    R := HueToColor(H + 1 / 3);
    G := HueToColor(H);
    B := HueToColor(H - 1 / 3)
  end;
  Result := KColor(R, G, B);
end;

procedure RGBtoHSL(RGB: TKColor; out H, S, L: single);
var
  R, G, B, D, Cmax, Cmin: Single;
begin
  R := TKColorRec(RGB).R / 255;
  G := TKColorRec(RGB).G / 255;
  B := TKColorRec(RGB).B / 255;
  Cmax := Max(R, Max(G, B));
  Cmin := Min(R, Min(G, B));
  L := (Cmax + Cmin) / 2;

  if Cmax = Cmin then
  begin
    H := 0;
    S := 0
  end
  else
  begin
    D := Cmax - Cmin;
    if L < 0.5 then S := D / (Cmax + Cmin)
    else S := D / (2 - Cmax - Cmin);
    if R = Cmax then H := (G - B) / D
    else
      if G = Cmax then H  := 2 + (B - R) /D
      else H := 4 + (R - G) / D;
    H := H / 6;
    if H < 0 then H := H + 1
  end;
end;

function ChangeHue(Color: TKColor; DeltaHue: integer): TKColor;
var
  H, S, L: single;
  HValue: integer;
begin
  RGBtoHSL(Result, H, S, L);

  HValue := Round(H * 255);
  Inc(HValue, DeltaHue);

  if HValue > 255 then HValue := HValue - 255;
  if HValue < 0 then HValue := 255 + HValue;

  Result := HSLtoRGB(HValue / 255, S, L);
end;
 
function ChangeBrightness(Color: TKColor; DeltaBrightness: integer): TKColor;
var
  R, G, B: integer;
begin
  R := TKColorRec(Color).R;
  G := TKColorRec(Color).G;
  B := TKColorRec(Color).B;

  Inc(R, DeltaBrightness);
  Inc(G, DeltaBrightness);
  Inc(B, DeltaBrightness);

  Result := KColor(R, G, B);
end;

{ TKsBitmap ===================================================================}

constructor TKsBitmap.Create;
begin
  inherited Create;
  FFont := TFont.Create;
  with FBitmapInfo.bmiHeader do
  begin
    biSize := SizeOf(TBitmapInfoHeader);
    biPlanes := 1;
    biBitCount := 32;
    biCompression := BI_RGB;
  end;
end;

destructor TKsBitmap.Destroy;
begin
  if FDC <> 0 then DeleteDC(FDC);
  if FHandle <> 0 then DeleteObject(FHandle);
  FFont.Free;

  inherited Destroy;
end;

procedure TKsBitmap.AssignTo(Dst: TPersistent);
var
  Bmp: TBitmap;

  procedure CopyToBitmap(Bmp: TBitmap);
  begin
    Bmp.HandleType := bmDIB;
    Bmp.PixelFormat := pf24Bit;
    Bmp.Width := Width;
    Bmp.Height := Height;
    Draw(Bmp.Canvas, 0, 0);
  end;

begin
  if Dst is TPicture then CopyToBitmap(TPicture(Dst).Bitmap)
  else if Dst is TBitmap then CopyToBitmap(TBitmap(Dst))
  else if Dst is TClipboard then
  begin
    Bmp := TBitmap.Create;
    try
      CopyToBitmap(Bmp);
      TClipboard(Dst).Assign(Bmp);
    finally
      Bmp.Free;
    end;
  end
  else inherited;
end;

procedure TKsBitmap.Assign(Source: TPersistent);

  procedure AssignFromBitmap(SrcBmp: TBitmap);
  begin
    SetSize(SrcBmp.Width, SrcBmp.Height);
    if Empty then Exit;
    BitBlt(FDC, 0, 0, Width, Height, SrcBmp.Canvas.Handle, 0, 0, SRCCOPY);
    SetAlpha($FF);
  end;

var
  Canvas: TCanvas;
begin
  if Source is TKsBitmap then
  begin
  end
  else
    if Source is TBitmap then
    begin
      SetSize((Source as TBitmap).Width, (Source as TBitmap).Height);
      if Empty then Exit;
      BitBlt(FDC, 0, 0, FWidth, FHeight, (Source as TBitmap).Canvas.Handle, 0, 0, SRCCOPY);
      SetAlpha($FF);
    end
    else
      if Source is TGraphic then
      begin
        SetSize(TGraphic(Source).Width, TGraphic(Source).Height);
        if Empty then Exit;
        Canvas := TCanvas.Create;
        try
          Canvas.Handle := FDC;
          TGraphicAccess(Source).Draw(Canvas, Rect(0, 0, Width, Height));
          SetAlpha($FF);
        finally
          Canvas.Free;
        end;
      end
      else
        if Source is TPicture then
        begin
          with TPicture(Source) do
          begin
            if TPicture(Source).Graphic is TBitmap then
              AssignFromBitmap(TBitmap(TPicture(Source).Graphic))
            else
            begin
              // icons, metafiles etc...
              SetSize(TPicture(Source).Graphic.Width, TPicture(Source).Graphic.Height);
              if Empty then Exit;
              Canvas := TCanvas.Create;
              try
                Canvas.Handle := FDC;
                TGraphicAccess(Graphic).Draw(Canvas, Rect(0, 0, Width, Height));
                SetAlpha(255);
              finally
                Canvas.Free;
              end;
            end;
          end;
        end
        else  { inherited }
          inherited;
end;

procedure TKsBitmap.SetSize(AWidth, AHeight: Integer);
begin
  AWidth := Abs(AWidth);
  AHeight := Abs(AHeight);
  if (AWidth = 0) or (AHeight = 0) then Exit;
  if (AWidth = Width) and (AHeight = Height) then Exit;

  try
    { Free resource }
    if FDC <> 0 then DeleteDC(FDC);
    FDC := 0;
    if FHandle <> 0 then DeleteObject(FHandle);
    FHandle := 0;
    FBits := nil;
    FWidth := 0;
    FHeight := 0;

    { Initialization }
    with FBitmapInfo.bmiHeader do
    begin
      biWidth := AWidth;
      biHeight := -AHeight;
    end;

    { Create new DIB }
    FHandle := CreateDIBSection(0, FBitmapInfo, DIB_RGB_COLORS, Pointer(FBits), 0, 0);
    if FBits = nil then
      raise Exception.Create('Can''t allocate the DIB handle');

    FDC := CreateCompatibleDC(0);
    if FDC = 0 then
    begin
      DeleteObject(FHandle);
      FHandle := 0;
      FBits := nil;
      raise Exception.Create('Can''t create compatible DC');
    end;

    if SelectObject(FDC, FHandle) = 0 then
    begin
      DeleteDC(FDC);
      DeleteObject(FHandle);
      FDC := 0;
      FHandle := 0;
      FBits := nil;
      raise Exception.Create('Can''t select an object into DC');
    end;

    FWidth := AWidth;
    FHeight := AHeight;
  finally
    Changed;
  end;
end;

function TKsBitmap.Empty: Boolean;
begin
  Result := FHandle = 0;
end;

procedure TKsBitmap.Clear(Color: TKColor);
begin
  FillLongword(FBits^, FWidth * FHeight, Color);
end;

procedure TKsBitmap.PerformTransparent(Color: TKColor);
var
  i: integer;
  C: PKColor;
begin
  for i := 0 to FWidth * FHeight - 1 do
  begin
    C := @FBits[i];
    if (TKColorRec(C^).R = TKColorRec(Color).R) and
       (TKColorRec(C^).G = TKColorRec(Color).G) and
       (TKColorRec(C^).B = TKColorRec(Color).B)
    then
      C^ := ckTransparent;
  end;
end;

procedure TKsBitmap.Changed;
begin
  if Assigned(FOnChanged) then
    FOnChanged(Self);
end;

procedure TKsBitmap.ChangeHue(DeltaHue: integer);
var
  i: integer;
  Color: PKColor;
begin
  if FWidth * FHeight = 0 then Exit;

  for i := 0 to FWidth * FHeight - 1 do
  begin
    Color := @Bits[i];

    if (TKColorRec(Color^).A = 0) then Continue;

    Color^ := KsBitmap.ChangeHue(Color^, DeltaHue);
  end;
end;

procedure TKsBitmap.ChangeBrightness(DeltaBrightness: integer);
var
  i: integer;
  Color: PKColor;
begin
  if FWidth * FHeight = 0 then Exit;

  for i := 0 to FWidth * FHeight - 1 do
  begin
    Color := @Bits[i];

    if (TKColorRec(Color^).A = 0) then Continue;

    Color^ := KsBitmap.ChangeBrightness(Color^, DeltaBrightness);
  end;
end;

{ Drawing }

procedure TKsBitmap.Draw(DC: HDC; X, Y: integer);
begin
  { Draw bitmap to DC }
  BitBlt(DC, X, Y, FWidth, FHeight, FDC, 0, 0, SRCCOPY);
end;

procedure TKsBitmap.Draw(DC: HDC; X, Y: integer; SrcRect: TRect);
begin
  { Draw bitmap rect to DC }
  BitBlt(DC, X, Y, RectWidth(SrcRect), RectHeight(SrcRect), FDC,
    SrcRect.Left, SrcRect.Top, SRCCOPY);
end;

procedure TKsBitmap.Draw(DC: HDC; DstRect, SrcRect: TRect);
begin
  { Draw bitmap rect to DC }
  StretchBlt(DC, DstRect.Left, DstRect.Top, RectWidth(DstRect), RectHeight(DstRect),
    FDC, SrcRect.Left, SrcRect.Top, RectWidth(SrcRect), RectHeight(SrcRect), SRCCOPY);
end;

procedure TKsBitmap.Draw(Canvas: TCanvas; X, Y: integer);
begin
  { Draw bitmap to Canvas }
  BitBlt(Canvas.Handle, X, Y, FWidth, FHeight, FDC, 0, 0, SRCCOPY);
end;

procedure TKsBitmap.Draw(Canvas: TCanvas; X, Y: integer; SrcRect: TRect);
begin
  { Draw bitmap rect to Canvas }
  BitBlt(Canvas.Handle, X, Y, RectWidth(SrcRect), RectHeight(SrcRect), FDC,
    SrcRect.Left, SrcRect.Top, SRCCOPY);
end;

procedure TKsBitmap.Draw(Canvas: TCanvas; DstRect, SrcRect: TRect);
begin
  Draw(Canvas.Handle, DstRect, SrcRect);
end;

procedure TKsBitmap.Draw(Bitmap: TKsBitmap; X, Y: integer);
begin
  Draw(Bitmap, X, Y, Rect(0, 0, Width, Height));
end;

procedure TKsBitmap.Draw(Bitmap: TKsBitmap; X, Y: integer; SrcRect: TRect);
var
  i, j: integer;
  B, F: PKColor;
  BlendFunc: TBlendFunction;
begin
  if not FBlend then
    BitBlt(Bitmap.DC, X, Y, RectWidth(SrcRect), RectHeight(SrcRect), FDC,
      SrcRect.Left, SrcRect.Top, SRCCOPY)
  else
    if @AlphaBlend <> nil then
    begin
      { Windows Blend }
      BlendFunc.BlendOp := 0;
      BlendFunc.BlendFlags := 0;
      BlendFunc.Alpha := $FF;
      BlendFunc.Format := 1;
      AlphaBlend(Bitmap.DC, X, Y, RectWidth(SrcRect), RectHeight(SrcRect), FDC,
        SrcRect.Left, SrcRect.Top, RectWidth(SrcRect), RectHeight(SrcRect), BlendFunc);
    end
    else
    begin
      { KSDev Blend }
      if SrcRect.Left < 0 then SrcRect.Left := 0;
      if SrcRect.Top < 0 then SrcRect.Top := 0;
      if SrcRect.Right > FWidth then SrcRect.Right := FWidth;
      if SrcRect.Bottom > FHeight then SrcRect.Bottom := FHeight;
      { Draw bitmap rect to another bitmap }
      for i := SrcRect.Left to SrcRect.Right-1 do
        for j := SrcRect.Top to SrcRect.Bottom-1 do
        begin
          if X + (i-SrcRect.Left) < 0 then Continue;
          if Y + (j-SrcRect.Top) < 0 then Continue;
          if X + (i-SrcRect.Left) >= Bitmap.FWidth then Continue;
          if Y + (j-SrcRect.Top) >= Bitmap.FHeight then Continue;
          { Get Back pixel }
          B := @Bitmap.FBits[(X + (i-SrcRect.Left)) + (Y + (j-SrcRect.Top)) * Bitmap.FWidth];
          { Get fore pixel }
          F := @FBits[i + j * FWidth];
          { Blend }
          if TKColorRec(F^).A = 0 then Continue;
          if (TKColorRec(F^).A = $FF) then
            B^ := F^
          else
          begin
            { Blend }
            B^ := BlendPixel(F^, B^);
          end;
        end; 
    end;
end;

procedure TKsBitmap.Draw(Bitmap: TKsBitmap; DstRect, SrcRect: TRect);
var
  SrcW, SrcH, DstW, DstH: integer;
  R: TRect;
  SFX, SFY: integer;
  B, F: PKColor;
  DstX, DstY, SrcX: integer;
  SX, SY: integer;
  DX, DY: integer;
  BlendFunc: TBlendFunction;
  TP: TKColor;
begin
  { Stretch }
  if not FBlend then
    StretchBlt(Bitmap.FDC, DstRect.Left, DstRect.Top, RectWidth(DstRect), RectHeight(DstRect),
      FDC, SrcRect.Left, SrcRect.Top, RectWidth(SrcRect), RectHeight(SrcRect), SRCCOPY)
  else
    if @AlphaBlend <> nil then
    begin
      { Windows Blend }
      BlendFunc.BlendOp := 0;
      BlendFunc.BlendFlags := 0;
      BlendFunc.Alpha := $FF;
      BlendFunc.Format := 1;
      AlphaBlend(Bitmap.FDC, DstRect.Left, DstRect.Top, RectWidth(DstRect), RectHeight(DstRect),
        FDC, SrcRect.Left, SrcRect.Top, RectWidth(SrcRect), RectHeight(SrcRect), BlendFunc);
    end
    else
    begin
      { KSDev Stretch Blend }
      IntersectRect(R, SrcRect, Rect(0, 0, FWidth, FHeight));
      if (RectWidth(R) <= 0) or (RectHeight(R) <= 0) then Exit;
      if (RectWidth(DstRect) <= 0) or (RectHeight(DstRect) <= 0) then Exit;
      IntersectRect(R, DstRect, Rect(0, 0, Bitmap.FWidth, Bitmap.FHeight));
      if (RectWidth(R) <= 0) or (RectHeight(R) <= 0) then Exit;

      SrcW := RectWidth(SrcRect);
      SrcH := RectHeight(SrcRect);
      DstW := RectWidth(DstRect);
      DstH := RectHeight(DstRect);

      if (SrcW = DstW) and (SrcH = DstH) then
      begin
        Draw(Bitmap, DstRect.Left, DstRect.Top, SrcRect);
        Exit;
      end;

      SFX := MulDiv((R.Left - DstRect.Left) * SrcW, 65535, DstW);
      SFY := MulDiv((R.Top - DstRect.Top) * SrcH, 65535, DstH);

      DX := (SrcW shl 16) div DstW;
      DY := (SrcH shl 16) div DstH;
      SY := SFY;

      for DstY := R.Top to R.Bottom - 1 do
      begin
        F := @Bits[SrcRect.Left + (SY shr 16 + SrcRect.Top) * FWidth];
        B := @Bitmap.Bits[R.Left + (DstY * Bitmap.FWidth)];
        SX := SFX;
        for DstX := R.Left to R.Right - 1 do
        begin
          SrcX := SX shr 14 and $FFFFFFFC;
          Inc(SX, DX);
          { Get fore pixel }
          TP := PKColor(Integer(F) + SrcX)^;
          { Blend }
          if TKColorRec(TP).A = 0 then
            { Nothing }
          else
            if (TKColorRec(TP).A = $FF) then
              B^ := TP
            else
            begin
              { Blend }
              B^ := BlendPixel(TP, B^);
            end;

          Inc(B);
        end;
        Inc(SY, DY);
      end;
  end;
end; 

procedure TKsBitmap.DrawTile(Bitmap: TKsBitmap; DstRect, SrcRect: TRect);
var
  i, j: integer;
  R, R1, SrcR: TRect;
  Cx, Cy: integer;
  W, H, DW, DH: integer;
begin
  W := RectWidth(SrcRect);
  H := RectHeight(SrcRect);
  if W * H = 0 then Exit;

  SrcR := Rect(0, 0, W, H);
  OffsetRect(SrcR, DstRect.Left, DstRect.Top);

  Cx := RectWidth(DstRect) div W;
  if RectWidth(DstRect) mod W <> 0 then Inc(Cx);
  Cy := RectHeight(DstRect) div H;
  if RectHeight(DstRect) mod H <> 0 then Inc(Cy);

  for i := 0 to Cx do
    for j := 0 to Cy do
    begin
      R := SrcR;
      OffsetRect(R, i * W, j * H);

      IntersectRect(R, R, DstRect);

      DW := RectWidth(R);
      DH := RectHeight(R);

      if (DW = 0) or (DH = 0) then Break;

      if (DW <> W) or (DH <> H) then
      begin
        R1 := SrcRect;
        R1.Right := R1.Left + DW;
        R1.Bottom := R1.Top + DH;
        Draw(Bitmap, R, R1);
      end
      else
        Draw(Bitmap, R, SrcRect);

    end;
end;

procedure TKsBitmap.DrawStretch(Bitmap: TKsBitmap; DstRect, SrcRect: TRect);
begin
  Draw(Bitmap, DstRect, SrcRect);
end;

procedure TKsBitmap.DrawMarginRect(Buffer: TKsBitmap; MarginRect, MarginDstRect: TRect;
  Stretch: boolean);
var
  DstRect, R: TRect;
  i, j: integer;
  W, H: integer;
  DW, DH: integer;
begin
  W := RectWidth(MarginRect);
  H := RectHeight(MarginRect);
  if W * H = 0 then Exit;

  if not Stretch then
    DrawTile(Buffer, MarginDstRect, MarginRect)
  else
    DrawStretch(Buffer, MarginDstRect, MarginRect);
end;

procedure TKsBitmap.DrawMargin(Bitmap: TKsBitmap; DstRect, SrcRect: TRect;
  MarginLeft, MarginTop, MarginRight, MarginBottom: integer;
  Stretch: boolean);
var
  MarginSrcRect, MarginDstRect: TRect;
begin
  { Draw with margin }
  if (MarginLeft = 0) and (MarginTop = 0) and
     (MarginRight = 0) and (MarginBottom = 0) then
  begin
    Draw(Bitmap, DstRect, SrcRect);
    Exit;
  end;

  { Draw Center Rect }
  with SrcRect do
    MarginSrcRect := Rect(Left + MarginLeft, Top + MarginTop, Right - MarginRight,
      Bottom - MarginBottom);
  with DstRect do
    MarginDstRect := Rect(Left + MarginLeft, Top + MarginTop, Right - MarginRight,
      Bottom - MarginBottom);
  DrawMarginRect(Bitmap, MarginSrcRect, MarginDstRect, Stretch);

  { Draw Top Border }
  with SrcRect do
    MarginSrcRect := Rect(Left + MarginLeft, Top, Right - MarginRight, Top + MarginTop);
  with DstRect do
    MarginDstRect := Rect(Left + MarginLeft, Top, Right - MarginRight, Top + MarginTop);
  DrawMarginRect(Bitmap, MarginSrcRect, MarginDstRect, Stretch);

  { Draw Bottom Border }
  with SrcRect do
    MarginSrcRect := Rect(Left + MarginLeft, Bottom - MarginBottom, Right - MarginRight, Bottom);
  with DstRect do
    MarginDstRect := Rect(Left + MarginLeft, Bottom - MarginBottom, Right - MarginRight, Bottom);
  DrawMarginRect(Bitmap, MarginSrcRect, MarginDstRect, Stretch);

  { Draw Left Border }
  with SrcRect do
    MarginSrcRect := Rect(Left, Top + MarginTop, Left + MarginLeft, Bottom - MarginBottom);
  with DstRect do
    MarginDstRect := Rect(Left, Top + MarginTop, Left + MarginLeft, Bottom - MarginBottom);
  DrawMarginRect(Bitmap, MarginSrcRect, MarginDstRect, Stretch);

  { Draw Right Border }
  with SrcRect do
    MarginSrcRect := Rect(Right - MarginRight, Top + MarginTop, Right,
      Bottom - MarginBottom);
  with DstRect do
    MarginDstRect := Rect(Right - MarginRight, Top + MarginTop, Right,
      Bottom - MarginBottom);
  DrawMarginRect(Bitmap, MarginSrcRect, MarginDstRect, Stretch);

  { Draw Angles }
  with SrcRect do
    MarginSrcRect := Rect(Left, Top, Left + MarginLeft, Top + MarginTop);
  with DstRect do
    Draw(Bitmap, Left, Top, MarginSrcRect);

  with SrcRect do
    MarginSrcRect := Rect(Right - MarginRight, Top, Right, Top + MarginTop);
  with DstRect do
    Draw(Bitmap, Right - MarginRight, Top, MarginSrcRect);

  with SrcRect do
    MarginSrcRect := Rect(Left, Bottom - MarginBottom, Left + MarginLeft, Bottom);
  with DstRect do
    Draw(Bitmap, Left, Bottom - MarginBottom, MarginSrcRect);

  with SrcRect do
    MarginSrcRect := Rect(Right - MarginRight, Bottom - MarginBottom, Right, Bottom);
  with DstRect do
    Draw(Bitmap, Right - MarginRight, Bottom - MarginBottom, MarginSrcRect);
end;

{ Alpha }

procedure TKsBitmap.MergeDraw(Bitmap: TKsBitmap; X, Y: integer; SrcRect: TRect);
var
  Index, i, j: integer;
  B, F: PKColor;
begin
  if SrcRect.Left < 0 then
  begin
    X := X + Abs(SrcRect.Left);
    SrcRect.Left := 0;
  end;
  if SrcRect.Top < 0 then
  begin
    Y := Y + Abs(SrcRect.Top);
    SrcRect.Top := 0;
  end;
  if SrcRect.Right > Bitmap.FWidth then SrcRect.Right := Bitmap.FWidth;
  if SrcRect.Bottom > Bitmap.FHeight then SrcRect.Bottom := Bitmap.FHeight;
  { Draw bitmap rect to another bitmap }
  for i := SrcRect.Left to SrcRect.Right-1 do
    for j := SrcRect.Top to SrcRect.Bottom-1 do
    begin
      { Get Back pixel from Bitmap }
      B := @Bitmap.FBits[i + j * Bitmap.FWidth];
      { Get fore pixel }
      Index := (X + i-SrcRect.Left) + (Y + j-SrcRect.Top) * FWidth;
      if Index >= FWidth * FHeight then Continue
      else F := @FBits[Index];
      
      { Blend }
      if TKColorRec(F^).A = 0 then
        F^ := B^
      else
        if (TKColorRec(F^).A <> $FF) then
        begin
          { Blend }
          F^ := BlendPixel(F^, B^);
        end;
    end;
end;

procedure TKsBitmap.SetAlpha(Alpha: byte);
begin
  if FWidth*FHeight > 0 then
    FillAlpha(FBits^, FWidth*FHeight-1, Alpha);
end;

procedure TKsBitmap.SetAlpha(Alpha: byte; Rect: TRect);
begin
  if RectWidth(Rect) = 0 then Exit;
  if RectHeight(Rect) = 0 then Exit;

  if Rect.Left < 0 then Rect.Left := 0;
  if Rect.Top < 0 then Rect.Top := 0;
  if Rect.Right > FWidth then Rect.Right := FWidth;
  if Rect.Bottom > FHeight then Rect.Bottom := FHeight;

  FillAlphaRect(FBits^, FWidth, FHeight, Rect.Left, Rect.Top, Rect.Right-1,
    Rect.Bottom-1, Alpha);
end;

{ Drawing }

procedure TKsBitmap.MoveTo(X, Y: integer);
begin
  FLinePos := Point(X, Y);
  MoveToEx(FDC, FLinePos.X, FLinePos.Y, nil);
end;

procedure TKsBitmap.LineTo(X, Y: integer; Color: TKColor);
var
  Pen: TPen;
  SavePen: integer;
begin
  Pen := TPen.Create;
  try
    { Set Pen }
    Pen.Style := psSolid;
    Pen.Color := RGB(TKColorRec(Color).R, TKColorRec(Color).G, TKColorRec(Color).B);
    { Select Object }
    SavePen := SelectObject(FDC, Pen.Handle);
    { Draw Line }
    Windows.LineTo(FDC, X, Y);

    FLinePos := Point(X, Y);
  finally
    SelectObject(FDC, SavePen);
    Pen.Free;
  end;
end;

procedure TKsBitmap.DrawLine(R: TRect; Color: TKColor);
begin
  MoveTo(R.Left, R.Top);
  LineTo(R.Right, R.Bottom, Color);
end;

procedure TKsBitmap.DrawEdge(R: TRect; RaisedColor, SunkenColor: TKColor);
var
  Color: TKColor;
  i, j: integer;
begin
  if R.Left < 0 then R.Left := 0;
  if R.Top < 0 then R.Top := 0;
  if R.Right > Width then R.Right := Width;
  if R.Bottom > Height then R.Bottom := Height;
  if RectWidth(R) <= 0 then Exit;
  if RectHeight(R) <= 0 then Exit;

  Color := RaisedColor;
  j := R.Top;
  for i := R.Left to R.Right-2 do
    FBits[i + j * FWidth] := BlendPixel(Color, FBits[i + j * FWidth]);
  i := R.Left;
  for j := R.Top to R.Bottom-2 do
    FBits[i + j * FWidth] := BlendPixel(Color, FBits[i + j * FWidth]);

  Color := SunkenColor;
  j := R.Bottom-1;
  for i := R.Left to R.Right-1 do
    FBits[i + j * FWidth] := BlendPixel(Color, FBits[i + j * FWidth]);
  i := R.Right-1;
  for j := R.Top to R.Bottom-2 do
    FBits[i + j * FWidth] := BlendPixel(Color, FBits[i + j * FWidth]);
end;

procedure TKsBitmap.DrawBevel(R: TRect; Color: TKColor; Width: integer; Down: boolean);
var
  i: integer;
  SColor, RColor: TKColor;
begin
  { Draw bevel }
  for i := 0 to Width-1 do
  begin
    if Width = 1 then
    begin
      SColor := SunkenColor(Color, 35);
      RColor := RaisedColor(Color, 35);
    end
    else
    begin
      SColor := SunkenColor(Color, 17 * (Width-i));
      RColor := RaisedColor(Color, 17 * (Width-i));
    end;

    if Down then
      DrawEdge(R, SColor, RColor)
    else
      DrawEdge(R, RColor, SColor);

    InflateRect(R, -1, -1);
  end;
end;

procedure TKsBitmap.DrawRect(R: TRect; Color: TKColor);
begin
  DrawEdge(R, Color, Color);
end;

procedure TKsBitmap.DrawFocusRect(R: TRect; Color: TKColor);
var
  Brush: TBrush;
  Pen: TPen;
  SavePen: integer;
  SaveBrush: integer;
begin
  Brush := TBrush.Create;
  Pen := TPen.Create;
  try
    { Set Brush & Pen }
    Brush.Style := bsClear;
    Pen.Style := psSolid;
    Pen.Color := RGB(TKColorRec(Color).R, TKColorRec(Color).G, TKColorRec(Color).B);
    { Select Object }
    SaveBrush := SelectObject(FDC, Brush.Handle);
    SavePen := SelectObject(FDC, Pen.Handle);
    { Draw RoundRect }
    Windows.DrawFocusRect(FDC, R);
  finally
    SelectObject(FDC, SavePen);
    SelectObject(FDC, SaveBrush);
    Pen.Free;
    Brush.Free;
  end;
end;

procedure TKsBitmap.DrawRoundRect(R: TRect; Radius: integer; Color: TKColor);
var
  Brush: TBrush;
  Pen: TPen;
  SavePen: integer;
  SaveBrush: integer;
begin
  Brush := TBrush.Create;
  Pen := TPen.Create;
  try
    { Set Brush & Pen }
    Brush.Style := bsClear;
    Pen.Style := psSolid;
    Pen.Color := RGB(TKColorRec(Color).R, TKColorRec(Color).G, TKColorRec(Color).B);
    { Select Object }
    SaveBrush := SelectObject(FDC, Brush.Handle);
    SavePen := SelectObject(FDC, Pen.Handle);
    { Draw RoundRect }
    RoundRect(FDC, R.Left, R.Top, R.Right, R.Bottom, Radius, Radius);
  finally
    SelectObject(FDC, SavePen);
    SelectObject(FDC, SaveBrush);
    Pen.Free;
    Brush.Free;
  end;
end;

procedure TKsBitmap.DrawEllipse(R: TRect; Color: TKColor);
var
  Brush: TBrush;
  Pen: TPen;
  SavePen: integer;
  SaveBrush: integer;
begin
  Brush := TBrush.Create;
  Pen := TPen.Create;
  try
    { Set Brush & Pen }
    Brush.Style := bsClear;
    Pen.Style := psSolid;
    Pen.Color := RGB(TKColorRec(Color).R, TKColorRec(Color).G, TKColorRec(Color).B);
    { Select Object }
    SaveBrush := SelectObject(FDC, Brush.Handle);
    SavePen := SelectObject(FDC, Pen.Handle);
    { Draw RoundRect }
    Ellipse(FDC, R.Left, R.Top, R.Right, R.Bottom);
  finally
    SelectObject(FDC, SavePen);
    SelectObject(FDC, SaveBrush);
    Pen.Free;
    Brush.Free;
  end;
end;

procedure TKsBitmap.FillEllipse(R: TRect; Color: TKColor);
var
  Brush: TBrush;
  Pen: TPen;
  SavePen: integer;
  SaveBrush: integer;
begin
  Brush := TBrush.Create;
  Pen := TPen.Create;
  try
    { Set Brush & Pen }
    Brush.Style := bsSolid;
    Brush.Color := RGB(TKColorRec(Color).R, TKColorRec(Color).G, TKColorRec(Color).B);
    Pen.Style := psSolid;
    Pen.Color := Brush.Color;
    { Select Object }
    SaveBrush := SelectObject(FDC, Brush.Handle);
    SavePen := SelectObject(FDC, Pen.Handle);
    { Draw RoundRect }
    Ellipse(FDC, R.Left, R.Top, R.Right, R.Bottom);
  finally
    SelectObject(FDC, SavePen);
    SelectObject(FDC, SaveBrush);
    Pen.Free;
    Brush.Free;
  end;
end;

procedure TKsBitmap.FillRect(R: TRect; Color: TKColor);
var
  i, j: integer;
begin
  if R.Left < 0 then R.Left := 0;
  if R.Top < 0 then R.Top := 0;
  if R.Right > Width then R.Right := Width;
  if R.Bottom > Height then R.Bottom := Height;
  if RectWidth(R) <= 0 then Exit;
  if RectHeight(R) <= 0 then Exit;

  if Blend then
  begin
    for i := R.Left to R.Right-1 do
      for j := R.Top to R.Bottom-1 do
        FBits[i + j * FWidth] := BlendPixel(Color, FBits[i + j * FWidth]);
  end
  else
    FillLongwordRect(FBits^, FWidth, FHeight, R.Left, R.Top, R.Right-1, R.Bottom-1, Color);
end;

procedure TKsBitmap.FillRoundRect(R: TRect; Radius: integer;
  Color: TKColor);
var
  Brush: TBrush;
  Pen: TPen;
  SavePen: integer;
  SaveBrush: integer;
begin
  Brush := TBrush.Create;
  Pen := TPen.Create;
  try
    { Set Brush & Pen }
    Brush.Style := bsSolid;
    Brush.Color := RGB(TKColorRec(Color).R, TKColorRec(Color).G, TKColorRec(Color).B);
    Pen.Style := psSolid;
    Pen.Color := Brush.Color;
    { Select Object }
    SaveBrush := SelectObject(FDC, Brush.Handle);
    SavePen := SelectObject(FDC, Pen.Handle);
    { Draw RoundRect }
    RoundRect(FDC, R.Left, R.Top, R.Right, R.Bottom, Radius, Radius);
  finally
    SelectObject(FDC, SavePen);
    SelectObject(FDC, SaveBrush);
    Pen.Free;
    Brush.Free;
  end;
end;

procedure TKsBitmap.FillHalftoneRect(R: TRect; Color, HalfColor: TKColor);
var
  i, j: integer;
  C: PKColor;
begin
  if R.Left < 0 then R.Left := 0;
  if R.Top < 0 then R.Top := 0;
  if R.Right > Width then R.Right := Width;
  if R.Bottom > Height then R.Bottom := Height;
  if RectWidth(R) <= 0 then Exit;
  if RectHeight(R) <= 0 then Exit;

  FillRect(R, Color);
  { Add Halftone }
  for i := R.Left to R.Right-1 do
    for j := R.Top to R.Bottom-1 do
    begin
      C := @FBits[i + j * FWidth];
      if Odd(i) and Odd(j) then
        C^ := HalfColor;
      if not Odd(i) and not Odd(j) then
        C^ := HalfColor;
    end;
end;

procedure TKsBitmap.FillGradientRect(Rect: TRect; BeginColor,
  EndColor: TKColor; Vertical: boolean);
var
  RGBFrom: array[0..3] of integer;
  RGBDiff: array[0..4] of integer;
  ColorBand : TRect;
  Colors: integer;

  I: Integer;
  R,G,B,A: Byte;
begin
  if Rect.Left < 0 then Rect.Left := 0;
  if Rect.Top < 0 then Rect.Top := 0;
  if Rect.Right > Width then Rect.Right := Width;
  if Rect.Bottom > Height then Rect.Bottom := Height;
  if RectWidth(Rect) <= 0 then Exit;
  if RectHeight(Rect) <= 0 then Exit;

  Colors := 255;
  if not Vertical and (Colors > RectWidth(Rect)) then
    Colors := RectWidth(Rect);
  if Vertical and (Colors > RectHeight(Rect)) then
    Colors := RectHeight(Rect);

  { extract from RGB values }
  RGBFrom[0] := TKColorRec(BeginColor).R * $FF;
  RGBFrom[1] := TKColorRec(BeginColor).G * $FF;
  RGBFrom[2] := TKColorRec(BeginColor).B * $FF;
  RGBFrom[3] := TKColorRec(BeginColor).A * $FF;
  { calculate difference of from and to RGB values }
  RGBDiff[0] := TKColorRec(EndColor).R * $FF - RGBFrom[0];
  RGBDiff[1] := TKColorRec(EndColor).G * $FF - RGBFrom[1];
  RGBDiff[2] := TKColorRec(EndColor).B * $FF - RGBFrom[2];
  RGBDiff[3] := TKColorRec(EndColor).A * $FF - RGBFrom[3];

  ColorBand := Rect;
  for I := 0 to Colors do
  begin
    { calculate color band's top and bottom coordinates }
    if not Vertical then
    begin
      ColorBand.Left := MulDiv(I, RectWidth(Rect), Colors);
      ColorBand.Right := MulDiv(Succ(I), RectWidth(Rect), Colors);

      ColorBand.Left := ColorBand.Left + Rect.Left;
      ColorBand.Right := ColorBand.Right + Rect.Left;
    end else
    begin
      ColorBand.Top := MulDiv (I, RectHeight(Rect), Colors);
      ColorBand.Bottom := MulDiv (Succ(I), RectHeight(Rect), Colors);

      ColorBand.Top := ColorBand.Top + Rect.Top;
      ColorBand.Bottom := ColorBand.Bottom + Rect.Top;
    end;

    { calculate color band color }
    R := Round((RGBFrom[0] + ((I * RGBDiff[0]) /  Colors)) / $FF);
    G := Round((RGBFrom[1] + ((I * RGBDiff[1]) /  Colors)) / $FF);
    B := Round((RGBFrom[2] + ((I * RGBDiff[2]) /  Colors)) / $FF);
    A := Round((RGBFrom[3] + ((I * RGBDiff[3]) /  Colors)) / $FF);

    if (i = 0) or (i = Colors) then
      IntersectRect(ColorBand, Rect, ColorBand);

    FillRect(ColorBand, KColor(R, G, B, A));
  end;
end;

procedure TKsBitmap.FillRadialGradientRect(Rect: TRect; BeginColor,
  EndColor: TKColor; Pos: TPoint);
var
  RGBFrom: array[0..3] of integer;
  RGBDiff: array[0..4] of integer;
  Colors: integer;

  ColorBand: TRect;
  Len: integer;
  I: Integer;
  R,G,B,A: Byte;
  ClipRgn: HRgn;
begin
  if Rect.Left < 0 then Rect.Left := 0;
  if Rect.Top < 0 then Rect.Top := 0;
  if Rect.Right > Width then Rect.Right := Width;
  if Rect.Bottom > Height then Rect.Bottom := Height;
  if RectWidth(Rect) <= 0 then Exit;
  if RectHeight(Rect) <= 0 then Exit;

  Colors := 50;

  { extract from RGB values }
  RGBFrom[0] := TKColorRec(BeginColor).R * $FF;
  RGBFrom[1] := TKColorRec(BeginColor).G * $FF;
  RGBFrom[2] := TKColorRec(BeginColor).B * $FF;
  RGBFrom[3] := TKColorRec(BeginColor).A * $FF;
  { calculate difference of from and to RGB values }
  RGBDiff[0] := TKColorRec(EndColor).R * $FF - RGBFrom[0];
  RGBDiff[1] := TKColorRec(EndColor).G * $FF - RGBFrom[1];
  RGBDiff[2] := TKColorRec(EndColor).B * $FF - RGBFrom[2];
  RGBDiff[3] := TKColorRec(EndColor).A * $FF - RGBFrom[3];

  { set clip region }
  ClipRgn := CreateRectRgn(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom);
  SelectClipRgn(FDC, ClipRgn);

  try
    { calc length }
    if RectWidth(Rect) > RectHeight(Rect) then
      Len := RectWidth(Rect)
    else
      Len := RectHeight(Rect);

    for I := Colors downto 0 do
    begin
      { calculate color band color }
      R := Round((RGBFrom[0] + ((I * RGBDiff[0]) /  Colors)) / $FF);
      G := Round((RGBFrom[1] + ((I * RGBDiff[1]) /  Colors)) / $FF);
      B := Round((RGBFrom[2] + ((I * RGBDiff[2]) /  Colors)) / $FF);
      A := Round((RGBFrom[3] + ((I * RGBDiff[3]) /  Colors)) / $FF);

      ColorBand.TopLeft := Rect.TopLeft;
      ColorBand.Right := ColorBand.Left + MulDiv(Succ(I), Len, Colors) * 2;
      ColorBand.Bottom := ColorBand.Top + MulDiv(Succ(I), Len, Colors) * 2;

      OffsetRect(ColorBand, -RectWidth(ColorBand) div 2, -RectHeight(ColorBand) div 2);

      OffsetRect(ColorBand, Round((Pos.X / 100) * RectWidth(Rect)),
        Round((Pos.X / 100) * RectHeight(Rect)));

      { paint circle  }
      FillEllipse(ColorBand, KColor(R, G, B, A));
    end;
  finally
    SelectClipRgn(DC, 0);
    DeleteObject(ClipRgn);
  end;
end;

procedure TKsBitmap.DrawPolygon(Points: array of TPoint; Color: TColor);
var
  Brush: TBrush;
  Pen: TPen;
  SavePen: integer;
  SaveBrush: integer;
begin
  Brush := TBrush.Create;
  Pen := TPen.Create;
  try
    { Set Brush & Pen }
    Brush.Style := bsClear;
    Pen.Style := psSolid;
    Pen.Color := RGB(TKColorRec(Color).R, TKColorRec(Color).G, TKColorRec(Color).B);
    { Select Object }
    SaveBrush := SelectObject(FDC, Brush.Handle);
    SavePen := SelectObject(FDC, Pen.Handle);
    { Draw Polygon }
    Windows.Polygon(FDC, PPoints(@Points)^, High(Points) + 1);
  finally
    SelectObject(FDC, SavePen);
    SelectObject(FDC, SaveBrush);
    Pen.Free;
    Brush.Free;
  end;
end;

procedure TKsBitmap.FillPolygon(Points: array of TPoint; Color: TColor);
var
  Brush: TBrush;
  Pen: TPen;
  SavePen: integer;
  SaveBrush: integer;
begin
  Brush := TBrush.Create;
  Pen := TPen.Create;
  try
    { Set Brush & Pen }
    Brush.Style := bsSolid;
    Brush.Color := RGB(TKColorRec(Color).R, TKColorRec(Color).G, TKColorRec(Color).B);
    Pen.Style := psSolid;
    Pen.Color := Brush.Color;
    { Select Object }
    SaveBrush := SelectObject(FDC, Brush.Handle);
    SavePen := SelectObject(FDC, Pen.Handle);
    { Draw Polygon }
    Windows.Polygon(FDC, PPoints(@Points)^, High(Points) + 1);
  finally
    SelectObject(FDC, SavePen);
    SelectObject(FDC, SaveBrush);
    Pen.Free;
    Brush.Free;
  end;
end;

procedure TKsBitmap.FillHalftonePolygon(Points: array of TPoint; Color,
  HalfColor: TKColor);
var
  TopLeft, BottomRight: TPoint;
  i, j: integer;
  C: PKColor;
begin
  FillPolygon(Points, Color);
  { Calc Polygon Rect }
  TopLeft := Point(MaxInt, MaxInt);
  BottomRight := Point(0, 0);
  for i := Low(Points) to High(Points) do
  begin
    if Points[i].X < TopLeft.X then
      TopLeft.X := Points[i].X;
    if Points[i].Y < TopLeft.Y then
      TopLeft.Y := Points[i].Y;

    if Points[i].X > BottomRight.X then
      BottomRight.X := Points[i].X;
    if Points[i].Y > BottomRight.Y then
      BottomRight.Y := Points[i].Y;
  end;
  { Draw Halftone }
  for i := TopLeft.X to BottomRight.X-1 do
    for j := TopLeft.Y to BottomRight.Y-1 do
    begin
      if not PointInPolygon(Point(i, j), Points) then Continue;
      C := @FBits[i + j * FWidth];
      if Odd(i) and Odd(j) then
        C^ := HalfColor;
      if not Odd(i) and not Odd(j) then
        C^ := HalfColor;
    end;
end;

function TKsBitmap.TextHeight(AText: string): integer;
var
  R: TRect;
  SaveObject: integer;
begin
  Result := 0;

  if not Empty then
  begin
    SaveObject := SelectObject(FDC, FFont.Handle);
    R := Rect(0, 0, 0, 0);
    Windows.DrawText(FDC, PChar(AText), Length(AText), R, DT_CALCRECT);
    SelectObject(FDC, SaveObject);

    Result := R.Bottom;
  end;
end;

procedure TKsBitmap.DrawVerticalText(AText: string; Bounds: TRect;
  Flag: cardinal; FromTop: boolean);
var
  R, R1: TRect;
  TempBuf: TKsBitmap;
  BackColor: TKColor;
  i, j: integer;
  Pixel: TKColor;
begin
  R := Bounds;
  BackColor := KColor(255, 0, 255);

  TempBuf := TKsBitmap.Create;
  try
    TempBuf.SetSize(RectHeight(R), RectWidth(R));
    TempBuf.Clear(BackColor);
    TempBuf.Font.Assign(Self.Font);

    { Draw Horizontaly }
    R1 := Rect(0, 0, TempBuf.Width, TempBuf.Height);
    TempBuf.DrawText(AText, R1, Flag);

    { Rotate }
    for i := 0 to TempBuf.Width - 1 do
      for j := 0 to TempBuf.Height - 1 do
      begin
        if TempBuf.Pixels[i, j] = BackColor then Continue;

        if not FromTop then
          Pixels[Bounds.Left + j, Bounds.Bottom - i] := KColor(FFont.Color)
        else
          Pixels[Bounds.Right - j, Bounds.Top + i] := KColor(FFont.Color)
      end;
  finally
    TempBuf.Free;
  end;
end;

function TKsBitmap.TextWidth(AText: string; Flags: Integer = 0): integer;
var
  SaveObject: integer;
  R: TRect;
begin
  Result := 0;

  if not Empty then
  begin
    SaveObject := SelectObject(FDC, FFont.Handle);
    R := Rect(0, 0, 0, 0);
    Windows.DrawText(FDC, PChar(AText), Length(AText), R, DT_CALCRECT or Flags);
    SelectObject(FDC, SaveObject);

    Result := R.Right;
  end;
end;

function TKsBitmap.DrawText(AText: string; var Bounds: TRect; Flag: cardinal): integer;
var
  SaveFont: HFONT;
  SaveTextColor: TColorRef;
begin
  SaveFont := SelectObject(DC, FFont.Handle);
  try
    SetBkMode(DC, Transparent);
    SaveTextColor := SetTextColor(DC, ColorToRGB(FFont.Color));
    Result := Windows.DrawText(DC, PChar(AText), Length(AText), Bounds, Flag);
    SetTextColor (DC, SaveTextColor);
  finally
    SelectObject (DC, SaveFont);
  end;
end;

function TKsBitmap.DrawText(AText: string; X, Y: integer): integer;
var
  R: TRect;
begin
  R := Rect(X, Y, X + TextWidth(AText), Y + TextHeight(AText));
  DrawText(AText, R, 0);
end;

{ I/O }

procedure TKsBitmap.LoadFromBmpStream(Stream: TStream);
var
  B: TBitmap;
begin
  B := TBitmap.Create;
  try
    B.LoadFromStream(Stream);
    Assign(B);
  finally
    B.Free;
  end;
end;

procedure TKsBitmap.LoadFromBmpFile(const FileName: string);
var
  B: TBitmap;
begin
  B := TBitmap.Create;
  try
    B.LoadFromFile(FileName);
    Assign(B);
  finally
    B.Free;
  end;
end;

procedure TKsBitmap.SaveToBmpFile(const FileName: string);
var
  B: TBitmap;
begin
  B := TBitmap.Create;
  try
    B.Assign(Self);
    B.SaveToFile(FileName);
  finally
    B.Free;
  end;
end;

procedure TKsBitmap.LoadFromStream(Stream: TStream);
var
  W, H: integer;
begin
  FName := ReadString(Stream);
  Stream.Read(W, SizeOf(Integer));
  Stream.Read(H, SizeOf(Integer));
  SetSize(W, H);
  if (FWidth = W) and (FHeight = H) then
    Stream.Read(FBits^, FWidth*FHeight*SizeOf(Longword));
end;

procedure TKsBitmap.SaveToStream(Stream: TStream);
begin
  WriteString(Stream, FName);
  Stream.Write(FWidth, SizeOf(Integer));
  Stream.Write(FHeight, SizeOf(Integer));
  Stream.Write(FBits^, FWidth*FHeight*SizeOf(Longword));
end;

procedure TKsBitmap.LoadFromFile(const FileName: string);
var
  F: TFileStream;
begin
  F := TFileStream.Create(FileName, fmOpenRead);
  try
    LoadFromStream(F);
  finally
    F.Free;
  end;
end;

procedure TKsBitmap.SaveToFile(const FileName: string);
var
  F: TFileStream;
begin
  F := TFileStream.Create(FileName, fmCreate);
  try
    SaveToStream(F);
  finally
    F.Free;
  end;
end;

{ BitmapLink }

function TKsBitmap.GetBitmapLink(Rect: TRect): TKsBitmapLink;
begin
  Result := TKsBitmapLink.Create;
  Result.Bitmap := Self;
  Result.Name := Name;
  Result.Rect := Rect;
end;

function TKsBitmap.GetBitmapLink(Rect: string): TKsBitmapLink;
begin
  Result := TKsBitmapLink.Create;
  Result.Bitmap := Self;
  Result.Name := Name;
  Result.Rect := StringToRect(Rect);
end;

{ Pixels  }

function TKsBitmap.GetPixel(X, Y: Integer): TKColor;
begin
  if (FBits <> nil) and (X >= 0) and (Y >= 0) and (X < FWidth) and (Y < FHeight) then
    Result := FBits[X + Y * FWidth]
  else
    Result := ckBlack; 
end;

procedure TKsBitmap.SetPixel(X, Y: Integer; Value: TKColor);
begin
  if X < 0 then Exit;
  if Y < 0 then Exit;
  if X > FWidth then Exit;
  if Y > FHeight then Exit;

  if FBits <> nil then
    FBits[X + Y * FWidth] := Value;
end;

{ Properties }

procedure TKsBitmap.SetHeight(const Value: integer);
begin
  SetSize(FWidth, Value);
end;

procedure TKsBitmap.SetWidth(const Value: integer);
begin
  SetSize(Value, FHeight);
end;

procedure TKsBitmap.SetFont(const Value: TFont);
begin
  FFont.Assign(Value);
end;

{ TKsBitmapLink ===============================================================}

constructor TKsBitmapLink.Create;
begin
  inherited Create;
end;

destructor TKsBitmapLink.Destroy;
begin
  inherited Destroy;
end;

procedure TKsBitmapLink.Assign(Source: TPersistent);
begin
  if Source is TKsBitmapLink then
  begin
    FBitmap := (Source as TKsBitmapLink).FBitmap;
    FRect := (Source as TKsBitmapLink).FRect;
    FName := (Source as TKsBitmapLink).FName;
  end
  else
    inherited;
end;

procedure TKsBitmapLink.Draw(Canvas: TCanvas; X, Y: integer);
begin
  if FBitmap = nil then Exit;
  if FBitmap.Empty then Exit;
  if FRect.Right - FRect.Left <= 0 then Exit;
  if FRect.Bottom - FRect.Top <= 0 then Exit;
  { Draw bitmap link }
  FBitmap.Draw(Canvas, X, Y, FRect);
end;

procedure TKsBitmapLink.Draw(Bitmap: TKsBitmap; X, Y: integer);
begin
  if FBitmap = nil then Exit;
  if FBitmap.Empty then Exit;
  if FRect.Right - FRect.Left <= 0 then Exit;
  if FRect.Bottom - FRect.Top <= 0 then Exit;
  { Draw bitmap link }
  FBitmap.Draw(Bitmap, X, Y, FRect);
end;

function TKsBitmapLink.GetAssigned: boolean;
begin
  Result := (FBitmap <> nil) and (RectWidth(FRect) * RectHeight(FRect) > 0);
end;

function TKsBitmapLink.GetBottom: integer;
begin
  Result := FRect.Bottom;
end;

function TKsBitmapLink.GetLeft: integer;
begin
  Result := FRect.Left;
end;

function TKsBitmapLink.GetRight: integer;
begin
  Result := FRect.Right;
end;

function TKsBitmapLink.GetTop: integer;
begin
  Result := FRect.Top;
end;

procedure TKsBitmapLink.SetBottom(const Value: integer);
begin
  FRect.Bottom := Value;
end;

procedure TKsBitmapLink.SetLeft(const Value: integer);
begin
  FRect.Left := Value;
end;

procedure TKsBitmapLink.SetRight(const Value: integer);
begin
  FRect.Right := Value;
end;

procedure TKsBitmapLink.SetTop(const Value: integer);
begin
  FRect.Top := Value;
end;

{ TKsBitmapList ===============================================================}

constructor TKsBitmapList.Create;
begin
  inherited Create;
end;

destructor TKsBitmapList.Destroy;
begin
  Clear;
  inherited Destroy;
end;

procedure TKsBitmapList.Clear;
var
  i: integer;
begin
  for i := 0 to Count-1 do
    TKsBitmap(Items[i]).Free;

  inherited Clear;
end;

function TKsBitmapList.GetBitmap(index: integer): TKsBitmap;
begin
  if (index >= 0) and (index < Count) then
    Result := TKsBitmap(Items[index])
  else
    Result := nil;
end;

function TKsBitmapList.GetBitmapLink(Bitmap: TKsBitmap; Rect: TRect): TKsBitmapLink;
var
  i: integer;
begin
  Result := nil;

  { Create BitmapLink }

  for i := 0 to Count-1 do
    if Bitmaps[i] = Bitmap then
      Result := Bitmaps[i].GetBitmapLink(Rect);
end;

function TKsBitmapList.GetBitmapLink(Name: string; Rect: TRect): TKsBitmapLink;
var
  i: integer;
begin
  Result := nil;
  
  { Create BitmapLink }

  for i := 0 to Count-1 do
    if LowerCase(Bitmaps[i].Name) = LowerCase(Name) then
      Result := Bitmaps[i].GetBitmapLink(Rect);
end;

function TKsBitmapList.GetBitmapLink(Name, Rect: string): TKsBitmapLink;
var
  i: integer;
begin
  Result := nil;

  { Create BitmapLink }

  for i := 0 to Count-1 do
    if LowerCase(Bitmaps[i].Name) = LowerCase(Name) then
      Result := Bitmaps[i].GetBitmapLink(Rect);
end;

function TKsBitmapList.GetBitmapByName(index: string): TKsBitmap;
var
  i: integer;
begin
  Result := nil;

  for i := 0 to Count - 1 do
    if LowerCase(Bitmaps[i].Name) = LowerCase(index) then
    begin
      Result := Bitmaps[i];
      Exit;
    end;
end;

procedure InitWindowsBlend;
begin
  if not EnableWindowsBlend then Exit;
  
  MSImg32Lib := LoadLibrary('msimg32.dll');
  if MSImg32Lib <> 0 then
  begin
    @TransparentBlt := GetProcAddress(MSImg32Lib, 'TransparentBlt');
    @AlphaBlend := GetProcAddress(MSImg32Lib, 'AlphaBlend');
  end;
end;

initialization
  ckWindow := KColor(clWindow);
  ckBtnFace := KColor(clBtnFace);
  ckBtnShadow := KColor(clBtnShadow);

  InitWindowsBlend;
finalization
  if MSImg32Lib <> 0 then
    FreeLibrary(MSImg32Lib);
end.




