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

unit SRVRadioButton;

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

type
  TSRVRadioButton = class(TSRVCustomControl)
  private
    { Private declarations }
    FUnPress: TMetafile;
    FPress: TMetafile;
    FBorder: TMetafile;
    FFlag: TMetafile;
    FDisabled: TMetafile;
    FDisFlag: TMetafile;
    FMouseIn: boolean;
    FMouseDown: boolean;
    FMouseEnter: TNotifyEvent;
    FMouseLeave: TNotifyEvent;
    FFocused: boolean;
    FCanPaint: boolean;
    FChecked: boolean;
    procedure WMSize(var Message: TMessage); message WM_SIZE;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure CMFocusChanged(var Message: TMessage); message CM_FOCUSCHANGED;
    procedure MouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure MouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure DrawFlag(X, Y: Integer; IsChecked, CheckEnabled, CheckMouseIn, Press: boolean);
    procedure RedrawFlag;
    function GetFocusRect: TRect;
    procedure UnCheck;
  protected
    { Protected declarations }
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
    procedure SetChecked(NewChecked: 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 Caption;
    property Checked: boolean read FChecked write SetChecked;
    property Color;
    property Enabled;
    property DrawOnPrint default True;
    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 OnMouseEnter: TNotifyEvent read FMouseEnter write FMouseEnter;
    property OnMouseLeave: TNotifyEvent read FMouseLeave write FMouseLeave;
    property Width default 113;
  end;

implementation
uses Math;

procedure PaintPress(Color : TColor; Canvas : TCanvas);
var
     hrgn : THandle;
begin
  hrgn := CreateRoundRectRgn(0, 0, 14, 14, 14, 14);
  SelectClipRgn(Canvas.Handle, hrgn);
  DrawGradientToCanvas(13, 7, SRV_FACE_START, SRV_FACE_END, 32, gsTop, True, Canvas);
  DeleteObject(hrgn);

  hrgn := CreateRectRgn(0, 0, 13, 13);
  SelectClipRgn(Canvas.Handle, hrgn);
  Canvas.Brush.Style := bsClear;
  Canvas.Pen.Width := 1;
  Canvas.Pen.Color := Color;
  Canvas.Ellipse(1, 1, 13, 13);
  DeleteObject(hrgn);
end;

procedure PaintBorder(Color : TColor; Canvas : TCanvas);
begin
  Canvas.Pen.Color := Color;
  Canvas.Brush.Style := bsClear;
  Canvas.Ellipse(1, 1, 11, 11);
  Canvas.Pen.Color := RGB(Min(getRValue(Color) + $10, $0FF),
                          Min(getGValue(Color) + $10, $0FF),
                          Min(getBValue(Color) + $10, $0FF));
  Canvas.Ellipse(2, 2, 10, 10);
end;

procedure PaintFlag(Color : TColor; Canvas : TCanvas);
begin
  Canvas.Pen.Color := Color;
  Canvas.Brush.Color := Color;
  Canvas.Ellipse(0, 0, 6, 6);
  Canvas.Pen.Color := RGB(Min(getRValue(Color) + $20, $0FF),
                          Min(getGValue(Color) + $20, $0FF),
                          Min(getBValue(Color) + $20, $0FF));
  Canvas.Brush.Color := Canvas.Pen.Color;
  Canvas.Ellipse(1, 1, 5, 5);
  Canvas.Pen.Color := RGB(Min(getRValue(Color) + $30, $0FF),
                          Min(getGValue(Color) + $30, $0FF),
                          Min(getBValue(Color) + $30, $0FF));
  Canvas.Brush.Color := Canvas.Pen.Color;
  Canvas.Ellipse(2, 2, 4, 4);
end;

procedure PaintDisabled(Color : TColor; Canvas : TCanvas);
begin
  Canvas.Brush.Color := clWhite;
  Canvas.Pen.Color := Color;
  Canvas.Ellipse(1, 1, 13, 13);
end;


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

  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;

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

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

  FDisabled := TMetafile.Create;
  FDisabled.Width := 13;
  FDisabled.Height := 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;
end;

destructor TSRVRadioButton.Destroy;
begin
  inherited;
  FUnPress.Free;
  FPress.Free;
  FBorder.Free;
  FFlag.Free;
  FDisabled.Free;
  FDisFlag.Free;
end;

procedure TSRVRadioButton.SetChecked(NewChecked: Boolean);
begin
  if NewChecked <> FChecked then
    begin
      UnCheck;
      FChecked := NewChecked;
      RedrawFlag;
      if Assigned(OnClick) then
        OnClick(Self);
    end;
end;

procedure TSRVRadioButton.WMSize(var Message: TMessage);
begin
  inherited;
  Invalidate;
end;

procedure TSRVRadioButton.CMEnabledChanged(var Message: TMessage);
begin
  Inherited;
  RedrawFlag;
end;

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

procedure TSRVRadioButton.CMFocusChanged(var Message: TMessage);
begin
  Inherited;
  if Focused then
    begin
      Checked := True;
      UnCheck;
      if Assigned(OnClick) then
        OnClick(Self);
    end;
  Invalidate;
end;

procedure TSRVRadioButton.MouseEnter(var Message: TMessage);
begin
  FMouseIn := True;
  RedrawFlag;
  if Assigned(FMouseEnter) then
    FMouseEnter(Self);
end;

procedure TSRVRadioButton.MouseLeave(var Message: TMessage);
begin
  FMouseIn := False;
  RedrawFlag;
  if Assigned(FMouseLeave) then
    FMouseLeave(Self);
end;

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

procedure TSRVRadioButton.KeyUp(var Key: Word; Shift: TShiftState);
begin
  FCanPaint := False;
  Inherited;
  if FMouseDown = True then
    begin
      FMouseDown := False;
      Checked := True;
      RedrawFlag;
      UnCheck;
      if Assigned(OnClick) then
        OnClick(Self);
    end;
  if Assigned(OnKeyUp) then
    OnKeyUp(Self, Key, Shift);
  FCanPaint := True;
end;

procedure TSRVRadioButton.DrawFlag(X, Y: Integer; IsChecked, CheckEnabled, CheckMouseIn, Press: boolean);
var
     R : TRect;
     IsCheck, DoSkin : Boolean;
begin
  R := Bounds(X, Y, FUnPress.Width, FUnPress.Height);
  IsCheck := (IsChecked and not Press) or (not IsChecked and Press);
  DoSkin := DrawBoxBG(Canvas, R, FSkinManager, ButtonSkinSchemeIndex, True,
    CheckMouseIn, IsCheck, CheckEnabled, Focused, 1, Color);

  If not DoSkin then
    if IsChecked = True then 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+4, Y+4, FFlag);
      end else begin
        Canvas.Draw(X, Y, FDisabled);
        Canvas.Draw(X+4, Y+4, FDisFlag);
      end;
    end else 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;

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

procedure TSRVRadioButton.RedrawFlag;
begin
  Canvas.Lock;
  if Alignment = taLeftJustify then
    DrawFlag(0, (Height div 2) - (FUnPress.Height div 2), Checked,
      Enabled, FMouseIn, FMouseDown);
  if Alignment = taRightJustify then
    DrawFlag(Width - FUnPress.Width,
      (Height div 2) - (FUnPress.Height div 2), Checked,
      Enabled, FMouseIn, FMouseDown);
  if Alignment = taCenter then
    DrawFlag((Width - FUnPress.Width) div 2,
      (Height div 2) - (FUnPress.Height div 2), Checked,
      Enabled, FMouseIn, FMouseDown);
   Canvas.Unlock;
end;

function TSRVRadioButton.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 TSRVRadioButton.UnCheck;
var
  I: Integer;
  Sibling: TControl;
begin
  if Parent <> nil then
    with Parent do
      for I := 0 to ControlCount - 1 do
        begin
          Sibling := Controls[I];
          if (Sibling <> Self) and (Sibling is TSRVRadioButton) then
            TSRVRadioButton(Sibling).SetChecked(False);
        end;
end;

procedure TSRVRadioButton.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 := Font;
  if Alignment = taLeftJustify then begin
    DrawFlag(0, (Height div 2) - (FUnPress.Height div 2), Checked, 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), Checked, 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 = taRightJustify then begin
    DrawFlag((Width - FUnPress.Width) div 2, (Height div 2) - (FUnPress.Height div 2), Checked, 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 TSRVRadioButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if (Button = mbLeft) and (FMouseDown = False) then
    begin
      SetFocus;
      FMouseDown := True;
      RedrawFlag;
    end;
  if Assigned(OnMouseDown) then
    OnMouseDown(Self, Button, Shift, X, Y);
end;

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

end.
