unit TFSRVHint;

interface

{$I RV_Defs.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, RVScroll, RichView, RVStyle, RVEdit, ImgList, ExtCtrls,
  SRVToolBar;

const
  stvhShowHint = 4567;
  stvhHideHint = stvhShowHint + 1;

type
  TFSRVHint1 = class(TForm)
    Panel1: TPanel;
    RichView1: TRichView;
    pnlCaption: TPanel;
    lblCaption: TLabel;
    MenuToolBarTop: TSRVToolBar;
    pnlBottom: TPanel;
    MenuToolBarBottom: TSRVToolBar;
    ImageList1: TImageList;
    RVStyle1: TRVStyle;
    ImageList2: TImageList;
    ImageList3: TImageList;
    lnLeftTop: TImage;
    lnLeft: TImage;
    lnLeftBottom: TImage;
    lnBottom: TImage;
    lnRightBottom: TImage;
    lnRight: TImage;
    lnRightTop: TImage;
    lnTop: TImage;
    procedure FormCreate(Sender: TObject);
    procedure lnTopMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure lnTopMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure lnTopMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure lnLeftTopMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure lnLeftMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure lnRightTopMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure lnRightMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure lnBottomMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure lnLeftBottomMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure lnRightBottomMouseMove(Sender: TObject; Shift: TShiftState;
      X, Y: Integer);
    procedure pnlCaptionMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure pnlCaptionMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure pnlCaptionMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure RichView1Click(Sender: TObject);
    procedure MenuToolBarTopClickButton(Sender: TObject;
      ToolButton: TSRVToolButton);
    procedure MenuToolBarBottomClickButton(Sender: TObject;
      ToolButton: TSRVToolButton);
  private
    { Private declarations }
    IsByse : Boolean;
    IsLock : Boolean;
    procedure ResizeDelta(deltaX, deltaY : Integer; moveX, moveY: Boolean);
  public
    { Public declarations }
    HintDelay : Integer;
    HintBounds : TRect;
    ShowInMousePos : Boolean;
    AllwaysShow : Boolean;
    IsStickForm : Boolean;
    DeltaX : Integer;
    DeltaY : Integer;
    CanActiveHint : Boolean;
    CanResize : Boolean;
    CanMove : Boolean;
    HintOwner : TObject;
    procedure DefaultHandler(var Message); override;
    {
    function CanFocus: Boolean; override;
    }
    procedure WMActivate(var Message: TMessage); message WM_ACTIVATE;
    procedure WMMouseActivate(var Message: TMessage); message WM_MOUSEACTIVATE;
    procedure WMSetFocus(var Message: TMessage); message WM_SETFOCUS;
    procedure WMMouseDown(var Message: TWMMouse); message WM_LBUTTONDOWN;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure WMMouseMove(var Message: TWMMouseMove); message WM_MOUSEMOVE;
    procedure WMTimer(var Message: TMessage); message WM_TIMER;
    procedure StickForm(var msg: TWMWindowPosChanging); message WM_WINDOWPOSCHANGING;

    procedure RunTimerCloseHint;
    procedure ShowHintWithDelay(Delay : Integer);
    procedure ShowHintWindow;
    procedure HideHintWindow;
    function  IsShowHint : Boolean;
    procedure Lock;
    procedure Unlock;
    function  InMouse : Boolean;
  end;

var
  // размеры формы
  oldWidth, oldHeight : Integer;
  FormMoved, oldPos : TPoint;
  StateMoveForm, isResizing : Boolean;
  oldWRect, WRect : TRect;

implementation

uses SRVHint;

{$R *.DFM}

procedure TFSRVHint1.FormCreate(Sender: TObject);
begin
  HintOwner := Sender;
  HintDelay := 3000;
  TabStop := False;
  IsLock := False;
  ShowInMousePos := True;
  CanActiveHint := False;
  Tag := -1;
//  ControlState := csFocusing

  StateMoveForm := false;
  isResizing := false;
  oldWidth := 0;
  oldHeight := 0;
end;

{
function TFSRVHint1.CanFocus: Boolean;
begin
  Result := False;
end;
}

procedure TFSRVHint1.WMSetFocus(var Message: TMessage);
begin
  inherited;
//  Message.Result := -1;
end;

procedure TFSRVHint1.WMMouseDown(var Message: TWMMouse);
begin
  inherited;
end;

procedure TFSRVHint1.WMMouseMove(var Message: TWMMouseMove);
begin
  inherited;
end;

procedure TFSRVHint1.WMActivate(var Message: TMessage);
begin
  inherited;
end;

procedure TFSRVHint1.WMMouseActivate(var Message: TMessage);
begin
  Message.Result := 0;
  inherited;
end;

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

{-----------------------------------------------------------------------}
function  TFSRVHint1.InMouse : Boolean;
begin
  Result := PtInRect(BoundsRect, Mouse.CursorPos) or
            PtInRect(HintBounds, Mouse.CursorPos);
end;


procedure TFSRVHint1.RunTimerCloseHint;
begin
  if (HintDelay <> 0) then begin
    if SetTimer(WindowHandle, stvhHideHint, HintDelay, nil) = 0 then
      raise EOutOfResources.Create('Out of resource for installing timer');
  end else If not InMouse then
    HideHintWindow;
end;

procedure TFSRVHint1.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  RunTimerCloseHint;
end;

procedure TFSRVHint1.DefaultHandler(var Message);
begin
//  If (TMessage(Message).Msg <> WM_ACTIVATE) and
//     (TMessage(Message).Msg <> WM_MOUSEACTIVATE) and
//     (TMessage(Message).Msg <> WM_SETFOCUS) then
  inherited;
end;

procedure TFSRVHint1.HideHintWindow;
begin
  If isResizing or StateMoveForm then
    Exit;
  ShowWindow(Handle, SW_HIDE);
  Visible := False;
  Lock;
end;

procedure TFSRVHint1.ShowHintWithDelay(Delay : Integer);
begin
  Unlock;
  If (Delay = 0) then
    ShowHintWindow
  else if (Delay <> 0) and not IsWindowVisible(WindowHandle) then
    if SetTimer(WindowHandle, stvhShowHint, Delay, nil) = 0 then
      raise EOutOfResources.Create('Out of resource for installing timer');
end;

procedure TFSRVHint1.ShowHintWindow;
begin
  If IsLock or (not InMouse and not AllwaysShow) then
    Exit;

  If ShowInMousePos then begin
    Left := Mouse.CursorPos.x + DeltaX;
    Top := Mouse.CursorPos.y + DeltaY;
  end;
  If CanActiveHint then
    ShowWindow(WindowHandle, SW_SHOW)
  else
    ShowWindow(WindowHandle, SW_SHOWNOACTIVATE);
  SetForegroundWindow(WindowHandle);
  Visible := True;

  RunTimerCloseHint;
end;

procedure TFSRVHint1.WMTimer(var Message: TMessage);
begin
  If IsByse then
    Exit;

  IsByse := True;

  If (Message.WParam = stvhShowHint) then begin
    KillTimer(WindowHandle, stvhShowHint);

    ShowHintWindow;
  end else If (Message.WParam = stvhHideHint) and not InMouse then begin
    KillTimer(WindowHandle, stvhHideHint);

    HideHintWindow;
  end;

  IsByse := False;
end;

function  TFSRVHint1.IsShowHint : Boolean;
begin
  Result := IsWindowVisible(WindowHandle);
end;

procedure TFSRVHint1.Lock;
begin
  IsLock := True;
end;

procedure TFSRVHint1.MenuToolBarBottomClickButton(Sender: TObject;
  ToolButton: TSRVToolButton);
begin
  If Assigned(TSRVHint(HintOwner).OnClickBottomButton) then
    TSRVHint(HintOwner).OnClickBottomButton(Sender, ToolButton);
end;

procedure TFSRVHint1.MenuToolBarTopClickButton(Sender: TObject;
  ToolButton: TSRVToolButton);
begin
  If Assigned(TSRVHint(HintOwner).OnClickTopButton) then
    TSRVHint(HintOwner).OnClickTopButton(Sender, ToolButton);
end;

procedure TFSRVHint1.Unlock;
begin
  IsLock := False;
end;

procedure TFSRVHint1.StickForm(var msg : TWMWindowPosChanging);
var
     rWorkArea : TRect;
     StickAt : Integer;
     Docked : Boolean;
begin
  If not IsStickForm then begin
    inherited;
    Exit;
  end;

  Docked := False;

  StickAt := 10;

  SystemParametersInfo(SPI_GETWORKAREA, 0, @rWorkArea, 0);

  if (msg.WindowPos.x <= rWorkArea.Left + StickAt) then begin
     msg.WindowPos.x := rWorkArea.Left;
     Docked := true;
  end;

  if (msg.WindowPos.x + msg.WindowPos.cx >= rWorkArea.Right - StickAt) then begin
     msg.WindowPos.x := rWorkArea.Right - msg.WindowPos.cx;
     Docked := true;
  end;

  if (msg.WindowPos.y <= rWorkArea.Top + StickAt) then begin
    msg.WindowPos.y := rWorkArea.Top;
    Docked := true;
  end;

  if (msg.WindowPos.y + msg.WindowPos.cy >= rWorkArea.Bottom - StickAt) then begin
    msg.WindowPos.y := rWorkArea.Bottom - msg.WindowPos.cy;
    Docked := true;
  end;

  if (Docked) then begin
    // запрещаем перемещение за пределы экрана
    if (msg.WindowPos.x < rWorkArea.Left) then
      msg.WindowPos.x := rWorkArea.Left;
    if (msg.WindowPos.x + msg.WindowPos.cx > rWorkArea.Right) then
      msg.WindowPos.x := rWorkArea.Right - msg.WindowPos.cx;
    if (msg.WindowPos.y < rWorkArea.Top) then
      msg.WindowPos.y := rWorkArea.Top;
    if (msg.WindowPos.y + msg.WindowPos.cy > rWorkArea.Bottom) then
      msg.WindowPos.y := rWorkArea.Bottom - msg.WindowPos.cy;
  end;
end;
//---------------------------------------------------------------------------

procedure TFSRVHint1.ResizeDelta(deltaX, deltaY : Integer; moveX, moveY: Boolean);
begin
  if (Width + deltaX < Constraints.MinWidth) then
    deltaX := Constraints.MinWidth - Width;
  if (Height + deltaY < Constraints.MinHeight) then
    deltaY := Constraints.MinHeight - Height;

  if (moveX and moveY) then
    SetBounds(Left - deltaX, Top - deltaY, Width + deltaX, Height + deltaY)
  else if (moveX) then
    SetBounds(Left - deltaX, Top, Width + deltaX, Height + deltaY)
  else if (moveY) then
    SetBounds(Left, Top - deltaY, Width + deltaX, Height + deltaY)
  else
    SetBounds(Left, Top, Width + deltaX, Height + deltaY);
end;


procedure TFSRVHint1.RichView1Click(Sender: TObject);
begin
  If Assigned(TSRVHint(HintOwner).OnClick) then
    TSRVHint(HintOwner).OnClick(HintOwner);
end;

procedure TFSRVHint1.lnTopMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if (WindowState <> wsNormal) or not CanResize then
    Abort;
  isResizing := true;
  oldPos.x := X;
  oldPos.y := Y;
  GetWindowRect(Handle, oldWRect); //получаем прямоугольник окна
  GetWindowRect(Handle, WRect); //получаем прямоугольник окна
  DrawFocusRect(GetDC(0), WRect); //АПИ функция, рисующая рамку
end;

procedure TFSRVHint1.lnTopMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
     dy : Integer;
begin
  if (isResizing) then begin
	  DrawFocusRect(GetDC(0), WRect); //стираем предыдущую рамку
    dy := Y - oldPos.y;
    if ((oldWRect.Top + dy > 0) and (oldWRect.Bottom - oldWRect.Top - dy > Constraints.MinHeight)) then
      WRect.Top := oldWRect.Top + dy;
    DrawFocusRect(GetDC(0), WRect);
  end;
end;

procedure TFSRVHint1.lnTopMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
     isMoveX, isMoveY : boolean;
     deltaX, deltaY : Integer;
begin
  if (isResizing) then begin
    DrawFocusRect(GetDC(0), WRect);

    isMoveX := WRect.Left <> oldWRect.Left;
    isMoveY := WRect.Top <> oldWRect.Top;

    if (isMoveX) then deltaX := oldWRect.Left - WRect.Left
    else deltaX := WRect.Right - oldWRect.Right;

    if (isMoveY) then deltaY := oldWRect.Top - WRect.Top
    else deltaY := WRect.Bottom - oldWRect.Bottom;

    ResizeDelta(deltaX, deltaY, isMoveX, isMoveY);
  end;
  isResizing := false;
end;

procedure TFSRVHint1.lnLeftTopMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var
     dx, dy : Integer;
begin
  if (isResizing) then begin
    DrawFocusRect(GetDC(0), WRect); //стираем предыдущую рамку
    dx := X - oldPos.x;
    dy := Y - oldPos.y;

    if ((oldWRect.Left + dx > 0 ) and (oldWRect.Right - oldWRect.Left - dx > Constraints.MinWidth))  then
      WRect.Left := oldWRect.Left + dx;
    if ((oldWRect.Top + dy > 0) and (oldWRect.Bottom - oldWRect.Top - dy > Constraints.MinHeight)) then
      WRect.Top := oldWRect.Top + dy;
    DrawFocusRect(GetDC(0), WRect);
  end;
end;

procedure TFSRVHint1.lnLeftMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
     dx : Integer;
begin
  if (isResizing) then begin
    DrawFocusRect(GetDC(0), WRect); //стираем предыдущую рамку
    dx := X - oldPos.x;

    if ((oldWRect.Left + dx > 0 ) and (oldWRect.Right - oldWRect.Left - dx > Constraints.MinWidth)) then
      WRect.Left := oldWRect.Left + dx;
    DrawFocusRect(GetDC(0), WRect);
  end;
end;

procedure TFSRVHint1.lnRightTopMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
var
     dx, dy : Integer;
begin
  if (isResizing) then begin
    DrawFocusRect(GetDC(0), WRect); //стираем предыдущую рамку
    dx := X - oldPos.x;
    dy := Y - oldPos.y;

    if ((oldWRect.Right + dx < Screen.DesktopLeft + Screen.DesktopWidth ) and (oldWRect.Right - oldWRect.Left + dx > Constraints.MinWidth))then
      WRect.Right := oldWRect.Right + dx;
    if ((oldWRect.Top + dy > 0) and (oldWRect.Bottom - oldWRect.Top - dy > Constraints.MinHeight)) then
      WRect.Top := oldWRect.Top + dy;
    DrawFocusRect(GetDC(0), WRect);
  end;
end;

procedure TFSRVHint1.lnRightMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var
     dx : Integer;
begin
  if (isResizing) then begin
    DrawFocusRect(GetDC(0), WRect); //стираем предыдущую рамку
    dx := X - oldPos.x;

    if ((oldWRect.Right + dx < Screen.DesktopLeft + Screen.DesktopWidth ) and (oldWRect.Right - oldWRect.Left + dx > Constraints.MinWidth)) then
      WRect.Right := oldWRect.Right + dx;
    DrawFocusRect(GetDC(0), WRect);
  end;
end;

procedure TFSRVHint1.lnBottomMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var
     dy : Integer;
begin
  if (isResizing) then begin
    DrawFocusRect(GetDC(0), WRect); //стираем предыдущую рамку
    dy := Y - oldPos.y;

    if ((oldWRect.Bottom + dy < Screen.DesktopTop + Screen.DesktopHeight ) and (oldWRect.Bottom - oldWRect.Top + dy > Constraints.MinHeight)) then
      WRect.Bottom := oldWRect.Bottom + dy;
    DrawFocusRect(GetDC(0), WRect);
  end;
end;

procedure TFSRVHint1.lnLeftBottomMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
var
     dx, dy : Integer;
begin
  if (isResizing) then begin
	DrawFocusRect(GetDC(0), WRect); //стираем предыдущую рамку
	dx := X - oldPos.x;
	dy := Y - oldPos.y;

	if ((oldWRect.Left + dx > 0 ) and (oldWRect.Right - oldWRect.Left - dx > Constraints.MinWidth)) then
	  WRect.Left := oldWRect.Left + dx;
	if ((oldWRect.Bottom + dy < Screen.DesktopTop + Screen.DesktopHeight ) and (oldWRect.Bottom - oldWRect.Top + dy > Constraints.MinHeight)) then
	  WRect.Bottom := oldWRect.Bottom + dy;
	 DrawFocusRect(GetDC(0), WRect);
  end;
end;

procedure TFSRVHint1.lnRightBottomMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
var
     dx, dy : Integer;
begin
  if (isResizing) then begin
    DrawFocusRect(GetDC(0), WRect); //стираем предыдущую рамку
    dx := X - oldPos.x;
    dy := Y - oldPos.y;

    if ((oldWRect.Right + dx < Screen.DesktopLeft + Screen.DesktopWidth ) and (oldWRect.Right - oldWRect.Left + dx > Constraints.MinWidth)) then
      WRect.Right := oldWRect.Right + dx;
    if ((oldWRect.Bottom + dy < Screen.DesktopTop + Screen.DesktopHeight ) and (oldWRect.Bottom - oldWRect.Top + dy > Constraints.MinHeight)) then
      WRect.Bottom := oldWRect.Bottom + dy;
    DrawFocusRect(GetDC(0), WRect);
  end;
end;

procedure TFSRVHint1.pnlCaptionMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if (WindowState = wsNormal) and  CanMove then begin
    FormMoved.x := X;
    FormMoved.y := Y;
    StateMoveForm := true;
  end;
end;

procedure TFSRVHint1.pnlCaptionMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
     deltaX, deltaY : Integer;
begin
  if (StateMoveForm) then begin
    if (Screen.Cursor <> crSizeAll) then
        Screen.Cursor := crSizeAll;
      deltaX := (X - FormMoved.x);
    deltaY := (Y - FormMoved.y);
    SetBounds(Left + deltaX, Top + deltaY, Width, Height);
    FormMoved.x := X - deltaX;
    FormMoved.y := Y - deltaY;
  end;
end;

procedure TFSRVHint1.pnlCaptionMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  StateMoveForm := False;
  Screen.Cursor := crDefault;
end;

end.
