{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvTransparentButton.PAS, released on 2002-05-26.

The Initial Developer of the Original Code is Peter Thörnqvist [peter3 at sourceforge dot net]
Portions created by Peter Thörnqvist are Copyright (C) 2002 Peter Thörnqvist.
All Rights Reserved.

Contributor(s):
  Andreas Hausladen (refactored)

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvTransparentButton.pas 11400 2007-06-28 21:24:06Z ahuser $

unit JvTransparentButton;

{$I jvcl.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  SysUtils, Classes,
  Windows, Messages, Graphics, Controls,
  ExtCtrls, Menus, Forms, ImgList, ActnList, Buttons,
  CommCtrl, JvJCLUtils,
  JvComponent, JvButton;

type
  TJvFrameStyle =
    (fsRegular, fsIndent, fsExplorer, fsNone, fsLight, fsDark, fsMono);
  TJvTextAlign = (ttaTopLeft, ttaTop, ttaTopRight, ttaRight, ttaBottomRight,
    ttaBottom, ttaBottomLeft, ttaLeft, ttaCenter);

type
  TJvTransparentButtonActionLink = class(TControlActionLink)
  protected
    FClient: TJvCustomGraphicButton;
    procedure AssignClient(AClient: TObject); override;
    function IsCheckedLinked: Boolean; override;
    {$IFDEF COMPILER6_UP}
    function IsGroupIndexLinked: Boolean; override;
    procedure SetGroupIndex(Value: Integer); override;
    {$ENDIF COMPILER6_UP}
    procedure SetChecked(Value: Boolean); override;
    procedure SetImageIndex(Value: Integer); override;
  end;

  TJvTransparentButton = class;

  TJvTransparentButtonImages = class(TPersistent)
  private
    FButton: TJvTransparentButton;

    FGrayList: TCustomImageList;
    FActiveList: TCustomImageList;
    FDisabledList: TCustomImageList;
    FDownList: TCustomImageList;
    FHotList: TCustomImageList;
    FGrayLink: TChangeLink;
    FActiveLink: TChangeLink;
    FDisabledLink: TChangeLink;
    FDownLink: TChangeLink;
    FHotLink: TChangeLink;
    FGrayIndex: TImageIndex;
    FActiveIndex: TImageIndex;
    FDisabledIndex: TImageIndex;
    FDownIndex: TImageIndex;
    FHotIndex: TImageIndex;
    procedure SetGrayList(Value: TCustomImageList);
    procedure SetActiveList(Value: TCustomImageList);
    procedure SetDisabledList(Value: TCustomImageList);
    procedure SetDownList(Value: TCustomImageList);
    procedure SetHotList(Value: TCustomImageList);
    procedure SetGrayIndex(Value: TImageIndex);
    procedure SetActiveIndex(Value: TImageIndex);
    procedure SetDisabledIndex(Value: TImageIndex);
    procedure SetDownIndex(Value: TImageIndex);
    procedure SetHotIndex(Value: TImageIndex);
  protected
    procedure AddGlyphs;
    procedure SetImageList(var List: TCustomImageList; Link: TChangeLink;
      Value: TCustomImageList);
  public
    constructor Create(AButton: TJvTransparentButton);
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
  published
    property ActiveImage: TCustomImageList read FActiveList write SetActiveList;
    property ActiveIndex: TImageIndex read FActiveIndex write SetActiveIndex default -1;
    property GrayImage: TCustomImageList read FGrayList write SetGrayList;
    property GrayIndex: TImageIndex read FGrayIndex write SetGrayIndex default -1;
    property DisabledImage: TCustomImageList read FDisabledList write SetDisabledList;
    property DisabledIndex: TImageIndex read FDisabledIndex write SetDisabledIndex default -1;
    property DownImage: TCustomImageList read FDownList write SetDownList;
    property DownIndex: TImageIndex read FDownIndex write SetDownIndex default -1;
    property HotImage: TCustomImageList read FHotList write SetHotList;
    property HotIndex: TImageIndex read FHotIndex write SetHotIndex default -1;
  end;

  TJvTransparentButton = class(TJvCustomGraphicButton)
  private
    FTextAlign: TJvTextAlign;
    FAutoGray: Boolean;
    FTransparent: Boolean;
    FShowPressed: Boolean;
    FPressOffset: Integer;
    FSpacing: Integer;
    FBorderSize: Cardinal;
    FImList: TCustomImageList;
    FOutline: TJvFrameStyle;
    FWordWrap: Boolean;

    { former TJvTransparentButton }
    FGlyph: TBitmap;
    FGrayGlyph: TBitmap;
    FDisabledGlyph: TBitmap;
    FNumGlyphs: TNumGlyphs;
    { former TJvTransparentButton2 }
    FKeepMouseLeavePressed: Boolean;
    FImages: TJvTransparentButtonImages;
    { former TJvTransparentButton }
    procedure SetGlyph(Bmp: TBitmap);
    procedure SetNumGlyphs(Value: TNumGlyphs);
    procedure CalcGlyphCount;
    { former TJvTransparentButton2 }
    procedure SetImages(Value: TJvTransparentButtonImages);

    procedure SetWordWrap(Value: Boolean);
    procedure SetSpacing(Value: Integer);
    procedure SetAutoGray(Value: Boolean);
    procedure SetTextAlign(Value: TJvTextAlign);
    procedure SetFrameStyle(Value: TJvFrameStyle);
    procedure SetTransparent(Value: Boolean);
    procedure SetBorderWidth(Value: Cardinal);
    function GetUseImages: Boolean;
  protected
    procedure PaintButton(Canvas: TCanvas); override;
    procedure PaintFrame(Canvas: TCanvas); override;
    procedure DrawTheText(ARect: TRect; Canvas: TCanvas); virtual;
    procedure DrawTheBitmap(ARect: TRect; Canvas: TCanvas); virtual;
    function GetActionLinkClass: TControlActionLinkClass; override;
    procedure GlyphChanged(Sender: TObject);

    { former TJvTransparentButton }
    procedure AddGlyphGlyphs(AGlyph: TBitmap; AColor: TColor; Value: Integer);
    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;

    { former TJvTransparentButton2 }
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure AddImageGlyphs;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    property InternalList: TCustomImageList read FImList;
    property Canvas;
    property UseImages: Boolean read GetUseImages;
  published
    property Action;
    property AllowAllUp;
    property Align;
    property Anchors;
    property Constraints;

    property AutoGray: Boolean read FAutoGray write SetAutoGray default True;
    property BorderWidth: Cardinal read FBorderSize write SetBorderWidth default 1;
    property Caption;
    property Color;
    property DropDownMenu;
    property DropArrow;
    property Down;
    property Enabled;
    property Font;
    property GroupIndex;
    property HotTrack;
    property HotTrackFont;
    property HotTrackFontOptions;

    property FrameStyle: TJvFrameStyle read FOutline write SetFrameStyle default fsExplorer;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property ShowPressed: Boolean read FShowPressed write FShowPressed default True;
    property PressOffset: Integer read FPressOffset write FPressOffset default 1;
    property Spacing: Integer read FSpacing write SetSpacing default 2;
    property TextAlign: TJvTextAlign read FTextAlign write SetTextAlign default ttaCenter;
    property Transparent: Boolean read FTransparent write SetTransparent default True;
    property Visible;
    property WordWrap: Boolean read FWordWrap write SetWordWrap default False;

    property OnClick;
    property OnDragDrop;
    property OnDropDownMenu;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnParentColorChange;
    property OnStartDrag;

    { former TJvTransparentButton }
    property Glyph: TBitmap read FGlyph write SetGlyph;
    property NumGlyphs: TNumGlyphs read FNumGlyphs write SetNumGlyphs default 1;
    { former TJvTransparentButton2 }
    property KeepMouseLeavePressed: Boolean read FKeepMouseLeavePressed write FKeepMouseLeavePressed default False;
    property Images: TJvTransparentButtonImages read FImages write SetImages;
  end;

{ SLOW! don't use in realtime! }
procedure GrayBitmap(Bmp: TBitmap; R, G, B: Integer);
procedure DisabledBitmap(Bmp: TBitmap);
procedure MonoBitmap(Bmp: TBitmap; R, G, B: Integer);
procedure BWBitmap(Bmp: TBitmap);

function DrawDisabledText(DC: HDC; Caption: TCaption; nCount: Integer;
  var lpRect: TRect; uFormat: Integer): Integer;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$URL: https://jvcl.svn.sourceforge.net/svnroot/jvcl/branches/JVCL3_33_PREPARATION/run/JvTransparentButton.pas $';
    Revision: '$Revision: 11400 $';
    Date: '$Date: 2007-06-28 23:24:06 +0200 (jeu., 28 juin 2007) $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  JvConsts, JvJVCLUtils;

{ create a grayed version of a color bitmap }
{ SLOW! don't use in realtime! }

procedure GrayBitmap(Bmp: TBitmap; R, G, B: Integer);
var
  I, J: Integer;
  Col: Longint;
  DC: HDC;
begin
  if Bmp.Empty then
    Exit;
  DC := Bmp.Canvas.Handle;
  for I := 0 to Bmp.Width do
    for J := 0 to Bmp.Height do
    begin
      //Col := Bmp.Canvas.Pixels[I, J];
      Col := GetPixel(DC, I, J);
      Col := (GetRValue(Col) * R + GetGValue(Col) * G + GetBValue(Col) * B) div (R + G + B);
      //Bmp.Canvas.Pixels[I, J] := RGB(Col, Col, Col);
      SetPixel(DC, I, J, RGB(Col, Col, Col));
    end;
end;

{ create a grayed version of a color bitmap }
{ SLOW! don't use in realtime! }

procedure MonoBitmap(Bmp: TBitmap; R, G, B: Integer);
var
  I, J: Integer;
  Col: Longint;
  DC: HDC;
begin
  if Bmp.Empty then
    Exit;
  DC := Bmp.Canvas.Handle;
  for I := 0 to Bmp.Width do
    for J := 0 to Bmp.Height do
    begin
      //Col := Bmp.Canvas.Pixels[I, J];
      Col := GetPixel(DC, I, J);
      Col := (GetRValue(Col) * R + GetGValue(Col) * G + GetBValue(Col) * B) div (R + G + B);
      //Bmp.Canvas.Pixels[I, J] := RGB(Col, Col, Col);
      SetPixel(DC, I, J, RGB(Col, Col, Col));
    end;
end;

{ create a disabled bitmap from a regular one, works best when bitmap has been
reduced to a few colors. Used by BWBitmap }

procedure DisabledBitmap(Bmp: TBitmap);
var
  MonoBmp, TmpImage: TBitmap;
  W, H: Integer;
begin
  if Bmp.Empty then
    Exit;
  MonoBmp := TBitmap.Create;
  TmpImage := TBitmap.Create;
  W := Bmp.Width;
  H := Bmp.Height;

  with TmpImage do
  begin
    Width := W;
    Height := H;
    Canvas.Brush.Color := clBtnFace;
  end;

  try
    with MonoBmp do
    begin
      Assign(Bmp);
      Canvas.Font.Color := clWhite;
      Canvas.Brush.Color := clBlack;
      Monochrome := True;
    end;

    with TmpImage.Canvas do
    begin
      Brush.Color := clBtnFace;
      FillRect(Rect(0, 0, W, H));
      Brush.Color := clBtnHighlight;
      SetTextColor(Handle, clBlack);
      SetBkColor(Handle, clWhite);
      BitBlt(Handle, 1, 1, W + 1, H + 1, MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax);
      Brush.Color := clBtnShadow;
      SetTextColor(Handle, clBlack);
      SetBkColor(Handle, clWhite);
      BitBlt(Handle, 0, 0, W, H, MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax);
    end;
    Bmp.Assign(TmpImage);
  finally
    MonoBmp.Free;
    TmpImage.Free;
  end;
end;

{ create a disabled bitmap by changing all colors to either black or TopLeftCol and then
  running it through DisabledBitmap }
{ SLOW! don't use in realtime! }

procedure BWBitmap(Bmp: TBitmap);
var
  I, J, W, H: Integer;
  TopLeftCol: TColor;
  Col: Longint;
  DC: HDC;
begin
  if Bmp.Empty then
    Exit;

  W := Bmp.Width;
  H := Bmp.Height;
  TopLeftCol := Bmp.Canvas.Pixels[0, 0];

  DC := Bmp.Canvas.Handle;
  for I := 0 to W do
    for J := 0 to H do
    begin
      //Col := Bmp.Canvas.Pixels[I, J];
      Col := GetPixel(DC, I, J);
      if (Col <> clWhite) and (Col <> TopLeftCol) then
        Col := clBlack
      else
        Col := TopLeftCol;
      //Bmp.Canvas.Pixels[I, J] := Col;
      SetPixel(DC, I, J, Col);
    end;
  DisabledBitmap(Bmp);
end;

{ just like DrawText, but draws disabled instead }

function DrawDisabledText(DC: HDC; Caption: TCaption; nCount: Integer;
  var lpRect: TRect; uFormat: Integer): Integer;
var
  OldCol: Integer;
begin
  OldCol := SetTextColor(DC, ColorToRGB(clBtnHighlight));
  OffsetRect(lpRect, 1, 1);
  DrawText(DC, Caption, nCount, lpRect, uFormat);
  OffsetRect(lpRect, -1, -1);
  SetTextColor(DC, ColorToRGB(clBtnShadow));
  Result := DrawText(DC, Caption, nCount, lpRect, uFormat);
  SetTextColor(DC, OldCol);
end;

//=== { TJvTransparentButtonActionLink } =====================================

procedure TJvTransparentButtonActionLink.AssignClient(AClient: TObject);
begin
  inherited AssignClient(AClient);
  FClient := AClient as TJvCustomGraphicButton;
end;

function TJvTransparentButtonActionLink.IsCheckedLinked: Boolean;
begin
  if FClient is TJvTransparentButton then
    Result := inherited IsCheckedLinked and (TJvTransparentButton(FClient).Down = (Action as TCustomAction).Checked)
  else
    Result := False;
end;


{$IFDEF COMPILER6_UP}

function TJvTransparentButtonActionLink.IsGroupIndexLinked: Boolean;
begin
  Result := False;
end;

procedure TJvTransparentButtonActionLink.SetGroupIndex(Value: Integer);
begin
end;

{$ENDIF COMPILER6_UP}


procedure TJvTransparentButtonActionLink.SetChecked(Value: Boolean);
begin
  if IsCheckedLinked and (FClient is TJvTransparentButton) then
    TJvTransparentButton(FClient).Down := Value;
end;

procedure TJvTransparentButtonActionLink.SetImageIndex(Value: Integer);
begin
  // Force updating the image indexes when the action changes its own value
  if (FClient is TJvTransparentButton) then
  begin
    TJvTransparentButton(FClient).Images.ActiveIndex := Value;
    TJvTransparentButton(FClient).Images.GrayIndex := Value;
    TJvTransparentButton(FClient).Images.DisabledIndex := Value;
    TJvTransparentButton(FClient).Images.DownIndex := Value;
    TJvTransparentButton(FClient).Images.HotIndex := Value;
  end;
end;

//=== { TJvTransparentButtonImages } =========================================

constructor TJvTransparentButtonImages.Create(AButton: TJvTransparentButton);
begin
  inherited Create;
  FButton := AButton;

  FGrayLink := TChangeLink.Create;
  FGrayLink.OnChange := AButton.GlyphChanged;

  FActiveLink := TChangeLink.Create;
  FActiveLink.OnChange := AButton.GlyphChanged;

  FDisabledLink := TChangeLink.Create;
  FDisabledLink.OnChange := AButton.GlyphChanged;

  FDownLink := TChangeLink.Create;
  FDownLink.OnChange := AButton.GlyphChanged;

  FHotLink := TChangeLink.Create;
  FHotLink.OnChange := AButton.GlyphChanged;

  FActiveIndex := -1;
  FDisabledIndex := -1;
  FDownIndex := -1;
  FGrayIndex := -1;
  FHotIndex := -1;
end;

destructor TJvTransparentButtonImages.Destroy;
begin
  FGrayLink.Free;
  FActiveLink.Free;
  FDisabledLink.Free;
  FDownLink.Free;
  FHotLink.Free;
  inherited Destroy;
end;

procedure TJvTransparentButtonImages.Assign(Source: TPersistent);
var
  Src: TJvTransparentButtonImages;
begin
  if Source is TJvTransparentButtonImages then
  begin
    Src := TJvTransparentButtonImages(Source);

    ActiveImage := Src.ActiveImage;
    GrayImage := Src.GrayImage;
    DisabledImage := Src.DisabledImage;
    DownImage := Src.DownImage;
    HotImage := Src.HotImage;

    ActiveIndex := Src.ActiveIndex;
    GrayIndex := Src.GrayIndex;
    DisabledIndex := Src.DisabledIndex;
    DownIndex := Src.DownIndex;
    HotIndex := Src.HotIndex;
  end
  else
    inherited Assign(Source);
end;

procedure TJvTransparentButtonImages.AddGlyphs;
begin
  FButton.AddImageGlyphs;
end;

procedure TJvTransparentButtonImages.SetImageList(var List: TCustomImageList; Link: TChangeLink;
  Value: TCustomImageList);
begin
  if Value <> List then
  begin
    if Assigned(List) then
      List.UnRegisterChanges(Link);
    List := Value;
    if Assigned(List) then
      List.RegisterChanges(Link);
    AddGlyphs;
  end;
end;

procedure TJvTransparentButtonImages.SetGrayList(Value: TCustomImageList);
begin
  SetImageList(FGrayList, FGrayLink, Value);
end;

procedure TJvTransparentButtonImages.SetActiveList(Value: TCustomImageList);
begin
  SetImageList(FActiveList, FActiveLink, Value);
end;

procedure TJvTransparentButtonImages.SetDisabledList(Value: TCustomImageList);
begin
  SetImageList(FDisabledList, FDisabledLink, Value);
end;

procedure TJvTransparentButtonImages.SetDownList(Value: TCustomImageList);
begin
  SetImageList(FDownList, FDownLink, Value);
end;

procedure TJvTransparentButtonImages.SetHotList(Value: TCustomImageList);
begin
  SetImageList(FHotList, FHotLink, Value);
end;

procedure TJvTransparentButtonImages.SetGrayIndex(Value: TImageIndex);
begin
  if FGrayIndex <> Value then
  begin
    FGrayIndex := Value;
    AddGlyphs;
  end;
end;

procedure TJvTransparentButtonImages.SetActiveIndex(Value: TImageIndex);
begin
  if FActiveIndex <> Value then
  begin
    FActiveIndex := Value;
    AddGlyphs;
  end;
end;

procedure TJvTransparentButtonImages.SetDisabledIndex(Value: TImageIndex);
begin
  if FDisabledIndex <> Value then
  begin
    FDisabledIndex := Value;
    AddGlyphs;
  end;
end;

procedure TJvTransparentButtonImages.SetDownIndex(Value: TImageIndex);
begin
  if FDownIndex <> Value then
  begin
    FDownIndex := Value;
    AddGlyphs;
  end;
end;

procedure TJvTransparentButtonImages.SetHotIndex(Value: TImageIndex);
begin
  if FHotIndex <> Value then
  begin
    FHotIndex := Value;
    AddGlyphs;
  end;
end;

//=== { TJvTransparentButton } ===============================================

constructor TJvTransparentButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FAutoGray := True;
  FShowPressed := True;
  FBorderSize := 1;
  FTransparent := True;
  Caption := 'saidus';

  FImList := TImageList.Create(Self);
  FPressOffset := 1;
  FSpacing := 2;
  FTextAlign := ttaCenter;
  FWordWrap := False;
  FOutline := fsExplorer;

  { former TJvTransparentButton2 }
  FImages := TJvTransparentButtonImages.Create(Self);

  { former TJvTransparentButton }
  FNumGlyphs := 1;
  FGlyph := TBitmap.Create;
  FGrayGlyph := TBitmap.Create;
  FDisabledGlyph := TBitmap.Create;
  FGlyph.OnChange := GlyphChanged;
  FNumGlyphs := 1;

  // obones: removed, it goes against the default values set in the ancestor
  // and will force them to be true when loading from a DFM.
  //AllowAllUp := True;
  //Flat := True;
end;

destructor TJvTransparentButton.Destroy;
begin
  { former TJvTransparentButton }
  FGlyph.Free;
  FGrayGlyph.Free;
  FDisabledGlyph.Free;
  { former TJvTransparentButton2 }
 // FImages.Free;  // Should not be there, it is distroyed by the ansistor       -- modified by me 

//  FImList.Free; // should not be there, it is distroyed by the ansistor        -- modified by me
  inherited Destroy;
end;

procedure TJvTransparentButton.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then
  begin
    if AComponent = FImages.FGrayList then
      FImages.GrayImage := nil;
    if AComponent = FImages.FActiveList then
      FImages.ActiveImage := nil;
    if AComponent = FImages.FDisabledList then
      FImages.DisabledImage := nil;
    if AComponent = FImages.FDownList then
      FImages.DownImage := nil;
    if AComponent = FImages.FHotList then
      FImages.HotImage := nil;
  end;
end;

function TJvTransparentButton.GetActionLinkClass: TControlActionLinkClass;
begin
  Result := TJvTransparentButtonActionLink;
end;

procedure TJvTransparentButton.SetFrameStyle(Value: TJvFrameStyle);
begin
  if FOutline <> Value then
  begin
    FOutline := Value;
    Flat := FTransparent;
    Invalidate;
  end;
end;

procedure TJvTransparentButton.SetTransparent(Value: Boolean);
begin
  if FTransparent <> Value then
  begin
    FTransparent := Value;
    Flat := FTransparent;
    Invalidate;
  end;
end;

procedure TJvTransparentButton.SetBorderWidth(Value: Cardinal);
begin
  if FBorderSize <> Value then
  begin
    FBorderSize := Value;
    Invalidate;
  end;
end;

procedure TJvTransparentButton.SetWordWrap(Value: Boolean);
begin
  if FWordWrap <> Value then
  begin
    FWordWrap := Value;
    Invalidate;
  end;
end;

procedure TJvTransparentButton.SetSpacing(Value: Integer);
begin
  if FSpacing <> Value then
  begin
    FSpacing := Value;
    Invalidate;
  end;
end;

procedure TJvTransparentButton.SetAutoGray(Value: Boolean);
begin
  if FAutoGray <> Value then
  begin
    FAutoGray := Value;
    Invalidate;
  end;
end;

procedure TJvTransparentButton.SetTextAlign(Value: TJvTextAlign);
begin
  if FTextAlign <> Value then
  begin
    FTextAlign := Value;
    Invalidate;
  end;
end;

{ paint everything but bitmap and text }

procedure TJvTransparentButton.PaintFrame(Canvas: TCanvas);
var
  TmpRect: TRect;
  DrawIt: Boolean;
begin
  TmpRect := Rect(0, 0, Width, Height);
  { draw the outline }
  with Canvas do
  begin
    Brush.Color := Color;
    Pen.Color := clBlack;
    Pen.Width := BorderWidth;

    case FrameStyle of
      fsNone:
        begin
          if not Transparent then
            FillRect(Rect(0, 0, Width, Height));
          if csDesigning in ComponentState then
            Frame3D(Canvas, TmpRect, clBlack, clBlack, 1);
        end;
      fsExplorer:
        begin
          if not Transparent then
            FillRect(Rect(0, 0, Width, Height));
          Frame3D(Canvas, TmpRect, clBtnHighlight, clBtnShadow, 1);
        end;
      fsRegular:
        begin
          { draw outline }
          Pen.Color := clBlack;
          if not Transparent then
            Rectangle(1, 1, Width, Height)
          else
          begin
            TmpRect := Rect(1, 1, Width, Height);
            Frame3D(Canvas, TmpRect, clBlack, clBlack, BorderWidth);
          end;
        end;
      fsIndent:
        begin
          { draw outline }
          Pen.Color := clBtnShadow;
          if not Transparent then
            Rectangle(0, 0, Width - 1, Height - 1)
          else
          begin
            TmpRect := Rect(0, 0, Width - 1, Height - 1);
            Frame3D(Canvas, TmpRect, clBtnShadow, clBtnShadow, BorderWidth)
          end;
          TmpRect := Rect(1, 1, Width, Height);
          Frame3D(Canvas, TmpRect, clBtnHighlight, clBtnHighlight, BorderWidth);
        end;
      fsLight:
        begin
          if not Transparent then
            FillRect(Rect(0, 0, Width, Height));
          if csDesigning in ComponentState then
            Frame3D(Canvas, TmpRect, clBtnHighlight, clBtnShadow, 1);
        end;
      fsDark:
        begin
          if not Transparent then
            FillRect(Rect(0, 0, Width, Height));
          if csDesigning in ComponentState then
            Frame3D(Canvas, TmpRect, clBtnFace, cl3DDkShadow, 1);
        end;
      fsMono:
        begin
          if not Transparent then
            FillRect(Rect(0, 0, Width, Height));
          if csDesigning in ComponentState then
            Frame3D(Canvas, TmpRect, clBtnHighlight, cl3DDkShadow, 1);
        end;
    end;

    TmpRect := Rect(1, 1, Width - 1, Height - 1);

    if (bsMouseDown in MouseStates) or Down then
    begin
      if FrameStyle <> fsNone then
      begin
        InflateRect(TmpRect, 1, 1);
        case FrameStyle of
          fsRegular:
            if ShowPressed then
            begin
              Frame3D(Canvas, TmpRect, clBlack, clBtnHighlight, BorderWidth);
              Frame3D(Canvas, TmpRect, clBtnShadow, clBtnFace, BorderWidth);
            end;
          fsExplorer:
            if (bsMouseInside in MouseStates) or Down then
            begin
              if ShowPressed then
                Frame3D(Canvas, TmpRect, clBtnShadow, clBtnHighlight, BorderWidth)
              else
                Frame3D(Canvas, TmpRect, clBtnHighlight, clBtnShadow, BorderWidth);
            end;
          fsIndent:
            if ShowPressed then
            begin
              Frame3D(Canvas, TmpRect, clBlack, clBtnHighlight, BorderWidth);
              Frame3D(Canvas, TmpRect, clBtnShadow, clBtnFace, BorderWidth);
            end;
          fsLight:
            if ShowPressed then
              Frame3D(Canvas, TmpRect, clBtnShadow, clBtnHighlight, 1);
          fsDark:
            if ShowPressed then
              Frame3D(Canvas, TmpRect, cl3DDkShadow, clBtnFace, 1);
          fsMono:
            if ShowPressed then
              Frame3D(Canvas, TmpRect, cl3DDkShadow, clBtnHighlight, 1);
        end;
      end;
    end
    else
    begin
      DrawIt := ((bsMouseInside in MouseStates) and Transparent) or not Transparent or (csDesigning in ComponentState);
      InflateRect(TmpRect, 1, 1);
      case FrameStyle of
        fsNone:
          if csDesigning in ComponentState then
            Frame3D(Canvas, TmpRect, clBlack, clBlack, 1);
        fsRegular:
          if DrawIt then
          begin
            Frame3D(Canvas, TmpRect, clBtnHighlight, clBlack, BorderWidth);
            Frame3D(Canvas, TmpRect, RGB(223, 223, 223), clBtnShadow, BorderWidth);
          end;
        fsExplorer:
          if (bsMouseInside in MouseStates) or (csDesigning in ComponentState) then
            Frame3D(Canvas, TmpRect, clBtnHighlight, clBtnShadow, BorderWidth);
        fsIndent:
          if DrawIt then
          begin
            Frame3D(Canvas, TmpRect, clBtnShadow, clBtnHighlight, BorderWidth);
            Frame3D(Canvas, TmpRect, clBtnHighlight, clBtnShadow, BorderWidth);
          end;
        fsLight:
          if DrawIt then
            Frame3D(Canvas, TmpRect, clBtnHighlight, clBtnShadow, 1);
        fsDark:
          if DrawIt then
            Frame3D(Canvas, TmpRect, clBtnFace, cl3DDkShadow, 1);
        fsMono:
          if DrawIt then
            Frame3D(Canvas, TmpRect, clBtnHighlight, cl3DDkShadow, 1);
      end;
    end;

    if (HotTrackFont <> Font) and (Caption <> '') then
    begin
      InflateRect(TmpRect, 1, 1);
      DrawTheText(TmpRect, Canvas);
    end;
  end;
end;

procedure TJvTransparentButton.PaintButton(Canvas: TCanvas);
var
  Dest: TRect;
  TmpWidth: Integer;
begin
  with Canvas do
  begin
    { find glyph bounding rect - adjust according to textalignment}
    TmpWidth := FImList.Width;
    if TmpWidth <= 0 then
      TmpWidth := FImList.Width;

    { do top }
    if Self.TextAlign in [ttaBottomLeft, ttaBottom, ttaBottomRight] then
      Dest.Top := Spacing
    else
    if Self.TextAlign in [ttaTopLeft, ttaTop, ttaTopRight] then
      Dest.Top := Height - FImList.Height - Spacing
    else
      Dest.Top := (Height - FImList.Height) div 2;

    { do left }
    if Self.TextAlign = ttaLeft then
      Dest.Left := Width - TmpWidth - Spacing
    else
    if Self.TextAlign = ttaRight then
      Dest.Left := Spacing
    else { left, center, right }
      Dest.Left := (Width - TmpWidth) div 2;
    {
        if Dest.Top < Spacing then Dest.Top := Spacing;
        if Dest.Left < Spacing then Dest.Left := Spacing;
    }
    Dest.Bottom := Dest.Top + FImList.Height;
    Dest.Right := Dest.Left + TmpWidth;
    {
        if Dest.Bottom > Height - Spacing then
           Dest.Top := Height - FGlyph.Height - Spacing;
    }
    if FImList.Count > 0 then
      DrawTheBitmap(Dest, Canvas);
    { finally, do the caption }
    if Caption <> '' then
      DrawTheText(Dest, Canvas);
  end;
end;

{ ARect contains the bitmap bounds }

procedure TJvTransparentButton.DrawTheText(ARect: TRect; Canvas: TCanvas);
var
  Flags, MidX, MidY: Integer;
  DC: HDC; { Col: TColor; }
  TmpRect: TRect;
begin
  if (bsMouseInside in MouseStates) and HotTrack then
    Canvas.Font := HotTrackFont
  else
    Canvas.Font := Self.Font;
  DC := Canvas.Handle; { reduce calls to GetHandle }

  if FWordWrap then
    Flags := DT_WORDBREAK
  else
    Flags := DT_SINGLELINE;

  TmpRect := Rect(0, 0, Width, Height);

  { calculate width and height of text: }
  DrawText(DC, Caption, Length(Caption), TmpRect, Flags or DT_CALCRECT);
{
  if FWordWrap then
    Canvas.TextExtent(Caption, TmpRect, WordBreak)
  else
    Canvas.TextExtent(Caption, TmpRect, 0);
}
  MidY := TmpRect.Bottom - TmpRect.Top;
  MidX := TmpRect.Right - TmpRect.Left;
  Flags := DT_CENTER;
  { div 2 and shr 1 generates the exact same assembler code... }
  case Self.TextAlign of
    ttaTop:
      OffsetRect(TmpRect, Width div 2 - MidX div 2, ARect.Top - MidY - Spacing);
    ttaTopLeft:
      OffsetRect(TmpRect, Spacing, ARect.Top - MidY - Spacing);
    ttaTopRight:
      OffsetRect(TmpRect, Width - TmpRect.Right - Spacing, ARect.Top - MidY - Spacing);
    ttaBottom:
      OffsetRect(TmpRect, Width div 2 - MidX div 2, ARect.Bottom + Spacing);
    ttaBottomLeft:
      OffsetRect(TmpRect, Spacing, ARect.Bottom + Spacing);
    ttaBottomRight:
      OffsetRect(TmpRect, Width - MidX - Spacing, ARect.Bottom + Spacing);
    ttaCenter:
      OffsetRect(TmpRect, Width div 2 - MidX div 2, Height div 2 - MidY div 2);
    ttaRight:
      OffsetRect(TmpRect, Width - MidX - Spacing, Height div 2 - MidY div 2);
    ttaLeft:
      OffsetRect(TmpRect, Spacing, Height div 2 - MidY div 2);
  end;
  if FWordWrap then
    Flags := Flags or DT_WORDBREAK or DT_NOCLIP
  else
    Flags := Flags or DT_SINGLELINE or DT_NOCLIP;

  if ((bsMouseDown in MouseStates) or Down) and FShowPressed then
    OffsetRect(TmpRect, FPressOffset, FPressOffset);

  SetBkMode(DC, Windows.TRANSPARENT);
  if not Enabled then
    DrawDisabledText(DC, Caption, -1, TmpRect, Flags)
  else
  begin
    if (bsMouseInside in MouseStates) and HotTrack then
      SetTextColor(DC, ColorToRGB(HotTrackFont.Color))
    else
      SetTextColor(DC, ColorToRGB(Self.Font.Color));
    DrawText(DC, Caption, -1, TmpRect, Flags);
  end;
end;

procedure TJvTransparentButton.SetImages(Value: TJvTransparentButtonImages);
begin
  if Value <> FImages then
    FImages.Assign(Value);
end;

procedure TJvTransparentButton.CalcGlyphCount;
var
  GlyphNum: Integer;
begin
  if not Glyph.Empty then
  begin
    if Glyph.Width mod Glyph.Height = 0 then
    begin
      GlyphNum := Glyph.Width div Glyph.Height;
      if GlyphNum > 4 then
        GlyphNum := 1;
      SetNumGlyphs(GlyphNum);
    end;
  end;
end;

procedure TJvTransparentButton.AddGlyphGlyphs(AGlyph: TBitmap; AColor: TColor; Value: Integer);
var
  Bmp: TBitmap;
  I, TmpWidth: Integer;
  Dest, Source: TRect;
begin
  if UseImages then
    Exit;

  FImList.Clear;
  Bmp := TBitmap.Create;
  try
    if not AGlyph.Empty then
    begin
      { destroy old list }
      TmpWidth := AGlyph.Width div FNumGlyphs;
      FImList.Width := TmpWidth;
      FImList.Height := AGlyph.Height;
      Bmp.Width := FImList.Width;
      Bmp.Height := FImList.Height;
      Dest := Rect(0, 0, Bmp.Width, Bmp.Height);
      { create the imagelist }
      for I := 0 to FNumGlyphs - 1 do
      begin
        Source := Rect(I * Bmp.Width, 0, I * Bmp.Width + Bmp.Width, Bmp.Height);
        Bmp.Canvas.CopyRect(Dest, AGlyph.Canvas, Source);
        if I = 0 then { first picture }
        begin
          { create the disabled and grayed bitmaps too }
          FGrayGlyph.Assign(Bmp);
          MonoBitmap(FGrayGlyph, 11, 59, 30);
          FDisabledGlyph.Assign(Bmp);
          BWBitmap(FDisabledGlyph);
        end;
        FImList.AddMasked(Bmp, Bmp.TransparentColor);
      end;
      { add last }
      FImList.AddMasked(FGrayGlyph, FGrayGlyph.TransparentColor);
      FImList.AddMasked(FDisabledGlyph, FDisabledGlyph.TransparentColor);
    end;
  finally
    Bmp.Free;
  end;
  Invalidate;
  FGlyph.Dormant;
end;

procedure TJvTransparentButton.SetGlyph(Bmp: TBitmap);
begin
  FGlyph.Assign(Bmp);
  if UseImages then
    AddImageGlyphs;
  CalcGlyphCount;
  Invalidate;
end;

procedure TJvTransparentButton.SetNumGlyphs(Value: TNumGlyphs);
begin
  if FNumGlyphs <> Value then
  begin
    FNumGlyphs := Value;
    if not UseImages then
    begin
      GlyphChanged(Self);
      Invalidate;
    end;
  end;
end;

procedure TJvTransparentButton.DrawTheBitmap(ARect: TRect; Canvas: TCanvas);
var
  Index: TImageIndex;
  HelpRect: TRect;
  Icon: TIcon;
begin
  if FImList.Count = 0 then
    Exit;
  Index := 0;

  // Important: Draw parent image to keep transparency chain working

  // This line should be added, but currently it introduces some mess in this component.
  // Mainly, the frame around the button is not displayed.
  // That needs to be fixed before being added again.

  //CopyParentImage(Self, Canvas);


  if UseImages then
  begin
    // Images
    with FImList do
    begin
      if not Enabled then
        Index := 1 { disabled }
      else
      if ((bsMouseDown in MouseStates) and
          (KeepMouseLeavePressed or (bsMouseInside in MouseStates))) or Down then
        Index := 2 { down }
      else
      if (FrameStyle = fsExplorer) and FAutoGray and (MouseStates = []) then
        Index := 3 { autogray }
      else
      if (bsMouseInside in MouseStates) and HotTrack then
        Index := 4 { hot }
      else
        Index := 0; { normal/active }
    end;
  end
  else
  begin
    // Glyph
    case FNumGlyphs of {normal,disabled,down,down }
      2:
        if not Enabled then
          Index := 1;
      3:
        if not Enabled then
          Index := 1
        else
        if (bsMouseDown in MouseStates) or Down then
          Index := 2;
      4:
        if not Enabled then
          Index := 1
        else
        if (bsMouseDown in MouseStates) or Down then
          Index := 2;
    else
      Index := 0;
    end;

    { do we need the grayed bitmap ? }
    if (Flat or (FrameStyle = fsExplorer)) and FAutoGray and not (bsMouseInside in MouseStates) and not Down then
      Index := FImList.Count - 2;

    { do we need the disabled bitmap ? }
    if not Enabled and (FNumGlyphs = 1) then
      Index := FImList.Count - 1;
  end;

  if ((bsMouseDown in MouseStates) or Down) and FShowPressed then
    OffsetRect(ARect, FPressOffset, FPressOffset);

  // Mantis 3641: Do not draw the rectangle if we are transparent, it's of no use.
  if (bsMouseInside in MouseStates) and ((bsMouseDown in MouseStates) or Down) and
    not Transparent then
  begin
    HelpRect := ClientRect;
    InflateRect(HelpRect, -BorderWidth - 1, -BorderWidth - 1);
    Canvas.Brush.Bitmap := Pattern;
    Self.Canvas.FillRect(HelpRect);
  end;


  // Use a TIcon instead of FImList.Draw to avoid triggering Mantis 3851
  Icon := TIcon.Create;
  try
    FImList.GetIcon(Index, Icon);
    Canvas.Draw(ARect.Left, ARect.Top, Icon);
  finally
    Icon.Free;
  end;
end;

function TJvTransparentButton.GetUseImages: Boolean;
begin
  Result := not Assigned(Glyph) or Glyph.Empty;
end;

procedure TJvTransparentButton.GlyphChanged(Sender: TObject);
begin
  if UseImages then
    AddImageGlyphs
  else
    AddGlyphGlyphs(Glyph, Glyph.TransparentColor, NumGlyphs);
  Invalidate;
end;

procedure TJvTransparentButton.ActionChange(Sender: TObject; CheckDefaults: Boolean);

  {procedure CopyImage(ImageList: TCustomImageList; Index: TImageIndex);
  begin
    with Glyph do
    begin
      Width := ImageList.Width;
      Height := ImageList.Height;
      Self.Canvas.Brush.Color := clFuchsia; //! for lack of a better color
      Self.Canvas.FillRect(Rect(0,0, Width, Height));
      ImageList.Draw(Self.Canvas, 0, 0, Index);
    end;
    GlyphChanged(Glyph);
  end;}

begin
  inherited ActionChange(Sender, CheckDefaults);
  if Sender is TCustomAction then
  begin
    with TCustomAction(Sender) do
    begin
      if not CheckDefaults then
        Self.Down := Checked;
      {if UseImages then
      begin}
        // action uses ActiveImage
        Glyph.Width := 0;
        Glyph.Height := 0;

        if not CheckDefaults or (Images.ActiveIndex = -1) then
        begin
          Images.ActiveImage := ActionList.Images;
          Images.ActiveIndex := ImageIndex;
        end;
      {end
      else
      begin
        // Copy image from action's imagelist
        if (Glyph.Empty) and (ActionList <> nil) and (ActionList.Images <> nil) and
           (ImageIndex >= 0) and (ImageIndex < ActionList.Images.Count) then
          CopyImage(ActionList.Images, ImageIndex);
      end;}
    end;
  end;
end;

procedure TJvTransparentButton.AddImageGlyphs;
var
  Bmp: TBitmap; // creating a Bitmap is time consuming in Qt, so use one for all

  function AddGlyph(Images: TCustomImageList; Index: TImageIndex): Boolean;
  var
    Icon: HICON;
  begin
    Result := Assigned(Images) and (Index >= 0);
    if Result then
    begin
      Icon := ImageList_GetIcon(Images.Handle, Index, ILD_TRANSPARENT);
      ImageList_AddIcon(FImList.Handle, Icon);
      DestroyIcon(Icon);
    end;
  end;

begin
  if not UseImages then
    Exit;

  Bmp := TBitmap.Create;
  try
    { get imagelist properties (width, height, ...) }
    FImList.BkColor := clNone;
    { destroy old list }
    FImList.Clear;
    { create the imagelist }
    with Images do
    begin
      if Assigned(FActiveList) and (FActiveIndex > -1) then
      begin
        FImList.Height := FActiveList.Height;
        FImList.Width := FActiveList.Width;

        { copy some properties }
        FImList.Masked := FActiveList.Masked;
        FImList.ImageType := FActiveList.ImageType;
        FImList.DrawingStyle := FActiveList.DrawingStyle;
        FImList.BlendColor := FActiveList.BlendColor;

        AddGlyph(FActiveList, FActiveIndex);
      end
      else
        Exit; // without an active image the component cannot do anything

      Bmp.Height := FImList.Height;
      Bmp.Width := FImList.Width;

      if not AddGlyph(FDisabledList, FDisabledIndex) then
      begin
        FActiveList.GetBitmap(FActiveIndex, Bmp);
        DisabledBitmap(Bmp);
        FImList.AddMasked(Bmp, Bmp.TransparentColor);
      end;

      if not AddGlyph(FDownList, FDownIndex) then
        AddGlyph(FActiveList, FActiveIndex);

      if not AddGlyph(FGrayList, FGrayIndex) then
      begin
        FActiveList.GetBitmap(FActiveIndex, Bmp);
        GrayBitmap(Bmp, 11, 59, 30);
        FImList.AddMasked(Bmp, Bmp.TransparentColor);
      end;

      if not AddGlyph(FHotList, FHotIndex) then
        AddGlyph(FActiveList, FActiveIndex);
    end;
  finally
    Bmp.Free;
    Repaint;
  end;
end;

initialization
{$IFDEF UNITVERSIONING}
  RegisterUnitVersion(HInstance, UnitVersioning);
{$ENDIF UNITVERSIONING}

finalization
{$IFDEF UNITVERSIONING}
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.