lazarus-ccr/components/lazmapviewer/source/mvdragobj.pas

{
  (c) 2014 ti_dic

  This library is free software; you can redistribute it and/or modify it
  under the terms of the GNU Library General Public License as published by
  the Free Software Foundation; either version 2 of the License, or (at your
  option) any later version.

  This program is distributed in the hope that it will be useful, but WITHOUT
  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
  for more details.

  You should have received a copy of the GNU Library General Public License
  along with this library; if not, write to the Free Software Foundation,
  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
}
unit mvdragobj;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils;

Type
  TDragObj = Class;

  TDragEvent = Procedure (Sender : TDragObj) of Object;

  { TDragObj }

  TDragObj = Class
  private
    FMouseDown : boolean;
    FLnkObj: TObject;
    FDragsrc,FStartSrc : TObject;
    FOfsX: integer;
    FOfsY: integer;
    InDrag : Boolean;
    FStartX,FStartY : integer;
    FMouseX,FMouseY : integer;
    FEndX,FEndY : integer;
    FOnDrag: TDragEvent;
    FOnEndDrag: TDragEvent;

    procedure SetDest(X,Y : Integer);
    procedure SetLnkObj(AValue: TObject);
    procedure SetOnDrag(AValue: TDragEvent);
    procedure SetOnEndDrag(AValue: TDragEvent);

    Procedure DostartDrag(X,Y : Integer);
    Procedure DoDrag(X,Y : integer);
    Procedure DoEndDrag(X,Y : integer);
    Function HasMoved(X,Y : integer) : Boolean;
    Procedure AbortDrag;

    public
      Procedure MouseDown(aDragSrc : TObject;X,Y : integer);
      Procedure MouseUp(X,Y : integer);
      Procedure MouseMove(X,Y : integer);

      property OnDrag : TDragEvent read FOnDrag write SetOnDrag;
      property OnEndDrag : TDragEvent read FOnEndDrag write SetOnEndDrag;



      property OfsX : integer read FOfsX;
      property OfsY : integer read FOfsY;
      property StartX : integer read FStartX;
      property StartY : integer read FStartY;
      property MouseX : Integer read FMouseX;
      property MouseY : integer read FMouseY;
      property EndX : integer read FEndX;
      property EndY : integer read FEndY;
      Property LnkObj : TObject Read FLnkObj write SetLnkObj;
      property DragSrc : TObject Read FStartSrc;
  end;

implementation

{ TDragObj }

procedure TDragObj.SetDest(X, Y: Integer);
begin
  FEndX:=X;
  FEndY:=Y;
  FOfsX:=FEndX-FstartX;
  FOfsY:=FEndY-FstartY;
end;

procedure TDragObj.SetLnkObj(AValue: TObject);
begin
  if FLnkObj=AValue then Exit;
  FreeAndNil(FLnkObj);
  FLnkObj:=AValue;
end;

procedure TDragObj.SetOnDrag(AValue: TDragEvent);
begin
  if FOnDrag=AValue then Exit;
  FOnDrag:=AValue;
end;

procedure TDragObj.SetOnEndDrag(AValue: TDragEvent);
begin
  if FOnEndDrag=AValue then Exit;
  FOnEndDrag:=AValue;
end;

procedure TDragObj.DostartDrag(X, Y: Integer);
begin
   InDrag:=True;
   FStartSrc := FDragSrc;
   DoDrag(X,Y);
end;

procedure TDragObj.DoDrag(X, Y: integer);
begin
  if (X<>FEndX) or (Y<>FEndY) then
  Begin
    SetDest(X,Y);
    if Assigned(FOnDrag) then
      FOnDrag(Self);
  end;
end;

procedure TDragObj.DoEndDrag(X, Y: integer);
begin
  DoDrag(X,Y);
  if Assigned(FOnEndDrag) then
    FOnEndDrag(self);
  FreeAndNil(FLnkObj);
  FStartSrc := nil;
  InDrag:=False;
end;

function TDragObj.HasMoved(X, Y: integer): Boolean;
begin
  Result:=(X<>FStartX) or (Y<>FStartY);
end;

procedure TDragObj.AbortDrag;
begin
  if InDrag then
  Begin
    DoDrag(FstartX,FStartY);
    InDrag:=False;
    FMouseDown:=False;
    FDragSrc :=nil;
    FStartSrc := nil;
    FreeAndNil(FLnkObj);
  end;
end;

procedure TDragObj.MouseDown(aDragSrc : TObject;X, Y: integer);
begin
  if not(FMouseDown) then
  Begin
       FDragSrc := aDragSrc;
       FMouseDown := True;
       FStartX := X;
       FStartY := Y;
       FEndX := X;
       FEndY := Y;
  End
  Else
      AbortDrag;
end;


procedure TDragObj.MouseMove(X, Y: integer);
begin
  FMouseX := X;
  FMouseY := Y;
  if FMouseDown then
  Begin
    if InDrag then
       DoDrag(X,Y)
    else
    Begin
       if HasMoved(X,Y) then
         DoStartDrag(X,Y);
    end;
  end;
end;


procedure TDragObj.MouseUp(X, Y: integer);
begin
  if FMouseDown then
  Begin
    FMouseDown:=False;
    if InDrag then
       DoEndDrag(X,Y);
    FDragSrc := nil;
  end;
end;

end.