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

unit SRVButton;

interface
{$I RV_Defs.inc}
uses
  Windows, Messages, Graphics, Classes, Controls, Forms,
  {$IFNDEF RICHVIEWDEF5}
  StdCtrls,
  {$ENDIF}
  SRVControl;

const
  SRV_BTN_BORDER_COLOR = $00733C00;
  SRV_BTN_CORNERS_COLOR = $00AD967B;
  SRV_BTN_BKGRD_BDR_COLOR = $00EFF7F0;
  SRV_BTN_DSBL_BDR_COLOR = $00BFC7CF;
  SRV_BTN_PRESS_START = $00C6CFD6;
  SRV_BTN_PRESS_END = $00EBF3F7;
  SRV_BTN_BDR_MOUSE_START = $00CEF3FF;
  SRV_BTN_BDR_MOUSE_END = $000096E7;
  SRV_BTN_BDR_NOMOUSE_START = $00FFE7CE;
  SRV_BTN_BDR_NOMOUSE_END = $00EF846D;

type
  TSRVButton = class(TSRVCustomControl)
  private
    { Private desclarations }
    FLocked: Boolean;
    FOnClick: TNotifyEvent;
    FModalResult: TModalResult;
    FBgImg: TMetafile;
    FCkImg: TMetafile;
    FFcImg: TMetafile;
    FHlImg: TMetafile;
    FDefault: Boolean;
    FCancel: Boolean;
    FGlyph: TPicture;
    FShowFocusRect: Boolean;
    FFocusRectOffset: Integer;
    FMouseBorderWidth: Integer;
    FOffsetOnClick: Integer;
    {$IFNDEF RICHVIEWDEF5}
    FHighlighted: Boolean;
    {$ENDIF}
    procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure CMFocusChanged(var Message: TMessage); message CM_FOCUSCHANGED;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure CMParentColorChanged(var Message: TMessage); message CM_PARENTCOLORCHANGED;
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure CMDialogKey(var Message: TCMDialogKey); message CM_DIALOGKEY;
  protected
    { Protected desclarations }
    function IsDrawState(IgnoreDefault: Boolean = False): Boolean;
    procedure Click; reintroduce;
    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;
    procedure HookEnabledChanged; dynamic;
    procedure HookFocusedChanged; dynamic;
    procedure HookMouseDown; dynamic;
    procedure HookMouseEnter; dynamic;
    procedure HookMouseLeave; dynamic;
    procedure HookMouseMove; dynamic;
    procedure HookMouseUp; dynamic;
    procedure HookParentColorChanged; dynamic;
    procedure HookResized; dynamic;
    procedure HookTextChanged; dynamic;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
    procedure SetDefault(NewDefault: Boolean); virtual;
    procedure SetGlyph(NewGlyph: TPicture); virtual;
    procedure SetShowFocusRect(NewShowFocusRect: Boolean); virtual;
    procedure SetFocusRectOffset(NewFocusRectOffset: Integer); virtual;
    procedure SetMouseBorderWidth(NewMouseBorderWidth: Integer); virtual;
    procedure SetOffsetOnClick(NewOffsetOnClick: Integer); virtual;
    procedure Paint; override;
  public
    { Public declarations }
    DrawState: TOwnerDrawState;
    IsFind: Boolean;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure LockUpdate;
    procedure UnlockUpdate;
  published
    { Published declarations }
    property Anchors;
    property Align;
    Property Caption;
    property Color;
    property Cursor;
    property Default: Boolean read FDefault write SetDefault default False;
    property DrawOnPrint default True;
    property Enabled;
    property Font;
    property Hint;
    property FocusRectOffset: Integer read FFocusRectOffset write SetFocusRectOffset default 3;
    property Glyph: TPicture read FGlyph write SetGlyph;
    property Height default 26;
    property ModalResult: TModalResult read FModalResult write FModalResult default 0;
    property MouseBorderWidth: Integer read FMouseBorderWidth write SetMouseBorderWidth default 2;
    property PopupMenu;
    property ShowFocusRect: Boolean read FShowFocusRect write SetShowFocusRect default True;
    property ShowHint;
    property OffsetOnClick: Integer read FOffsetOnClick write SetOffsetOnClick default 0;
    property Visible;
    property TabStop default True;
    property Width default 75;
    property OnClick: TNotifyEvent read FOnClick write FOnClick;
    {$IFDEF RICHVIEWDEF5}
    property OnContextPopup;
    {$ENDIF}
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnMouseMove;
    property OnMouseUp;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('SRichView', [TSRVButton]);
end;

{ TSRVButton }

constructor TSRVButton.Create(AOwner: TComponent);
begin
  inherited;
  DoubleBuffered := True;
  {$IFDEF RICHVIEWDEF5}
  DrawState := [odDefault];
  {$ENDIF}
  IsFind := False;
  FLocked := False;
  FModalResult := 0;
  Height := 26;
  TabStop := True;
  Width := 75;
  FCancel := False;
  FDefault := False;
  FGlyph := TPicture.Create;
  FShowFocusRect := True;
  FFocusRectOffset := 3;
  FMouseBorderWidth := 2;
  FOffsetOnClick := 0;
  FBgImg := TMetafile.Create;
  FCkImg := TMetafile.Create;
  FFcImg := TMetafile.Create;
  FHlImg := TMetafile.Create;
end;

destructor TSRVButton.Destroy;
begin
  FBgImg.Free;
  FCkImg.Free;
  FFcImg.Free;
  FHlImg.Free;
  FGlyph.Free;
  inherited;
end;

procedure TSRVButton.LockUpdate;
begin
  FLocked := True;
end;

procedure TSRVButton.UnlockUpdate;
begin
  FLocked := False;
  Invalidate;
end;

procedure TSRVButton.CMDialogChar(var Message: TCMDialogChar);
begin
  with Message do
  if IsAccel(CharCode, Caption) and CanFocus and (Focused or
    ((GetKeyState(VK_MENU) and $8000) <> 0)) then Click
  else
    inherited;
end;

procedure TSRVButton.CMEnabledChanged(var Message: TMessage);
begin
  inherited;
  HookEnabledChanged;
end;

procedure TSRVButton.CMFocusChanged(var Message: TMessage);
begin
  inherited;
  HookFocusedChanged;
end;

procedure TSRVButton.CMMouseEnter(var Message: TMessage);
begin
  inherited;
  HookMouseEnter;
end;

procedure TSRVButton.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  HookMouseLeave;
end;

procedure TSRVButton.CMParentColorChanged(var Message: TMessage);
begin
  inherited;
  HookParentColorChanged;
end;

procedure TSRVButton.CMTextChanged(var Message: TMessage);
begin
  inherited;
  HookTextChanged;
end;

procedure TSRVButton.WMSize(var Message: TWMSize);
begin
  HookResized;
end;

procedure TSRVButton.CMDialogKey(var Message: TCMDialogKey);
begin
  inherited;
  with Message do
  if (((CharCode = VK_RETURN) and (Focused or (FDefault and not(IsFind)))) or
     ((CharCode = VK_ESCAPE) and FCancel) and (KeyDataToShiftState(KeyData) = [])) and
     CanFocus then
  begin
    Click;
    Result := 1;
  end
  else
    inherited;
end;

procedure TSRVButton.Click;
var
  Form: TCustomForm;
begin
  Form := GetParentForm(Self);
  if Form <> nil then
    Form.ModalResult := ModalResult;
  if assigned(FOnClick) then
    FOnClick(Self);
  inherited;
end;

procedure TSRVButton.MouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  if Button = mbLeft then
    HookMouseDown;
end;

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

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

procedure TSRVButton.HookEnabledChanged;
begin
  if not FLocked then
    Invalidate;
end;

procedure TSRVButton.HookFocusedChanged;
begin
  if Focused then
    Include(DrawState, odFocused)
  else
  begin
    Exclude(DrawState, odFocused);
    Exclude(DrawState, odSelected);
  end;
  IsFind := GetParentForm(Self).ActiveControl is TSRVButton;
  if not FLocked then
    Invalidate;
end;

procedure TSRVButton.HookMouseDown;
begin
  SetFocus;
  Include(DrawState, odSelected);
  if not FLocked then
    Invalidate;
end;

procedure TSRVButton.HookMouseEnter;
begin
  {$IFDEF RICHVIEWDEF5}
  Include(DrawState, odHotLight);
  {$ELSE}
  FHighlighted := True;
  {$ENDIF}
  if not FLocked then
    Invalidate;
  if assigned(OnMouseEnter) then
    OnMouseEnter(Self);
end;

procedure TSRVButton.HookMouseLeave;
begin
  {$IFDEF RICHVIEWDEF5}
  Exclude(DrawState, odHotLight);
  {$ELSE}
  FHighlighted := False;
  {$ENDIF}
  if not FLocked then
    Invalidate;
  if assigned(OnMouseLeave) then
    OnMouseLeave(Self);
end;

procedure TSRVButton.HookMouseMove;
begin
  ;
end;

procedure TSRVButton.HookMouseUp;
var
  ValidClick: Boolean;
begin
  if odSelected in DrawState then
  begin
    ValidClick :=
      {$IFDEF RICHVIEWDEF5}
      (odHotLight in DrawState)
      {$ELSE}
      FHighlighted
      {$ENDIF}
      and (odFocused in DrawState);
    Exclude(DrawState, odSelected);
    if not FLocked then
      Invalidate;
    if ValidClick then
      Click;
  end;
end;

procedure TSRVButton.HookParentColorChanged;
begin
  Invalidate;
end;

procedure TSRVButton.HookResized;
var
  Offset, ColSteps: Integer;
begin
    ColSteps := 32;
  Offset := 4 * (Integer(IsDrawState(True)));
  DrawGradient(Width - (2 + Offset), Height - (2 + Offset),
    SRV_FACE_START, SRV_FACE_END, ColSteps, gsTop, True, FBgImg);
  DrawGradient(Width - 2, Height - 2, SRV_BTN_PRESS_START, SRV_BTN_PRESS_END, ColSteps,
    gsTop, True, FCkImg);
  DrawGradient(Width - 2, Height - 2, SRV_BTN_BDR_MOUSE_START, SRV_BTN_BDR_MOUSE_END, ColSteps,
    gsTop, True, FHlImg);
  DrawGradient(Width - 2, Height - 2, SRV_BTN_BDR_NOMOUSE_START, SRV_BTN_BDR_NOMOUSE_END, ColSteps,
    gsTop, True, FFcImg);
end;

procedure TSRVButton.HookTextChanged;
begin
  if not FLocked then
    Invalidate;
end;

function TSRVButton.IsDrawState(IgnoreDefault: Boolean = False): Boolean;
begin
  {$IFDEF RICHVIEWDEF5}
  if odSelected in DrawState then
    Result := not(odHotLight in DrawState)
  else
    Result := (odHotLight in DrawState) or (odFocused in DrawState);
  {$ELSE}
  if odSelected in DrawState then
    Result := not FHighlighted
  else
    Result := FHighlighted or (odFocused in DrawState);
  {$ENDIF}
  if not IgnoreDefault then
    Result := Result or FDefault and not IsFind;
end;

procedure TSRVButton.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited;
  if (Shift = []) and (Key = VK_SPACE) then
  begin
    LockUpdate;
    try
      HookMouseEnter;;
      HookMouseDown;
    finally
      UnlockUpdate;
    end;
  end;
end;

procedure TSRVButton.KeyUp(var Key: Word; Shift: TShiftState);
begin
  if not(odSelected in DrawState) then
    Exit;
  HookMouseUp;
  HookMouseLeave;
  inherited;
end;

procedure TSRVButton.SetDefault(NewDefault: Boolean);
begin
  if NewDefault <> FDefault then
  begin
    FDefault := NewDefault;
    with GetParentForm(Self) do
      Perform(CM_FOCUSCHANGED, 0, LongInt(ActiveControl));
  end;
end;

procedure TSRVButton.SetGlyph(NewGlyph: TPicture);
begin
  FGlyph.Assign(NewGlyph);
  Invalidate;
end;

procedure TSRVButton.SetShowFocusRect(NewShowFocusRect: Boolean);
begin
  if NewShowFocusRect <> FShowFocusRect then
  begin
    FShowFocusRect := NewShowFocusRect;
    Invalidate;
  end;
end;

procedure TSRVButton.SetFocusRectOffset(NewFocusRectOffset: Integer);
begin
  if NewFocusRectOffset <> FFocusRectOffset then
  begin
    FFocusRectOffset := NewFocusRectOffset;
    Invalidate;
  end;
end;

procedure TSRVButton.SetMouseBorderWidth(NewMouseBorderWidth: Integer);
begin
  if NewMouseBorderWidth <> FMouseBorderWidth then
  begin
    FMouseBorderWidth := NewMouseBorderWidth;
    Invalidate;
  end;
end;

procedure TSRVButton.SetOffsetOnClick(NewOffsetOnClick: Integer);
begin
  if NewOffsetOnClick <> FOffsetOnClick then
  begin
    FOffsetOnClick := NewOffsetOnClick;
    Invalidate;
  end;
end;

procedure TSRVButton.Paint;
var
     R: TRect;
     Offset, Flags: Integer;
     Metafile: TMetafile;
begin
 if Enabled = True then
 begin
  with Canvas do
  begin
    R := GetClientRect;
    Brush.Color := Self.Color;
    FillRect(R);

    if IsDrawState then
    begin
      try
        if {$IFDEF RICHVIEWDEF5}odHotLight in DrawState{$ELSE}FHighlighted{$ENDIF} then
          Metafile := FHlImg
        else
          Metafile := FFcImg;
        Canvas.StretchDraw(Bounds(0, 0, Width, Height-4), Metafile);
      finally
      end;
    end;
    if not(({$IFDEF RICHVIEWDEF5}odHotLight in DrawState{$ELSE}FHighlighted{$ENDIF}) and (odSelected in DrawState)) then
    begin
      Offset := MouseBorderWidth+1;
      if IsDrawState then
        Canvas.StretchDraw(Bounds(Offset, Offset, Width - Offset*2, Height - Offset*2-9), FBgImg);
      if not IsDrawState then
        Canvas.StretchDraw(Bounds(0, 0, Width, Height - 1*2-9), FBgImg);
    end
    else
      Canvas.StretchDraw(Bounds(0, 0, Width, Height-9), FCkImg);

    if (odFocused in DrawState) and (FShowFocusRect) then
      DrawFocusRect(Bounds(FFocusRectOffset, FFocusRectOffset, Width - (FFocusRectOffset * 2), Height - (FFocusRectOffset * 2)));
    Pen.Color := SRV_BTN_BORDER_COLOR;
    Brush.Style := bsClear;
    RoundRect(0, 0, Width, Height, 5, 5);
    Pen.Color := SRV_BTN_CORNERS_COLOR;
    SetPixel(Canvas.Handle, 0, 1, Pen.Color);
    SetPixel(Canvas.Handle, 1, 0, Pen.Color);
    DrawLine(Canvas, Width - 2, 0, Width, 2);
    DrawLine(Canvas, 0, Height - 2, 2, Height);
    DrawLine(Canvas, Width - 3, Height, Width, Height - 3);
    InflateRect(R, -4, 0);
    if ({$IFDEF RICHVIEWDEF5}odHotLight in DrawState{$ELSE}FHighlighted{$ENDIF}) and (odSelected in DrawState) then
      OffsetRect(R, OffsetOnClick, OffsetOnClick);
    if FGlyph.Graphic <> nil then
    begin
      FGlyph.Graphic.Transparent := True;
      Draw(R.Left + 3, (Height - FGlyph.Height) div 2 + R.Top, FGlyph.Graphic);
      Inc(R.Left, FGlyph.Width + 3);
    end;
    Flags := DT_SINGLELINE or DT_CENTER or DT_VCENTER or DT_END_ELLIPSIS;
    Font.Assign(Self.Font);
    PaintText(Self, Canvas, Caption, Font, True, True, R, Flags);
  end;
 end;
if Enabled = False then
  begin
  R := GetClientRect;
  Canvas.Brush.Color := Color;
  Canvas.FillRect(R);
  Canvas.Brush.Color := SRV_BTN_BKGRD_BDR_COLOR;
  Canvas.FillRect(Rect(2, 2, Width-2, Height-2));
  Canvas.Pen.Color := SRV_BTN_DSBL_BDR_COLOR;
  Canvas.RoundRect(0, 0, Width, Height, -6, -6);
  Canvas.Font.Color := $0090A0A0;
  R := Rect(2, 2, Width-2, Height-2);
  if FGlyph.Graphic <> nil then
    begin
      FGlyph.Graphic.Transparent := True;
      Canvas.Draw(R.Left + 5, (Height - FGlyph.Height) div 2 + R.Top - 2, FGlyph.Graphic);
      Inc(R.Left, FGlyph.Width + 3);
    end;
  Flags := DT_SINGLELINE or DT_CENTER or DT_VCENTER or DT_END_ELLIPSIS;
  PaintText(Self, Canvas, Caption, Font, False, True, R, Flags);
  end;
end;

end.
