lazarus-ccr/components/jvcllaz/run/JvCtrls/jvmovablebevel.pas

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvMovableBevel.PAS, released on 2002-07-03.

The Initial Developer of the Original Code is John Kozikopulos [Stdreamer att Excite dott com]
Portions created by John Kozikopulos are Copyright (C) 2002 John Kozikopulos.
All Rights Reserved.

Contributor(s):

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.delphi-jedi.org

Known Issues:
-----------------------------------------------------------------------------}
// $Id$

unit JvMovableBevel;

{$mode objfpc}{$H+}

interface

uses
  SysUtils, Classes, Controls, Forms, ExtCtrls;

type
  TJvBevelScrollTextDirection = (tdNone, tdUpToDown, tdDownToUp, tdLeftToRight,
    tdRightToLeft, tdTopLeftToBottomRight, tdTopRightToBottomLeft,
    tdBottomLeftToTopRight, tdBottomRightToTopLeft);

  TJvMovableBevel = class(TBevel) //TJvExBevel)
  private
    FStartX: Integer;
    FStartY: Integer;
    FStartPoint: TPoint;
    FMinSize: Integer;
    FMoving: Boolean; // If True then we are moving the object around.
    FSizing: Boolean; // if True then we are sizing the object;
    FDirection: TJvBevelScrollTextDirection;
    FBorderSize: Byte;
    FOnMoving: TNotifyEvent;
    FOnMoved: TNotifyEvent;
    FOnSizing: TNotifyEvent;
    FOnSized: TNotifyEvent;
  protected
    procedure DoMove(Shift: TShiftState; DeltaX, DeltaY: Integer);
    procedure DoSize(Shift: TShiftState; DeltaX, DeltaY: Integer);
    procedure SelectCursor(X, Y: Integer);
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseEnter; override;
    procedure MouseLeave; override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property BorderSize: Byte read FBorderSize write FBorderSize default 4;
    property OnMoving: TNotifyEvent read FOnMoving write FOnMoving;
    property OnSizing: TNotifyEvent read FOnSizing write FOnSizing;
    property OnMoved: TNotifyEvent read FOnMoved write FOnMoved;
    property OnSized: TNotifyEvent read FOnSized write FOnSized;
  end;

  TJvMovablePanel = class(TPanel)
  private
    FStartX: Integer;
    FStartY: Integer;
    FStartPoint: TPoint;
    FMinSize: Integer;
    FMoving: Boolean; // If True then we are moving the object around.
    FSizing: Boolean; // if True then we are sizing the object;
    FDirection: TJvBevelScrollTextDirection;
    FBorderSize: Byte;
    FOnMoving: TNotifyEvent;
    FOnMoved: TNotifyEvent;
    FOnSizing: TNotifyEvent;
    FOnSized: TNotifyEvent;
  protected
    procedure DoMove(Shift: TShiftState; DeltaX, DeltaY: Integer);
    procedure DoSize(Shift: TShiftState; DeltaX, DeltaY: Integer);
    procedure SelectCursor(X, Y: Integer);
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseEnter; override;
    procedure MouseLeave; override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property BorderSize: Byte read FBorderSize write FBorderSize default 4;
    property OnMoving: TNotifyEvent read FOnMoving write FOnMoving;
    property OnSizing: TNotifyEvent read FOnSizing write FOnSizing;
    property OnMoved: TNotifyEvent read FOnMoved write FOnMoved;
    property OnSized: TNotifyEvent read FOnSized write FOnSized;
  end;


implementation


//=== TJvMovableBevel ==========================================================

constructor TJvMovableBevel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Shape := bsFrame;
  Style := bsRaised;
  FBorderSize := 4;
  FMinSize := 8;
end;

procedure TJvMovableBevel.DoMove(Shift: TShiftState; DeltaX, DeltaY: Integer);
begin
  // Must work on it in order to make expand and shrink the way coreldraw does when
  // shift and ctrl keys are pressed.

  {  If ssCtrl in shift then
     begin
      if Abs(FStartPoint.X - Left) < Abs(FStartPoint.Y - Top) then
      begin
         Top := Top + DeltaY;
         Left:=FStartX;
      end;
      if Abs(FStartPoint.X - Left) > Abs(FStartPoint.Y - Top) then
      begin
        Left := Left + DeltaX;
        Top := FStartY;
      end;
      if Abs(FStartPoint.X - Left) = Abs(FStartPoint.Y - Top) then
      begin
        Top := Top + DeltaY;
        Left := Left + DeltaX;
      end
    end
    else
    begin }
  Top := Top + DeltaY;
  Left := Left + DeltaX;
  //  end
end;

procedure TJvMovableBevel.DoSize(Shift: TShiftState; DeltaX, DeltaY: Integer);
begin
  case FDirection of
    tdUpToDown:
      begin
        Height := Height + DeltaY;
        Top := Top - DeltaY;
      end;
    tdDownToUp:
        Height := FStartY - DeltaY;
    tdLeftToRight:
      begin
        Width := Width + DeltaX;
        Left := Left - DeltaX;
      end;
    tdRightToLeft:
        Width := FStartX - DeltaX;
    tdTopLeftToBottomRight:
      begin
        Top := Top - DeltaY;
        Left := Left - DeltaX;
        Height := Height + DeltaY;
        Width := Width + DeltaX;
      end;
    tdTopRightToBottomLeft:
      begin
        Height := Height + DeltaY;
        Width := FStartX - DeltaX;
        Top := Top - DeltaY;
      end;
    tdBottomLeftToTopRight:
      begin
        Left := Left - DeltaX;
        Height := FStartY - DeltaY;
        Width := Width + DeltaX;
      end;
    tdBottomRightToTopLeft:
      begin
        Height := FStartY - DeltaY;
        Width := FStartX - DeltaX;
      end;
  end;
end;

procedure TJvMovableBevel.SelectCursor(X, Y: longint);
begin
  if (Y > 0) and (Y <= FBorderSize) then
  begin
    if (X > 0) and (X <= FBorderSize) then
    begin
      Screen.Cursor := crSizeNWSE;
      FDirection := tdTopLeftToBottomRight;
    end
    else
    if (X >= Width - FBorderSize) and (X < Width) then
    begin
      Screen.Cursor := crSizeNESW;
      FDirection := tdTopRightToBottomLeft;
    end
    else
    begin
      Screen.Cursor := crSizeNS;
      FDirection := tdUpToDown;
    end;
  end
  else
  if (Y >= Height - FBorderSize) and (Y < Height) then
  begin
    if (X > 0) and (X <= FBorderSize) then
    begin
      Screen.Cursor := crSizeNESW;
      FDirection := tdBottomLeftToTopRight;
    end
    else
    if (X >= Width - FBorderSize) and (X < Width) then
    begin
      Screen.Cursor := crSizeNWSE;
      FDirection := tdBottomRightToTopLeft;
    end
    else
    begin
      Screen.Cursor := crSizeNS;
      FDirection := tdDownToUp;
    end;
  end
  else
  if (X >= 1) and (X <= FBorderSize) then
  begin
    Screen.Cursor := crSizeWE;
    FDirection := tdLeftToRight;
  end
  else
  if (X >= Width - FBorderSize) and (X < Width) then
  begin
    Screen.Cursor := crSizeWE;
    FDirection := tdRightToLeft;
  end
  else
  begin
    Screen.Cursor := crDefault;
    FDirection := tdNone;
  end
end;

procedure TJvMovableBevel.MouseMove(Shift: TShiftState; X, Y: Integer);
//const
//  WM_MOVE = $0003;
begin
  if FMoving then
    DoMove(Shift, X - FStartX, Y - FStartY)
  else
  if FSizing then
    DoSize(Shift, FStartX - X, FStartY - Y)
  else
    SelectCursor(X, Y);
  inherited MouseMove(Shift, X, Y);
end;

procedure TJvMovableBevel.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  if FDirection > tdNone then
  begin
    FSizing := True;
    if Assigned(FOnSizing) then
      FOnSizing(Self);
  end
  else
  begin
    FMoving := True;
    if Assigned(FOnMoving) then
      FOnMoving(Self);
  end;
  FStartPoint := Point(Left, Top);
  FStartX := X;
  FStartY := Y;
  inherited MouseDown(Button, Shift, X, Y);
end;

procedure TJvMovableBevel.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
  SelectCursor(X, Y);
  FStartX := 0;
  FStartY := 0;
  if Height < 0 then
  begin
    Top := Top + Height;
    Height := Abs(Height);
  end;
  if Width < 0 then
  begin
    Left := Left + Width;
    Width := Abs(Width);
  end;
  inherited MouseUp(Button, Shift, X, Y);
  if FMoving and Assigned(FOnMoved) then
    FOnMoved(Self);
  if FSizing and Assigned(FOnSized) then
    FOnSized(Self);
  FMoving := False;
  FSizing := False;
end;


//Procedure TJvMovableBevel.SelectCursor(X, Y: Longint);
//begin
//  if Y in [0..FBorderSize] then
//  begin
//    If X in [0..FBorderSize] then
//    begin
//      Screen.Cursor:= crsizenwse;
//      FDirection := tdTopLeftToBottomRight;
//    end
//    else
//      if X in [Width-FBorderSize..Width] then
//      begin
//        Screen.Cursor := crsizenesw;
//        FDirection := tdTopRightToBottomLeft;
//      end
//      else
//      begin
//        Screen.Cursor := crsizens;
//        FDirection := tdUpToDown;
//      end;
//  end
//  else
//    if Y in [Height-FBorderSize..Height] then
//    begin
//      If X in [0..FBorderSize] then
//      begin
//        Screen.Cursor:= crsizenesw;
//        FDirection := tdBottomLeftToTopRight;
//      end
//      else
//        if X in [Width-FBorderSize..Width] then
//        begin
//          Screen.Cursor := crsizenwse;
//          FDirection := tdBottomRightToTopLeft;
//        end
//        else
//        begin
//          Screen.Cursor := crSizeNS;
//          FDirection := tdDownToUp;
//        end;
//  end
//  else
//    if (X in [1..FBorderSize]) then
//    begin
//      Screen.Cursor := crsizeWE;
//      FDirection := tdLeftToRight;
//    end
//    else
//      if  (X in [Width-FBorderSize..Width]) then
//      begin
//        Screen.Cursor := crsizeWE;
//        FDirection := tdRightToLeft;
//      end
//      else
//      begin
//        Screen.Cursor := crdefault;
//        FDirection := tdNone;
//      end
//end;{}

procedure TJvMovableBevel.MouseEnter;
var
  Pos: TPoint;
begin
  if csDesigning in ComponentState then
    Exit;
  Pos := ScreenToClient(Mouse.CursorPos);
  SelectCursor(Pos.X, Pos.Y);
  inherited MouseEnter;
end;

procedure TJvMovableBevel.MouseLeave;
begin
  if csDesigning in ComponentState then
    Exit;
  if (not FMoving) and (not FSizing) then
  begin
    Screen.Cursor := crDefault;
    FDirection := tdNone;
  end;
  inherited MouseLeave;
end;


//=== TJvMovablePanel ==========================================================

constructor TJvMovablePanel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FBorderSize := 4;
  FMinSize := 8;
end;

procedure TJvMovablePanel.DoMove(Shift: TShiftState; DeltaX, DeltaY: Integer);
begin
  Top := Top + DeltaY;
  Left := Left + DeltaX;
end;

procedure TJvMovablePanel.DoSize(Shift: TShiftState; DeltaX, DeltaY: Integer);
begin
  case FDirection of
    tdUpToDown:
      begin
        Height := Height + DeltaY;
        Top := Top - DeltaY;
      end;
    tdDownToUp:
        Height := FStartY - DeltaY;
    tdLeftToRight:
      begin
        Width := Width + DeltaX;
        Left := Left - DeltaX;
      end;
    tdRightToLeft:
        Width := FStartX - DeltaX;
    tdTopLeftToBottomRight:
      begin
        Top := Top - DeltaY;
        Left := Left - DeltaX;
        Height := Height + DeltaY;
        Width := Width + DeltaX;
      end;
    tdTopRightToBottomLeft:
      begin
        Height := Height + DeltaY;
        Width := FStartX - DeltaX;
        Top := Top - DeltaY;
      end;
    tdBottomLeftToTopRight:
      begin
        Left := Left - DeltaX;
        Height := FStartY - DeltaY;
        Width := Width + DeltaX;
      end;
    tdBottomRightToTopLeft:
      begin
        Height := FStartY - DeltaY;
        Width := FStartX - DeltaX;
      end;
  end;
end;

procedure TJvMovablePanel.SelectCursor(X, Y: longint);
begin
  if (Y > 0) and (Y <= FBorderSize) then
  begin
    if (X > 0) and (X <= FBorderSize) then
    begin
      Screen.Cursor := crSizeNWSE;
      FDirection := tdTopLeftToBottomRight;
    end
    else
    if (X >= Width - FBorderSize) and (X < Width) then
    begin
      Screen.Cursor := crSizeNESW;
      FDirection := tdTopRightToBottomLeft;
    end
    else
    begin
      Screen.Cursor := crSizeNS;
      FDirection := tdUpToDown;
    end;
  end
  else
  if (Y >= Height - FBorderSize) and (Y < Height) then
  begin
    if (X > 0) and (X <= FBorderSize) then
    begin
      Screen.Cursor := crSizeNESW;
      FDirection := tdBottomLeftToTopRight;
    end
    else
    if (X >= Width - FBorderSize) and (X < Width) then
    begin
      Screen.Cursor := crSizeNWSE;
      FDirection := tdBottomRightToTopLeft;
    end
    else
    begin
      Screen.Cursor := crSizeNS;
      FDirection := tdDownToUp;
    end;
  end
  else
  if (X >= 1) and (X <= FBorderSize) then
  begin
    Screen.Cursor := crSizeWE;
    FDirection := tdLeftToRight;
  end
  else
  if (X >= Width - FBorderSize) and (X < Width) then
  begin
    Screen.Cursor := crSizeWE;
    FDirection := tdRightToLeft;
  end
  else
  begin
    Screen.Cursor := crDefault;
    FDirection := tdNone;
  end
end;

procedure TJvMovablePanel.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  if FMoving then
    DoMove(Shift, X - FStartX, Y - FStartY)
  else
  if FSizing then
    DoSize(Shift, FStartX - X, FStartY - Y)
  else
    SelectCursor(X, Y);
  inherited MouseMove(Shift, X, Y);
end;

procedure TJvMovablePanel.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  if FDirection > tdNone then
  begin
    FSizing := True;
    if Assigned(FOnSizing) then
      FOnSizing(Self);
  end
  else
  begin
    FMoving := True;
    if Assigned(FOnMoving) then
      FOnMoving(Self);
  end;
  FStartPoint := Point(Left, Top);
  FStartX := X;
  FStartY := Y;
  inherited MouseDown(Button, Shift, X, Y);
end;


procedure TJvMovablePanel.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
  SelectCursor(X, Y);
  FStartX := 0;
  FStartY := 0;
  if Height < 0 then
  begin
    Top := Top + Height;
    Height := Abs(Height);
  end;
  if Width < 0 then
  begin
    Left := Left + Width;
    Width := Abs(Width);
  end;
  inherited MouseUp(Button, Shift, X, Y);
  if FMoving and Assigned(FOnMoved) then
    FOnMoved(Self);
  if FSizing and Assigned(FOnSized) then
    FOnSized(Self);
  FMoving := False;
  FSizing := False;
end;

procedure TJvMovablePanel.MouseEnter;
var
  Pos: TPoint;
begin
  if csDesigning in ComponentState then
    Exit;
  Pos := ScreenToClient(Mouse.CursorPos);
  SelectCursor(Pos.X, Pos.Y);
  inherited MouseEnter;
end;

procedure TJvMovablePanel.MouseLeave;
begin
  if csDesigning in ComponentState then
    Exit;
  if (not FMoving) and (not FSizing) then
  begin
    Screen.Cursor := crDefault;
    FDirection := tdNone;
  end;
  inherited MouseLeave;
end;

end.