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

  Custom Controls
  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 KsButtons;

{$I KsCommonVer.Inc}
{$T-,W-,X+,P+}

interface

uses
  Windows, SysUtils, Messages, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, StdCtrls, ExtCtrls, Buttons, ActnList, Consts, KsBitmap,
  KsControls;

type

  TKsButtonState = (kbsNormal, kbsPressed);

{ TKsCustomButton }

{ Use TKsCustomButton to put a advanced button on a form. TKsCustomButton introduces several properties to control its behavior in a dialog box setting. Users choose button controls to initiate actions. }
  TKsCustomButton = class(TKsCustomControl)
  private
    FActiveDefault: boolean;
    FDefault: boolean;
    FDragging: Boolean;
    FGlyph: TBitmap;
    FLayout: TButtonLayout;
    FKind: TBitBtnKind;
    FNumGlyphs: TNumGlyphs;
    FModifiedGlyph: boolean;
    FSpacing: Integer;
    FState: TKsButtonState;
    FModalResult: TModalResult;
    FBlackAndWhiteGlyph: boolean;
    { Properties }
    procedure SetDefault(const Value: boolean);
    procedure SetGlyph(const Value: TBitmap);
    procedure SetKind(const Value: TBitBtnKind);
    procedure SetLayout(const Value: TButtonLayout);
    procedure SetNumGlyphs(const Value: TNumGlyphs);
    procedure SetSpacing(const Value: Integer);
    procedure SetBlackAndWhiteGlyph(const Value: boolean);
    { Internal Event Handlers }
    procedure GlyphChangedHandler(Sender: TObject);
  protected
    { Message Handling }
    procedure CMEnabledChanged(var Msg: TMessage); message CM_ENABLEDCHANGED;
    procedure CMDialogKey( var Msg: TCMDialogKey ); message CM_DIALOGKEY;
    procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
    procedure CMFocusChanged(var Msg: TCMFocusChanged); message CM_FOCUSCHANGED;
    procedure CMTextChanged(var Msg: TMessage); message CM_TEXTCHANGED;
    { VCL Inherited }
    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
    { Inherited }
    procedure PaintBuffer; override;
    { Button }
    function GetLayoutRect: TRect; virtual;
    function GetCaptionRect: TRect; virtual;
    function GetGlyphRect: TRect; virtual;
    function GetGlyphSize: TPoint;
    procedure PaintFace; virtual;
    procedure PaintGlyph; virtual;
    procedure PaintText; virtual;
    { Mouse Handlers }
    procedure MouseEnter; override;
    procedure MouseLeave; override;
    procedure HasFocus; override;
    procedure KillFocus; override;
    { VCL }
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    { Protected Property }
    property ActiveDefault: boolean read FActiveDefault;
    property State: TKsButtonState read FState write FState;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;
    { Event Dispatch Methods }
    procedure Click; override;
  published
    property Action;
    property Anchors;
    { Use BlackAndWhiteGlyph property to set IE button behaviour. }
    property BlackAndWhiteGlyph: boolean read FBlackAndWhiteGlyph write SetBlackAndWhiteGlyph;
    property Caption;
    property Default: boolean read FDefault write SetDefault;
    property Enabled;
    property Font;
    property Glyph: TBitmap read FGlyph write SetGlyph;
    property Kind: TBitBtnKind read FKind write SetKind default bkCustom;
    property Layout: TButtonLayout read FLayout write SetLayout default blGlyphLeft;
    property ModalResult: TModalResult read FModalResult write FModalResult default mrNone;
    property NumGlyphs: TNumGlyphs read FNumGlyphs write SetNumGlyphs default 1;
    property Spacing: Integer read FSpacing write SetSpacing default 4;
    property TabOrder;
    property TabStop default true;
    property Transparent;
    property OnClick;
  end;

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

uses ImgList, KsUtils;

{$R *.res}

const
  BitBtnResNames: array[TBitBtnKind] of PChar = (
    nil, 'KSBTN_OK', 'KSBTN_CANCEL', 'KSBTN_HELP', 'KSBTN_YES',
    'KSBTN_NO', 'KSBTN_CLOSE', 'KSBTN_ABORT', 'KSBTN_RETRY',
    'KSBTN_IGNORE', 'KSBTN_ALL');

  BitBtnModalResults: array[TBitBtnKind] of TModalResult = (
    0, mrOk, mrCancel, 0, mrYes, mrNo, 0, mrAbort, mrRetry, mrIgnore, mrAll);

  BitBtnCaptions: array[TBitBtnKind] of string = (
    '', SOKButton, SCancelButton, SHelpButton, SYesButton, SNoButton,
    SCloseButton, SAbortButton, SRetryButton, SIgnoreButton, SAllButton);
    
var
  BitBtnGlyphs: array[TBitBtnKind] of TBitmap;


function GetBitBtnGlyph(Kind: TBitBtnKind): TBitmap;
begin
  if BitBtnGlyphs[Kind] = nil then
  begin
    BitBtnGlyphs[Kind] := TBitmap.Create;
    BitBtnGlyphs[Kind].Handle := LoadBitmap(HInstance, BitBtnResNames[Kind]);
  end;
  Result := BitBtnGlyphs[Kind];
end;

procedure FreeBitmaps;
var
  I: TBitBtnKind;
begin
  for I := Low(TBitBtnKind) to High(TBitBtnKind) do
    BitBtnGlyphs[I].Free;
end;

{ TKsCustomButton Methods =====================================================}

constructor TKsCustomButton.Create( AOwner: TComponent );
begin
  inherited Create(AOwner);
  ControlStyle := [csCaptureMouse, csSetCaption, csDoubleClicks];

  TabStop := true;

  FGlyph := TBitmap.Create;
  FGlyph.OnChange := GlyphChangedHandler;

  FNumGlyphs := 1;
  FKind := bkCustom;
  FLayout := blGlyphLeft;
  FSpacing := 4;

  Color := KColorToColor(ckBtnFace);
  Transparent := true;

  SetBounds(0, 0, 75, 25);
end;

destructor TKsCustomButton.Destroy;
begin
  FGlyph.Free;
  inherited Destroy;
end;

procedure TKsCustomButton.Loaded;
begin
  inherited Loaded;
  Invalidate;
end;

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

  procedure CopyImage(ImageList: TCustomImageList; Index: Integer);
  begin
    with Glyph do
    begin
      Width := ImageList.Width;
      Height := ImageList.Height;
      Canvas.Brush.Color := clFuchsia;
      Canvas.FillRect(Rect(0,0, Width, Height));
      ImageList.Draw(Canvas, 0, 0, Index);
    end;
  end;

begin
  inherited ActionChange(Sender, CheckDefaults);
  
  if Sender is TCustomAction then
  begin
    with TCustomAction(Sender) do
    begin
      { Copy image from action's imagelist }
      if (ActionList <> nil) and
         (ActionList.Images <> nil) and
         (ImageIndex >= 0) and
         (ImageIndex < ActionList.Images.Count) then
      begin
        CopyImage(ActionList.Images, ImageIndex);
      end;
      Self.Caption := Caption;
      Self.OnClick := OnExecute;
    end;
  end;
end;

procedure TKsCustomButton.GlyphChangedHandler(Sender: TObject);
var
  N: integer;
begin
  if (FGlyph.Height <> 0) and (FGlyph.Width mod FGlyph.Height = 0) then
  begin
    N := FGlyph.Width div FGlyph.Height;
    if N > 4 then
      N := 1;
    SetNumGlyphs(N);
  end;
  Invalidate;
end;

procedure TKsCustomButton.Click;
var
  Form: TCustomForm;
begin
  Form := GetParentForm(Self);
  if Form <> nil then
    Form.ModalResult := ModalResult;

  inherited Click;
{  if Assigned(FOnClick) then
    FOnClick(Self);}
end;

{ Button }

function TKsCustomButton.GetLayoutRect: TRect;
var
  B: TBitmap;
begin
  { Calc Rect }
  B := TBitmap.Create;
  try
    B.Canvas.Font.Assign(ControlFont);

    Result := Rect(0, 0, B.Canvas.TextWidth(Caption), B.Canvas.TextHeight(Caption));
    if (FGlyph <> nil) and not (FGlyph.Empty) then
    begin
      if FLayout in [blGlyphLeft, blGlyphRight] then
        Inc(Result.Right, FSpacing + GetGlyphSize.X)
      else
        Inc(Result.Bottom, FSpacing + GetGlyphSize.Y);

      If Result.Right < GetGlyphSize.X then
        Result.Right := GetGlyphSize.X;
      If Result.Bottom < GetGlyphSize.Y then
        Result.Bottom := GetGlyphSize.Y;
    end;

    { Centered }
    OffsetRect(Result, (FWidth - Result.Right) div 2, (FHeight - Result.Bottom) div 2);

    if FState = kbsPressed then
      OffsetRect(Result, 1, 1);
  finally
    B.Free;
  end;
end;

function TKsCustomButton.GetCaptionRect: TRect;
var
  GlyphSize: TPoint;
begin
  Result := GetLayoutRect;

  if FGlyph = nil then Exit;
  if FGlyph.Empty then
    Exit;

  GlyphSize := GetGlyphSize;
  case FLayout of
    blGlyphLeft: Inc(Result.Left, GlyphSize.X + FSpacing);
    blGlyphRight: Dec(Result.Right, GlyphSize.X + FSpacing);
    blGlyphTop: Inc(Result.Top, GlyphSize.Y + FSpacing);
    blGlyphBottom: Dec(Result.Bottom, GlyphSize.Y + FSpacing);
  end;
end;

function TKsCustomButton.GetGlyphSize: TPoint;
begin
  if FGlyph <> nil then
    Result := Point(FGlyph.Width div FNumGlyphs, FGlyph.Height)
  else
    Result := Point(0, 0);
end;

function TKsCustomButton.GetGlyphRect: TRect;
var
  GlyphSize: TPoint;
begin
  Result := GetLayoutRect;

  if FGlyph = nil then Exit;
  if FGlyph.Empty then
    Exit;

  GlyphSize := GetGlyphSize;
  case FLayout of
    blGlyphLeft: Result.Right := Result.Left + GlyphSize.X + FSpacing;
    blGlyphRight: Result.Left := Result.Right - GlyphSize.X - FSpacing;
    blGlyphTop: Result.Bottom := Result.Top + GlyphSize.Y + FSpacing;
    blGlyphBottom: Result.Top := Result.Bottom - GlyphSize.Y - FSpacing;
  end;
end;

{ Painting }

procedure TKsCustomButton.PaintFace;
var
  R: TRect;
  BackColor: TKColor;
begin
  with Buffer do
  begin
    R := Rect(0, 0, FWidth, FHeight);

    { Focused }
    if Focused or FActiveDefault then
    begin
      DrawEdge(R, ckBlack, ckBlack);
      InflateRect(R, -1, -1);
    end;
    BackColor := KColor(Color);
    { Draw State }
    case FState of
      kbsNormal: begin
        FillRect(R, BackColor);
        DrawEdge(R, KColor(clBtnHighlight), ckBlack);
        InflateRect(R, -1, -1);
        DrawEdge(R, KColor(Color), KColor(clBtnShadow));
      end;
      kbsPressed: begin
        FillRect(R, BackColor);
        DrawEdge(R, KColor(clBtnShadow), KColor(clBtnShadow));
      end;
    end;

    { Draw Focus Rect }
    if Focused then
    begin
      R := Rect(0, 0, FWidth, FHeight);
      InflateRect(R, -4, -4);
      DrawFocusRect(R, KColor(clBtnShadow));
    end;
  end
end;

procedure TKsCustomButton.PaintGlyph;
var
  R: TRect;
  SrcRect: TRect;
  i, j, W, H: Integer;
  NewColor, TransparentColor: TColor;
  cH, cS, cL: single;
begin
  if FGlyph = nil then Exit;
  if FGlyph.Empty then Exit;

  with Buffer do
  begin
    R := Rect(0, 0, GetGlyphSize.X, GetGlyphSize.Y);
    OffsetRect(R, (RectWidth(GetGlyphRect) - R.Right) div 2, (RectHeight(GetGlyphRect) - R.Bottom) div 2);
    OffsetRect(R, GetGlyphRect.Left, GetGlyphRect.Top);

    W := FGlyph.Width div FNumGlyphs;
    H := FGlyph.Height;

    if (FNumGlyphs > 1) and not Enabled then
      SrcRect := Rect(W, 0, W + W, H)
    else
      SrcRect := Rect(0, 0, W, H);

    TransparentColor := FGlyph.Canvas.Pixels[0, H - 1];

    { Copy to Buffer }
    for i := 0 to W-1 do
      for j := 0 to H-1 do
      begin
        NewColor := FGlyph.Canvas.Pixels[SrcRect.Left + i, SrcRect.Top + j];
        if (FBlackAndWhiteGlyph) and (not MouseInControl) and (NewColor <> TransparentColor) then
        begin
          RGBtoHSL(KColor(NewColor), cH, cS, cL);
          NewColor := RGB(Round(cL * $FF), Round(cL * $FF), Round(cL * $FF));
        end;
        if (not Enabled) and (NewColor <> TransparentColor) then
        begin
          RGBtoHSL(KColor(NewColor), cH, cS, cL);
          NewColor := RGB(160+Round(cL * 50), 160+Round(cL * 50), 160+Round(cL * 50));
        end;
        if NewColor <> TransparentColor then
          Pixels[R.Left + i, R.Top + j] := KColor(NewColor);
      end;
  end;
end;

procedure TKsCustomButton.PaintText;
var
  R: TRect;
begin
  with Buffer do
  begin
    Font.Assign(ControlFont);

    R := Rect(0, 0, TextWidth(Caption), TextHeight(Caption));
    OffsetRect(R, (RectWidth(GetCaptionRect) - R.Right) div 2, (RectHeight(GetCaptionRect) - R.Bottom) div 2);
    OffsetRect(R, GetCaptionRect.Left, GetCaptionRect.Top);

    if not Enabled then
    begin
      Font.Color := clBtnHighlight;
      OffsetRect(R, 1, 1);
      DrawText(Caption, R, DT_CENTER or DrawTextBiDiModeFlags(0));
      OffsetRect(R, -1, -1);
      Font.Color := clBtnShadow;
    end;

    { Draw Text }
    DrawText(Caption, R, DT_CENTER or DrawTextBiDiModeFlags(0));
  end;
end;

{ Drawing }

procedure TKsCustomButton.PaintBuffer;
begin
  inherited ;
  PaintFace;
  PaintText;
  PaintGlyph;
end;

{ Mouse }

procedure TKsCustomButton.KeyDown(var Key: Word; Shift: TShiftState);
begin
  if (Key = vk_Space) and not (ssAlt in Shift) then
  begin
    FState := kbsPressed;
    Invalidate;
  end;
  inherited KeyDown(Key, Shift);
end;

procedure TKsCustomButton.KeyUp(var Key: Word; Shift: TShiftState);
begin
  if Key = vk_Space then
  begin
    FState := kbsNormal;
    Invalidate;
    Click;
    Key := 0;
  end;
  inherited KeyUp(Key, Shift);
end;

procedure TKsCustomButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited MouseDown(Button, Shift, X, Y);

  if (Button = mbLeft) and Enabled then
  begin
    SetFocus;
    FState := kbsPressed;
    Invalidate;
    FDragging := True;
  end;
end;

procedure TKsCustomButton.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  NewState: TKsButtonState;
begin
  inherited MouseMove(Shift, X, Y);

  if FDragging then
  begin
    if (X >= 0) and (X < ClientWidth) and (Y >= 0) and (Y <= ClientHeight) then
      NewState := kbsPressed
    else
      NewState := kbsNormal;

    if NewState <> FState then
    begin
      FState := NewState;
      Invalidate;
    end;
  end;
end;

procedure TKsCustomButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited MouseUp(Button, Shift, X, Y);

  if FDragging then
  begin
    FDragging := false;
    FState := kbsNormal;
    if PtInRect(Rect(0, 0, FWidth, FHeight), Point(X, Y)) then
      Click;
    Invalidate;
  end;
end;

procedure TKsCustomButton.MouseEnter;
begin
  inherited;
  Invalidate;
end;

procedure TKsCustomButton.MouseLeave;
begin
  inherited;
  Invalidate;
end;

procedure TKsCustomButton.KillFocus;
begin
  inherited;
end;

procedure TKsCustomButton.HasFocus;
begin
  inherited;
end;

{ VCL Messages }

procedure TKsCustomButton.CMFocusChanged( var Msg: TCMFocusChanged );
begin
  with Msg do
  begin
    if (Sender is TKsCustomButton) or (Sender is TButton) then
    begin
      if FActiveDefault then
      begin
        FActiveDefault := false;
        Invalidate;
      end;
    end
    else
    begin
      if FActiveDefault <> FDefault then
      begin
        FActiveDefault := FDefault;
        Invalidate;
      end;
    end
  end;

  inherited ;
end;

procedure TKsCustomButton.CMEnabledChanged(var Msg: TMessage);
begin
  if HandleAllocated and not (csDesigning in ComponentState) then
    EnableWindow(Handle, Enabled);
  Invalidate;
end;

procedure TKsCustomButton.CMDialogKey(var Msg: TCMDialogKey);
begin
  with Msg do
  begin
    if ( ((CharCode = vk_Return) and FActiveDefault) or
         ((CharCode = vk_Return) and Focused) or
         ((CharCode = vk_Escape) and (ModalResult = mrCancel)) ) and
       (KeyDataToShiftState(KeyData) = []) and CanFocus then
    begin
      Click;
      Result := 1;
    end
    else
      inherited;
  end;
end;

procedure TKsCustomButton.CMDialogChar(var Message: TCMDialogChar);
begin
  with Message do
    if IsAccel(CharCode, Caption) and CanFocus then
    begin
      SetFocus;
      Click;
      Result := 1;
    end
    else
      inherited;
end;

procedure TKsCustomButton.CMTextChanged(var Msg: TMessage);
begin
  inherited;
  Invalidate;
end;

{ Preperties }

procedure TKsCustomButton.SetDefault(const Value: boolean);
var
  Form: TCustomForm;
begin
  FDefault := Value;
  if HandleAllocated then
  begin
    Form := GetParentForm(Self);
    if Form <> nil then
      Form.Perform(CM_FOCUSCHANGED, 0, Longint(Form.ActiveControl));
  end;
  Invalidate;
end;

procedure TKsCustomButton.SetGlyph(const Value: TBitmap);
begin
  FGlyph.Assign(Value);
end;

procedure TKsCustomButton.SetKind(const Value: TBitBtnKind);
begin
  if Value <> FKind then
  begin
    if Value <> bkCustom then
    begin
      Default := Value in [bkOK, bkYes];

      if ((csLoading in ComponentState) and (Caption = '')) or
         (not (csLoading in ComponentState)) then
      begin
        if BitBtnCaptions[Value] <> '' then
          Caption := BitBtnCaptions[Value];
      end;

      ModalResult := BitBtnModalResults[Value];
      FGlyph.Assign(GetBitBtnGlyph(Value));
      NumGlyphs := 2;
      FModifiedGlyph := false;
    end;
    FKind := Value;
    Invalidate;
  end;
end;

procedure TKsCustomButton.SetLayout(const Value: TButtonLayout);
begin
  if FLayout <> Value then
  begin
    FLayout := Value;
    Invalidate;
  end;
end;

procedure TKsCustomButton.SetNumGlyphs(const Value: TNumGlyphs);
begin
  if FNumGlyphs <> Value then
  begin
    FNumGlyphs := Value;
    Invalidate;
  end;
end;

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

procedure TKsCustomButton.SetBlackAndWhiteGlyph(const Value: boolean);
begin
  if FBlackAndWhiteGlyph <> Value then
  begin
    FBlackAndWhiteGlyph := Value;
    Invalidate;
  end;
end;

initialization
  FillChar(BitBtnGlyphs, SizeOf(BitBtnGlyphs), 0);
finalization
  FreeBitmaps;
end.

