movepanel.pas

可移动的Panel。用户可以随意控制自己的Panel。

{---------------------------------------------
            MovePanel Component
            version: 1.0
            date: 2004/12/18
            author: vber
 ---------------------------------------------}

{
  This component will automatically move while mousedown and move.
}

unit MovePanel;

interface
uses
  Classes, Windows, Extctrls, Controls;

type
  TMoveOption = (moBoth, moLeft, moTop);
  TMoveEvent = procedure (Sender: TObject; X, Y: Integer) of Object;
  TMovePanel = class(TPanel)
  private
    FMouseDown: Boolean;
    FCanMove: Boolean;
    FMoveOption: TMoveOption;
    {When moLeft: Moving without changing it's Top value
     When moTop:  Moving without changing it's Left value
    }
    FMoveEvent: TMoveEvent;
    FMoveFinished: TNotifyEvent;
    LastPoint: TPoint;

    procedure DoOnMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
    procedure DoOnMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
    procedure DoOnMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
    procedure DoCanMove(const Value: Boolean);
  published
    property CanMove: Boolean read FCanMove write DoCanMove default True;
    property MoveOption: TMoveOption read FMoveOption write FMoveOption default moBoth;
    property OnMove: TMoveEvent read FMoveEvent write FMoveEvent;
    property OnMoveFinished: TNotifyEvent read FMoveFinished write FMoveFinished;
  public
    constructor Create(AOwner: TComponent);override;
  end;

  procedure Register;
  
implementation

{ TMovePanel }

procedure Register;
begin
  RegisterComponents('vbersoft', [TMovePanel]);
end;

constructor TMovePanel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FCanMove := True;
  FMouseDown := False;
  FMoveOption := moBoth;

  OnMouseMove := DoOnMouseMove;
  OnMouseDown := DoOnMouseDown;
  OnMouseUp:= DoOnMouseUp;
end;

procedure TMovePanel.DoCanMove(const Value: Boolean);
begin
  FCanMove := Value;
  if not Value then FMouseDown := False;
end;

procedure TMovePanel.DoOnMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if not FCanMove then Exit;

  FMouseDown := True;

  GetCursorPos(LastPoint);
end;

procedure TMovePanel.DoOnMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  NowPoint: TPoint;
begin
  if not FMouseDown then Exit;

  GetCursorPos(NowPoint);

  case FMoveOption of
    moLeft:
          Left := Left + NowPoint.X - LastPoint.X;
    moTop:
          Top := Top + NowPoint.Y - LastPoint.Y;
    moBoth:
          begin
            Left := Left + NowPoint.X - LastPoint.X;
            Top := Top + NowPoint.Y - LastPoint.Y;
          end;
  end;

  LastPoint := NowPoint;

  if Assigned(FMoveEvent) then FMoveEvent(Sender, Left, Top);  
end;

procedure TMovePanel.DoOnMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  FMouseDown := False;
  if Assigned(FMoveFinished) then FMoveFinished(Self);
end;

end.