
{*******************************************************}
{                                                       }
{       ScaleRichView                                   }
{       The given component represents TCheckBox for    }
{       work with ScaleRichView.                        }
{                                                       }
{       Copyright (c) Ilya Zelenskiy                    }
{       Ilya.Zelenskiy@gmail.com                        }
{       http://www.trichview.com                        }
{                                                       }
{*******************************************************}

unit SRVCheckBox;

interface
{$I RV_Defs.inc}
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  SRVControl;

type
  TSRVCheckBoxState = (cbUnchecked, cbChecked, cbGrayed);

  TSRVCheckBox = class(TSRVCustomControl)
  private
    { Private declarations }
    FUnPress: TMetafile;
    FPress: TMetafile;
    FBorder: TMetafile;
    FFlag: TMetafile;
    FGrayed: TMetafile;
    FDisabled: TMetafile;
    FDisFlag: TMetafile;
    FDisGrayed: TMetafile;
    FMouseIn: boolean;
    FMouseDown: boolean;
    FAllowGrayed: Boolean;
    FState: TSRVCheckBoxState;
    FFocused: boolean;
    FCanPaint: boolean;
    procedure SetState(Value: TSRVCheckBoxState);
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;

    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure DrawFlag_(X, Y: Integer; CheckState: TSRVCheckBoxState; CheckEnabled, CheckMouseIn, Press: boolean);
    procedure DrawFlag;
    function GetFocusRect: TRect;
  protected
    { Protected declarations }
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure Toggle; virtual;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
    function GetChecked: Boolean;
    procedure SetChecked(Value: Boolean);
    procedure Paint; override;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    { Published declarations }
    property SkinManager;
    property SkinSchemeIndex;
    property ButtonSkinSchemeIndex;
    property Anchors;
    property Alignment default taLeftJustify;
    property AllowGrayed: Boolean read FAllowGrayed write FAllowGrayed default False;
    property Caption;
    property Checked: boolean read GetChecked write SetChecked;
    property Color;
    property DrawOnPrint default True;
    property Enabled;
    property Font;
    property Hint;
    property Height default 17;
    property PopupMenu;
    property ShowHint;
    property Visible;
    property TabStop default True;
    property TabOrder;
    property OnClick;
    {$IFDEF RICHVIEWDEF5}
    property OnContextPopup;
    {$ENDIF}
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property State: TSRVCheckBoxState read FState write SetState default cbUnchecked;
    property Width default 97;
  end;

implementation

constructor TSRVCheckBox.Create(AOwner: TComponent);
var
     MetafileCanvas : TMetafileCanvas;
begin
  inherited;
  Width := 97;
  Height := 17;
  ControlStyle := [csSetCaption, csDoubleClicks, csCaptureMouse];
  FAlignment := taLeftJustify;
  FMouseIn := False;
  FMouseDown := False;
  FAllowGrayed := False;
  FState := cbUnchecked;
  FFocused := False;
  FCanPaint := True;
  TabStop := True;

  FBorder := TMetafile.Create;
  FBorder.Width := 13;
  FBorder.Height := 13;
  MetafileCanvas := TMetafileCanvas.Create(FBorder, 0);
  PaintBorder($05AC7FF, MetafileCanvas);
  MetafileCanvas.Free;

  FUnPress := TMetafile.Create;
  FUnPress.Width := 13;
  FUnPress.Height := 13;
  MetafileCanvas := TMetafileCanvas.Create(FUnPress, 0);
  PaintPress(SRV_ENABLED_BORDER, MetafileCanvas);
  MetafileCanvas.Free;

  FPress := TMetafile.Create;
  FPress.Width := 13;
  FPress.Height := 13;
  MetafileCanvas := TMetafileCanvas.Create(FPress, 0);
  PaintPress(SRV_ENABLED_BORDER, MetafileCanvas);
  MetafileCanvas.Free;

  FFlag := TMetafile.Create;
  FFlag.Width := 13;
  FFlag.Height := 13;
  MetafileCanvas := TMetafileCanvas.Create(FFlag, 0);
  PaintFlag(SRV_FLAG_COLOR, MetafileCanvas);
  MetafileCanvas.Free;

  FGrayed := TMetafile.Create;
  FGrayed.Width := 13;
  FGrayed.Height := 13;
  MetafileCanvas := TMetafileCanvas.Create(FGrayed, 0);
  PaintGrayed(SRV_FLAG_COLOR, MetafileCanvas);
  MetafileCanvas.Free;

  FDisabled := TMetafile.Create;
  FDisabled.Height := 13;
  FDisabled.Width := 13;
  MetafileCanvas := TMetafileCanvas.Create(FDisabled, 0);
  PaintDisabled(SRV_DISABLED_BORDER, MetafileCanvas);
  MetafileCanvas.Free;

  FDisFlag := TMetafile.Create;
  FDisFlag.Width := 13;
  FDisFlag.Height := 13;
  MetafileCanvas := TMetafileCanvas.Create(FDisFlag, 0);
  PaintFlag(SRV_DISABLED_BORDER, MetafileCanvas);
  MetafileCanvas.Free;

  FDisGrayed := TMetafile.Create;
  FDisGrayed.Width := 13;
  FDisGrayed.Height := 13;
  MetafileCanvas := TMetafileCanvas.Create(FDisGrayed, 0);
  PaintGrayed(SRV_DISABLED_BORDER, MetafileCanvas);
  MetafileCanvas.Free;
end;

destructor TSRVCheckBox.Destroy;
begin
  inherited;
  FUnPress.Free;
  FPress.Free;
  FBorder.Free;
  FFlag.Free;
  FGrayed.Free;
  FDisabled.Free;
  FDisFlag.Free;
  FDisGrayed.Free;
end;

procedure TSRVCheckBox.Toggle;
begin
  case State of
    cbUnchecked:
      if AllowGrayed then State := cbGrayed else State := cbChecked;
    cbChecked: State := cbUnchecked;
    cbGrayed: State := cbChecked;
  end;
end;

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

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

procedure TSRVCheckBox.SetState(Value: TSRVCheckBoxState);
begin
  if FState <> Value then begin
    FState := Value;
    DrawFlag;
    if Assigned(OnClick) then
      OnClick(Self);
  end;
end;

procedure TSRVCheckBox.CMEnabledChanged(var Message: TMessage);
begin
  Inherited;
  DrawFlag;
end;

procedure TSRVCheckBox.CMMouseEnter(var Message: TMessage);
begin
  FMouseIn := True;
  DrawFlag;
  if Assigned(OnMouseEnter) then
    OnMouseEnter(Self);
end;

procedure TSRVCheckBox.CMMouseLeave(var Message: TMessage);
begin
  FMouseIn := False;
  DrawFlag;
  if Assigned(OnMouseLeave) then
    OnMouseLeave(Self);
end;

procedure TSRVCheckBox.KeyDown(var Key: Word; Shift: TShiftState);
begin
  FCanPaint := False;
  Inherited;
  if (Shift = []) and (Key = VK_SPACE) and (FMouseDown = False) then begin
    FMouseDown := True;
    DrawFlag;
  end;
  if Assigned(OnKeyDown) then
    OnKeyDown(Self, Key, Shift);
  FCanPaint := True;
end;

procedure TSRVCheckBox.KeyUp(var Key: Word; Shift: TShiftState);
begin
  FCanPaint := False;
  Inherited;
  if FMouseDown = True then begin
    FMouseDown := False;
    Toggle;
    DrawFlag;
  end;
  if Assigned(OnKeyUp) then
    OnKeyUp(Self, Key, Shift);
  if Assigned(OnClick) then
    OnClick(Self);
  FCanPaint := True;
end;

procedure TSRVCheckBox.DrawFlag_(X, Y: Integer; CheckState: TSRVCheckBoxState; CheckEnabled, CheckMouseIn, Press: boolean);
var
     R : TRect;
     IsCheck, DoSkin : Boolean;
begin
  IsCheck := ((CheckState = cbChecked) and not Press) or
    ((CheckState = cbUnchecked) and Press);
  R := Bounds(X, Y, FUnPress.Width, FUnPress.Height);
  DoSkin := DrawBoxBG(Canvas, R, FSkinManager, ButtonSkinSchemeIndex, True,
    CheckMouseIn, IsCheck, CheckEnabled, Focused, 1, clNone);

  If not DoSkin then
  Case CheckState of
    cbUnchecked:
      begin
        if CheckEnabled = True then begin
          if Press = False then
            Canvas.Draw(X, Y, FUnPress);
          if Press = True then
            Canvas.Draw(X, Y, FPress);
          if (CheckMouseIn = True) and (Press = False) then
            Canvas.Draw(X+1, Y+1, FBorder);
        end else
          Canvas.Draw(X, Y, FDisabled);
      end;
    cbChecked:
      begin
        if CheckEnabled = True then begin
          if Press = False then
            Canvas.Draw(X, Y, FUnPress);
          if Press = True then
            Canvas.Draw(X, Y, FPress);
          if (CheckMouseIn = True) and (Press = False) then
            Canvas.Draw(X+1, Y+1, FBorder);
          Canvas.Draw(X+3, Y+3, FFlag);
        end else begin
          Canvas.Draw(X, Y, FDisabled);
          Canvas.Draw(X+3, Y+3, FDisFlag);
        end;
      end;
    cbGrayed:
      begin
        if CheckEnabled = True then begin
          if Press = False then
            Canvas.Draw(X, Y, FUnPress);
          if Press = True then
            Canvas.Draw(X, Y, FPress);
          if (CheckMouseIn = True) and (Press = False) then
            Canvas.Draw(X+1, Y+1, FBorder);
          Canvas.Draw(X+3, Y+3, FGrayed);
        end else begin
          Canvas.Draw(X, Y, FDisabled);
          Canvas.Draw(X+3, Y+3, FDisGrayed);
        end;
      end;
  end;

  DrawBoxBorder(Canvas, R, FSkinManager, ButtonSkinSchemeIndex, True,
    CheckMouseIn, IsCheck, CheckEnabled, Focused, 1);
end;

procedure TSRVCheckBox.DrawFlag;
begin
  Canvas.Lock;

  if Alignment = taLeftJustify then
    DrawFlag_(0, (Height div 2) - (FUnPress.Height div 2), State,
      Enabled, FMouseIn, FMouseDown);
  if Alignment = taRightJustify then
    DrawFlag_(Width - FUnPress.Width,
      (Height div 2) - (FUnPress.Height div 2), State,
      Enabled, FMouseIn, FMouseDown);
  if Alignment = taCenter then
    DrawFlag_((Width - FUnPress.Width) div 2,
      (Height div 2) - (FUnPress.Height div 2), State,
      Enabled, FMouseIn, FMouseDown);

  Canvas.Unlock;
end;

function TSRVCheckBox.GetFocusRect: TRect;
begin
if (Alignment = taLeftJustify) then
  begin
  if not ((FUnPress.Width+4)+(Canvas.TextWidth(Caption)) > Width) and
     not ((Height div 2)-(Canvas.TextHeight('W') div 2)+Canvas.TextHeight(Caption)+1 > Height) then
       begin
         Result := Rect(FUnPress.Width+4, ((Height div 2) - (Canvas.TextHeight('W') div 2))-1, Canvas.TextWidth(Caption)+FUnPress.Width+6,
           (Height div 2) - (Canvas.TextHeight('W') div 2)+Canvas.TextHeight(Caption));
         Exit;
       end;
  if (((FUnPress.Width+4)+(Canvas.TextWidth(Caption)+FUnPress.Width+6)) > Width) and
     ((Height div 2)-(Canvas.TextHeight('W') div 2)+Canvas.TextHeight(Caption)+2 > Height) then
    begin
      Result := Rect(FUnPress.Width+4, 0, Width, Height);
      Exit;
    end;
  if (FUnPress.Width+4)+(Canvas.TextWidth(Caption)) > Width then
    begin
      Result := Rect(FUnPress.Width+4, (Height div 2) - (Canvas.TextHeight('W') div 2), Width,
        (Height div 2) - (Canvas.TextHeight('W') div 2)+Canvas.TextHeight(Caption));
      Exit;
    end;
  if ((Height div 2)-(Canvas.TextHeight('W') div 2)+Canvas.TextHeight(Caption)+2) > Height then
    begin
      Result := Rect(FUnPress.Width+4, 0, Canvas.TextWidth(Caption)+FUnPress.Width+6, Height);
      Exit;
    end;
end;
if Alignment = taRightJustify then
  begin
  if not ((FUnPress.Width+4)+(Canvas.TextWidth(Caption)) > Width) and
     not ((Height div 2)-(Canvas.TextHeight('W') div 2)+Canvas.TextHeight(Caption)+1 > Height) then
       begin
         Result := Rect(0, ((Height div 2) - (Canvas.TextHeight('W') div 2))-1, Canvas.TextWidth(Caption)+4,
           (Height div 2) - (Canvas.TextHeight('W') div 2)+Canvas.TextHeight(Caption));
         Exit;
       end;
  if (((FUnPress.Width+3)+(Canvas.TextWidth(Caption)+FUnPress.Width+6)) > Width) and
     ((Height div 2)-(Canvas.TextHeight('W') div 2)+Canvas.TextHeight(Caption)+2 > Height) then
    begin
      Result := Rect(0, 0, Width - (FUnPress.Width + 4), Height);
      Exit;
    end;
  if (FUnPress.Width+3)+(Canvas.TextWidth(Caption)) > Width then
    begin
      Result := Rect(0, (Height div 2) - (Canvas.TextHeight('W') div 2), Width - (FUnPress.Width + 4),
        (Height div 2) - (Canvas.TextHeight('W') div 2)+Canvas.TextHeight(Caption));
      Exit;
    end;
  if ((Height div 2)-(Canvas.TextHeight('W') div 2)+Canvas.TextHeight(Caption)+2) > Height then
    begin
      Result := Rect(0, 0, Canvas.TextWidth(Caption)+6, Height);
      Exit;
    end;
end;
end;

procedure TSRVCheckBox.Paint;
var
     R: TRect;
     DoSkin : Boolean;
begin
  if FCanPaint = False then
    Exit;

  Canvas.Lock;

  DrawBoxBG(Canvas, GetClientRect, FSkinManager, SkinSchemeIndex, True,
    MouseIn, FMouseDown, Enabled, Focused, 1, Color);

  Canvas.Font.Assign(Font);
  if Alignment = taLeftJustify then begin
    DrawFlag_(0, (Height div 2) - (FUnPress.Height div 2), State, Enabled, FMouseIn, FMouseDown);
    R := Rect(FUnPress.Width + 5, ((Height div 2) - (Canvas.TextHeight('W') div 2))-1, Width,
      (Height div 2) + (Canvas.TextHeight('W') div 2));
    DrawText(Canvas.Handle, PChar(Caption), Length(Caption), R, DT_LEFT);
  end;
  if Alignment = taRightJustify then begin
    DrawFlag_(Width - FUnPress.Width, (Height div 2) - (FUnPress.Height div 2), State, Enabled, FMouseIn, FMouseDown);
    R := Rect(2, ((Height div 2) - (Canvas.TextHeight('W') div 2))-1, Width - (FUnPress.Width + 5),
      (Height div 2) + (Canvas.TextHeight('W') div 2));
    DrawText(Canvas.Handle, PChar(Caption), Length(Caption), R, DT_LEFT);
  end;
  if Alignment = taCenter then begin
    DrawFlag_((Width - FUnPress.Width) div 2, (Height div 2) - (FUnPress.Height div 2), State, Enabled, FMouseIn, FMouseDown);
    R := Rect(2, ((Height div 2) - (Canvas.TextHeight('W') div 2))-1, (Width - (FUnPress.Width + 5)) div 2,
      (Height div 2) + (Canvas.TextHeight('W') div 2));
    DrawText(Canvas.Handle, PChar(Caption), Length(Caption), R, DT_LEFT);
  end;

  DoSkin := DrawBoxBorder(Canvas, GetClientRect, FSkinManager, SkinSchemeIndex, True,
    MouseIn, FMouseDown, Enabled, Focused, 1);
  if not DoSkin and Focused then
    Canvas.DrawFocusRect(GetFocusRect);

  Canvas.Unlock;
end;

procedure TSRVCheckBox.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if (Button = mbLeft) and (FMouseDown = False) then
    begin
      FMouseDown := True;
        if not Focused then
          SetFocus
        else DrawFlag;
    end;
  if Assigned(OnMouseDown) then
    OnMouseDown(Self, Button, Shift, X, Y);
end;

procedure TSRVCheckBox.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if (Button = mbLeft) and (FMouseDown = True) then begin
      FMouseDown := False;
      Toggle;
      DrawFlag;
    end;
  if Assigned(OnMouseUp) then
    OnMouseUp(Self, Button, Shift, X, Y);
  if Assigned(OnClick) then
    OnClick(Self);
end;

end.
