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

  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 KsCheckBoxs;

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

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Dialogs,
  StdCtrls, Forms, KsUtils, KsBitmap, KsControls;

type

{ TKsCustomCheckBox }

{ A TKsCustomCheckBox component presents an option for the user. The user can check the box to select the option, or uncheck it to deselect the option. }
  TKsCustomCheckBox = class(TKsCustomControl)
  private
    FState: TCheckBoxState;
    FSpacing: integer;
    FPressed: boolean;
    FAlignment: TLeftRight;
    { Properties }
    function GetChecked: boolean;
    procedure SetState(Value: TCheckBoxState);
    procedure SetChecked(Value: boolean);
    procedure SetSpacing(const Value: integer);
    procedure SetPressed(const Value: boolean);
    Procedure SetAlignment(Value: TLeftRight);
  protected
    { Messages }
    procedure CMEnabledChanged(var Msg: TMessage); message CM_ENABLEDCHANGED;
    procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure WMSysColorChange(var Msg: TMessage); message WM_SYSCOLORCHANGE;
    { Inherited }
    procedure PaintBuffer; override;
    { CheckBox }
    procedure DoClick; virtual;
    procedure Toggle; virtual;
    function GetBoxSize: TPoint; virtual;
    procedure PaintBox; virtual;
    procedure PaintText; virtual;
    { Event }
    procedure MouseEnter; override;
    procedure MouseLeave; override;
    { VCL }
    procedure Click; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState;X, Y: Integer);
      override;
    procedure KeyDown(var Key:Word;Shift:TShiftSTate); override;
    procedure KeyUp(var Key:Word;Shift:TShiftSTate); override;
    property Pressed: boolean read FPressed write SetPressed;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;
    { Properties }
  published
    property Anchors;
    property Caption;
    property Alignment: TLeftRight read FAlignment write SetAlignment;
    { Use Checked to determine whether the check box is checked or unchecked. Checked is True when the check box has a checked state, False if it is unchecked or grayed. }
    property Checked: boolean read GetChecked write SetChecked;
    property Enabled;
    property Spacing: integer read FSpacing write SetSpacing;
    { Indicates whether the check box is selected, deselected, or grayed. }
    property State: TCheckBoxState read FState write SetState;
    property TabOrder;
    property TabStop;
    property Transparent;
    property OnClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
  end;

{ TKsCustomRadioButton }

{ Use TKsCustomRadioButton to add a radio button to a form. Radio buttons present a set of mutually exclusive options to the user-that is, only one radio button in a set can be selected at a time. }
  TKsCustomRadioButton = class(TKsCustomControl)
  private
    FChecked: boolean;
    FGroupIndex: byte;
    FSpacing: integer;
    FPressed: boolean;
    FItemTabStop: Boolean;
    { Messages }
    procedure CMEnabledChanged(var Msg: TMessage); message CM_ENABLEDCHANGED;
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
    procedure WMSysColorChange(var Msg: TMessage);
    { Properties }
    procedure SetChecked(Value:Boolean);
    procedure SetSpacing(const Value: integer);
    procedure SetPressed(const Value: boolean);
  protected
    {}
    procedure TurnSiblingsOff;
    { Inherited }
    procedure PaintBuffer; override;
    { RadioButton }
    function GetBoxSize: TPoint; virtual;
    procedure PaintBox; virtual;
    procedure PaintText; virtual;
    { Event }
    procedure MouseEnter; override;
    procedure MouseLeave; override;
    procedure HasFocus; override;
    { VCL }
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState;X, Y: Integer); override;
    procedure KeyDown(var Key:Word;Shift:TShiftSTate); override;
    procedure KeyUp(var Key:Word;Shift:TShiftSTate); override;
    property Pressed: boolean read FPressed write SetPressed;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;
    { Properties }
  published
    property Anchors;
    property Caption;
    { Use Checked to determine whether the radio button is checked or unchecked. Checked is True when the radio button has a checked state, False if it is unchecked. }
    property Checked: boolean read FChecked write SetChecked;
    property GroupIndex: byte read FGroupIndex write FGroupIndex;
    property Enabled;
    property Spacing: integer read FSpacing write SetSpacing;
    property TabOrder;
    property TabStop;
    Property ItemTabStop: Boolean Read FItemTabStop Write FItemTabStop Default True;
    property Transparent;
    property OnClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
  end;

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

{ TKsCustomCheckBox ===========================================================}

constructor TKsCustomCheckBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FSpacing := 5;

  Width := 98;
  Height := 20;
  TabStop := true;
  Transparent := true;
  Caption := 'CheckBox';
end;

destructor TKsCustomCheckBox.Destroy;
begin
  inherited Destroy;
end;

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

{ CheckBox }

procedure TKsCustomCheckBox.Toggle;
begin
  case State of
    cbUnchecked, cbGrayed: State := cbChecked;
    cbChecked: State := cbUnchecked;
  end;
end;

function TKsCustomCheckBox.GetBoxSize: TPoint;
begin
  Result := Point(13, 13);
end;

procedure TKsCustomCheckBox.PaintBox;
var
  R: TRect;
  BackColor, CheckColor, RColor, SColor: TKColor;
  B: TKsBitmap;
  i, j: integer;
begin
  { Draw Box }
  with Buffer do
  begin
    R := Rect(0, 0, GetBoxSize.X, GetBoxSize.Y);
    if Alignment = taLeftJustify then
      RectVCenter(R, Rect(0, 0, FWidth, FHeight))
    else
      RectVCenter(R, Rect(FWidth-GetBoxSize.X, 0, FWidth, FHeight));

    { Draw standard box }
    case State of
      cbUnChecked: begin
        if not Enabled then
          DrawFrameControl(DC, R, DFC_BUTTON, DFCS_BUTTONCHECK or DFCS_INACTIVE)
        else
          DrawFrameControl(DC, R, DFC_BUTTON, DFCS_BUTTONCHECK);
      end;
      cbChecked: begin
        if not Enabled then
          DrawFrameControl(DC, R, DFC_BUTTON, DFCS_BUTTONCHECK or DFCS_CHECKED or DFCS_INACTIVE)
        else
          DrawFrameControl(DC, R, DFC_BUTTON, DFCS_BUTTONCHECK or DFCS_CHECKED)
      end;
      cbGrayed: begin
        if not Enabled then
          DrawFrameControl(DC, R, DFC_BUTTON, DFCS_BUTTON3STATE or DFCS_CHECKED or DFCS_INACTIVE)
        else
          DrawFrameControl(DC, R, DFC_BUTTON, DFCS_BUTTON3STATE or DFCS_CHECKED)
      end;
    end;
  end
end;

procedure TKsCustomCheckBox.PaintText;
var
  R: TRect;
begin
  { Draw Text }
  with Buffer do
  begin
    Font.Assign(ControlFont);

    { Calc Rect }
    R := Rect(0, 0, TextWidth(Caption), TextHeight(Caption));
    if Alignment = taLeftJustify then
      RectVCenter(R, Rect(GetBoxSize.X + FSpacing, 0, FWidth, FHeight))
    else
      RectVCenter(R, Rect(2, 0, FWidth-GetBoxSize.X + FSpacing, FHeight));

    { Draw Text }
    if not Enabled then
    begin
      Font.Color := clBtnHighlight;
      OffsetRect(R, 1, 1);
      DrawText(Caption, R, DrawTextBiDiModeFlags(DT_LEFT));
      OffsetRect(R, -1, -1);

      Font.Color := clBtnShadow;
    end;
    DrawText(Caption, R, DrawTextBiDiModeFlags(DT_LEFT));

    { Draw Focus }
    if Focused then
    begin
      InflateRect(R, 1, 2);
      Inc(R.Right, 2);
      DrawFocusRect(R, KColor(clBtnShadow));
    end;
  end;
end;

{ Painting }

procedure TKsCustomCheckBox.PaintBuffer;
begin
  inherited ;
  PaintBox;
  PaintText;
end;

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

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

procedure TKsCustomCheckBox.DoClick;
begin
  if csLoading in ComponentState then Exit;

  if Assigned(OnClick) then
    OnClick(Self);
end;

{ VCL Inherited }

procedure TKsCustomCheckBox.Click;
begin
  DoClick;
end;

procedure TKsCustomCheckBox.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited MouseDown(Button, Shift, X, Y);
  if Button = mbLeft then
  begin
    SetFocus;
    MouseCapture := true;

    FPressed := true;
    Invalidate;
  end;
end;

procedure TKsCustomCheckBox.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  FPressed := false;
  Invalidate;
  MouseCapture := false;
  if (X >= 0) and (X <= FWidth) and (Y >= 0) and (Y <= FHeight) then
  begin
    Checked := not Checked;
  end;
  
  inherited MouseUp(Button, Shift, X, Y);
end;

procedure TKsCustomCheckBox.MouseMove(Shift: TShiftState;X, Y: Integer);
begin
  inherited MouseMove(Shift,X,Y);
end;

procedure TKsCustomCheckBox.KeyDown(var Key:Word;Shift:TShiftSTate);
begin
  inherited KeyDown(Key, Shift);
  if Key = vk_Space then
  begin
    FPressed := true;
    Invalidate;
  end;
end;

procedure TKsCustomCheckBox.KeyUp(var Key:Word;Shift:TShiftSTate);
begin
  if Key = vk_Space then
  begin
    Checked := not Checked;
    FPressed := false;
    Invalidate;
  end;
end;

{ Messages }

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

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

procedure TKsCustomCheckBox.WMSysColorChange(var Msg: TMessage);
begin
  Invalidate;
end;

procedure TKsCustomCheckBox.CMTextChanged(var Message: TMessage);
begin
  Invalidate;
end;

{ Properties }

procedure TKsCustomCheckBox.SetState(Value: TCheckBoxState);
begin
  if FState <> Value then
  begin
    FState := Value;
    Click;

    Invalidate;
  end;
end;

function TKsCustomCheckBox.GetChecked: Boolean;
begin
  Result := State = cbChecked;
end;

procedure TKsCustomCheckBox.SetChecked(Value:Boolean);
begin
  if Value then
    State := cbChecked
  else
    State := cbUnchecked;
end;

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

procedure TKsCustomCheckBox.SetPressed(const Value: boolean);
begin
  FPressed := Value;
end;

procedure TKsCustomCheckBox.SetAlignment(Value: TLeftRight);
begin
  if FAlignment <> Value then
  begin
    FAlignment := Value;
    Invalidate;
  end;
end;

{ TKsCustomRadioButton ========================================================}

constructor TKsCustomRadioButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FSpacing := 5;
  FItemTabStop := True;
  Width := 98;
  Height := 20;
  TabStop := false;
  Transparent := true;
  Caption := 'RadioButton';
end;

destructor TKsCustomRadioButton.Destroy;
begin
  inherited Destroy;
end;

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

procedure TKsCustomRadioButton.TurnSiblingsOff;
var
  i: integer;
  Sibling: TKsCustomRadioButton;
begin
  if Parent <> nil then
  for i := 0 to Parent.ControlCount-1 do
    if Parent.Controls[i] is TKsCustomRadioButton then
    begin
      Sibling := TKsCustomRadioButton(Parent.Controls[i]);
      if (Sibling <> Self) and
         (Sibling.GroupIndex=GroupIndex) then
        Sibling.SetChecked(False);
    end;
end;

function TKsCustomRadioButton.GetBoxSize: TPoint;
begin
  Result := Point(13, 13);
end;

procedure TKsCustomRadioButton.PaintBox;
var
  R: TRect;
  BackColor, CheckColor, SColor: TKColor;
  B: TKsBitmap;
  i, j: integer;
begin
  { Draw Box }
  with Buffer do
  begin
    R := Rect(0, 0, GetBoxSize.X, GetBoxSize.Y);
    RectVCenter(R, Rect(0, 0, FWidth, FHeight));

    { Draw standard box }
    if not Checked then
    begin
      if not Enabled then
        DrawFrameControl(DC, R, DFC_BUTTON, DFCS_BUTTONRADIO or DFCS_INACTIVE)
      else
        DrawFrameControl(DC, R, DFC_BUTTON, DFCS_BUTTONRADIO);
    end
    else
    begin
      if not Enabled then
        DrawFrameControl(DC, R, DFC_BUTTON, DFCS_BUTTONRADIO or DFCS_CHECKED or DFCS_INACTIVE)
      else
        DrawFrameControl(DC, R, DFC_BUTTON, DFCS_BUTTONRADIO or DFCS_CHECKED);
    end;
  end;
end;

procedure TKsCustomRadioButton.PaintText;
var
  R: TRect;
begin
  { Draw Text }
  with Buffer do
  begin
    Font.Assign(ControlFont);

    { Calc Rect }
    R := Rect(0, 0, TextWidth(Caption), TextHeight(Caption));
    RectVCenter(R, Rect(GetBoxSize.X + FSpacing, 0, FWidth, FHeight));

    { Draw Text }
    if not Enabled then
    begin
      Font.Color := clBtnHighlight;
      OffsetRect(R, 1, 1);
      DrawText(Caption, R, DrawTextBiDiModeFlags(DT_LEFT));
      OffsetRect(R, -1, -1);

      Font.Color := clBtnShadow;
    end;
    DrawText(Caption, R, DrawTextBiDiModeFlags(DT_LEFT));

    { Draw Focus }
    if Focused then
    begin
      InflateRect(R, 1, 2);
      Inc(R.Right, 2);
      DrawFocusRect(R, KColor(clBtnShadow));
    end;
  end;
end;

{ Painting }

procedure TKsCustomRadioButton.PaintBuffer;
begin
  inherited ;
  PaintBox;
  PaintText;
end;

{ Events }

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

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

procedure TKsCustomRadioButton.HasFocus;
begin
  inherited;
  Checked := true;
end;

{ Events }

procedure TKsCustomRadioButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited MouseDown(Button, Shift, X, Y);
  if Button = mbLeft then
  begin
    SetFocus;
    MouseCapture := true;
    FPressed := true;
    Invalidate;
  end;
end;

procedure TKsCustomRadioButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  FPressed := false;
  Invalidate;
  MouseCapture := false;
  if (X >= 0) and (X <= Width) and (Y >= 0) and (Y <= Height) and not Checked then
    Checked := True;
  inherited MouseUp(Button, Shift, X, Y);
end;

procedure TKsCustomRadioButton.MouseMove(Shift: TShiftState;X, Y: Integer);
begin
  inherited MouseMove(Shift,X,Y);
end;

procedure TKsCustomRadioButton.KeyDown(var Key:Word;Shift:TShiftSTate);
begin
  inherited KeyDown(Key, Shift);
  if Key = vk_Space then
  begin
    FPressed := true;
    Invalidate;
  end;
end;

procedure TKsCustomRadioButton.KeyUp(var Key:Word;Shift:TShiftSTate);
begin
  if Key = vk_Space then
  begin
    if not Checked then Checked := true;
    FPressed := false;
    Invalidate;
  end;
end;

{ Messages }

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

procedure TKsCustomRadioButton.WMSysColorChange(var Msg: TMessage);
begin
  Invalidate;
end;

procedure TKsCustomRadioButton.CMTextChanged(var Message: TMessage);
begin
  Invalidate;
end;

{ Properties }

procedure TKsCustomRadioButton.SetChecked(Value: Boolean);
begin
  if FChecked <> Value then
  begin
    TabStop := Value And ItemTabStop;
    FChecked := Value;
    if Value then
    begin
      TurnSiblingsOff;
      if not (csLoading in ComponentState) then
        Click;
    end;
    Invalidate;
  end;
end;

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

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

procedure TKsCustomRadioButton.SetPressed(const Value: boolean);
begin
  FPressed := Value;
end;

end.
