//Tehty demo5, tehtävä 7 mukainen lisäys metodiin
//TRaahaava.ObjMouseUp. Lisäyksenä siis ehto (parw is TPanel)
//jonka täyttyminen vaaditaan, ennenkuin objektin siirto
//hyväksytään

unit raahattava;
{
  Olio, joka on tehty raahaamaan muita olioita paikasta toiseen.
  Vesa Lappalainen 17.01.1998
  Muutoksia:
  7.10.1999/vl
   + oma tappaminen viestillä WM_CLOSE Delphi 5:sta varten
  3.9.2001/vl
   + VCL/CLX-kääntäminen (määrittele vakio CLX)

  Liikuttaa olion olion nykyisestä paikasta hiiren liikkeiden
  mukaan.
  Saadaan tapahtuma jokaisesta liikahduksesta (OnMove) sekä perille
  saapumisesta (OnArrive).

  Jos irtipäästöpaikalla on kontrolli, jossa on OnDragGdrop-tapahtuman
  käsittelijä, niin tätä kutsutaan Arrive-tapahtuman jälkeen.
  Jos joko Arrive tai OnDragDrop muuttaa olion Parenttia, niin
  raahattava ei enää koske olioon.  Jos olion Parenttia ei muuteta,
  laittaa raahattava olion parentiksi sen WinControllin, jonka päälle
  olio pudotettiin, tai jos WinControllia ei löydy, niin olio palautetaan
  alkuperäiseen paikkaansa ja alkuperäinen Parent asetetaan takaisin.

  Arrrive-tapahtuman parametrit:
    TRaahaavaMeth = procedure (o,wnd:TControl;data:integer) of object;
      o      - olio, joka saapui raahattavan mukana
      wnd    - kontrolli, jonka päälle raahattiin
      data   - vapaamuotoinen kutsussa annettu data

  Käyttöä helpottamaan on tehty kolme funktiota, jotka luovat raahattavan
  olio, siirtävät siirrettävän olion raahattavan sisälle ja ilmoittavat
  lopuksi kun siirto on valmis.

   function Raahaa(OWhat : TControl; arrive:TRaahaavaMeth;
                  data:integer) : boolean;
   function RaahaaXY(OWhat : TControl; x,y:integer; arrive:TRaahaavaMeth;
                  data:integer) : boolean;
   function RaahaaPt(OWhat : TControl; dp:TPoint; arrive:TRaahaavaMeth;
                  data:integer) : boolean;
  Parametrit:
    OWhat    - siirrettävä olio
    f        - ikkuna jonka sisällä siirto tehdään
    ToPt     - raahattavan sisällä, yleensä tähän kannattaa laittaa
               MouseDown-tapahtumasta saatu hiiren paikka
    arrive   - metodi, joka käsittelee valmiin siirron
    data     - vapaasti käytettävä sana, joka saadaan käyttöön siirron loputtua

}

interface

uses
  SysUtils, Classes,
{$ifdef CLX}
  Qt,              QGraphics, QControls, QForms, QDialogs,QExtCtrls,
{$else}
  Messages,Windows,Graphics,   Controls,  Forms,  Dialogs, ExtCtrls,
{$endif}
  Types;

type
  TRaahaavaMeth = procedure (o,wnd:TControl;data:integer) of object;
  TRaahaavaMoveMeth = procedure (o:TControl;pt:TPoint;data:integer) of object;

  TDragControl = class(TControl)  // Hämäystä jotta saadaan OnMouse??? käyttöön
  published
  end;

  TRaahaava = class(TWinControl)
  private
    FOnArrive : TRaahaavaMeth;
    FOnMove   : TRaahaavaMoveMeth;
    FObject   : TDragControl;
    FDp       : TPoint;
    FFrom     : TPoint;
    FData     : Integer;
    FOrigo    : TPoint;

    FOldMove  : TMouseMoveEvent;
    FOldUp    : TMouseEvent;
    FOldParent: TWinControl;
    FMoving   : Boolean;
    FAreaOver : TDragControl;

    FAutoDestroy : boolean;
    procedure ObjMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure ObjMouseUp(Sender: TObject; Button: TMouseButton;
              Shift: TShiftState; X, Y: Integer);
    procedure PaintBox1Paint(Sender: TObject);
    procedure CreateDot;
  protected
  public
    constructor Create(AOwner:TComponent);                  override;
    destructor  Destroy;                                    override;
    function KuljetaPt(OWhat : TControl; f:TWinControl;ToPt:TPoint;
                       data : integer) : boolean; virtual;
    function Kuljeta(OWhat : TControl; dp:TPoint; data:integer):boolean; virtual;
    function Moving : boolean;                              virtual;
{$ifdef CLX}
{$else}
//    procedure PaintWindow(DC: HDC); override;
    procedure WmClose(var Message: TWMClose); message WM_CLOSE;
{$endif}
  published
    property OnArrive : TRaahaavaMeth read FOnArrive write FOnArrive;
    property OnMove   : TRaahaavaMoveMeth read FOnMove write FOnMove;
  end;



function Raahaa(OWhat : TControl; arrive:TRaahaavaMeth;
               data:integer) : boolean;
function RaahaaXY(OWhat : TControl; x,y:integer; arrive:TRaahaavaMeth;
               data:integer) : boolean;
function RaahaaPt(OWhat : TControl; dp:TPoint; arrive:TRaahaavaMeth;
               data:integer) : boolean;

procedure Register;

implementation

constructor TRaahaava.Create(AOwner:TComponent);
begin
  inherited;
//  BevelInner := bvNone;
//  BevelOuter := bvNone;
//  ParentColor := true;
  FAutoDestroy := false;
  FOnMove := nil;
  FOnArrive := nil;
  FOrigo.x := 0; FOrigo.y := 0;
//  ControlStyle := ControlStyle + [csCaptureMouse];
end;

destructor  TRaahaava.Destroy;
begin
  inherited;
end;

function TRaahaava.Moving : boolean;
begin
  Result := FMoving;
end;


procedure TRaahaava.ObjMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  SetBounds(x - FDp.x,y - Fdp.y,Width,Height);
  if ( sender <> FObject ) then exit;
//  Left := Left + x - FDp.x;
//  Top :=  Top  + y - Fdp.y;
end;

function FindControlAtPos(w:TWinControl;const Pos: TPoint;
                         AllowDisabled: Boolean; nc:TControl): TControl;
var
  I: Integer;
  P: TPoint;
begin
  with w do
    for I := ControlCount - 1 downto 0 do
    begin
      Result := Controls[I];
      if ( Result <> nc ) then with Result do
      begin
        P := Point(Pos.X - Left, Pos.Y - Top);
        if PtInRect(ClientRect, P) and
          ((csDesigning in ComponentState) and (Visible or
          not (csNoDesignVisible in ControlStyle)) or
          (Visible and (Enabled or AllowDisabled)
{$ifdef CLX}
{$else}
  and  (Perform(CM_HITTEST, 0, Longint(PointToSmallPoint(P))) <> 0)
{$endif}
          )) then
          Exit;
      end;
    end;
  Result := nil;
end;

procedure TRaahaava.ObjMouseUp(Sender: TObject; Button: TMouseButton;
                    Shift: TShiftState; X, Y: Integer);
var wnd,ctl : TControl; dwnd : TDragControl;
    parw : TWinControl;
    dpt,pt : TPoint;
begin
//  FObject.Parent := nil;
  FAreaOver.OnMouseMove := FOldMove;
  FAreaOver.OnMouseUp := FOldUp;

  SetCaptureControl(nil);

  pt := Parent.ScreenToClient(ClientToScreen(FOrigo));
  inc(pt.x,x); inc(pt.y,y);

  pt.x := X; pt.y := y;
  dpt := pt;

  wnd := FindControlAtPos(Parent,pt,true,self);
  ctl := wnd;
  parw := nil;
  while ( ctl is TWinControl ) do begin
    wnd  := ctl;
    parw := ctl as TWinControl;
    pt := parw.ScreenToClient(FAreaOver.ClientToScreen(dpt));
    ctl  := FindControlAtPos(parw,pt,true,self);
  end;

  if ( ctl <> nil ) then wnd := ctl;

  if ( Assigned(FOnArrive) ) then OnArrive(FObject,wnd,FData);

  if ( wnd <> nil ) then begin
    dwnd := TDragControl(wnd);
    if ( assigned(dwnd.OnDragDrop) ) then
      dwnd.OnDragDrop(wnd,FObject,pt.x,pt.y);
  end;

  if FObject.Parent = self then // Jos vastuuta ei ole otettu
    if (parw <> nil) and (parw is TPanel) then begin // Jos löytyi uusi, joka kelpaa vanhemmaksi
      pt := parw.ScreenToClient(ClientToScreen(FOrigo));
      FObject.Parent := parw;
      FObject.Left   := pt.x;
      FObject.Top    := pt.y;
    end
    else begin               // Muuten alkuperäinen paikka ja isäntä
      FObject.Parent := FOldParent;
      FObject.Left   := FFrom.x;
      FObject.Top    := FFrom.y;
    end;

{$ifdef CLX}
  if ( FAutoDestroy ) then QApplication_postEvent(Application.Handle, QCustomEvent_create(QEventType_CMRelease, Self));
{$else}
  if ( FAutoDestroy ) then PostMessage(Handle,WM_CLOSE,0,0);
{$endif}
end;

procedure TRaahaava.PaintBox1Paint(Sender: TObject);
begin
  (Sender as TPaintBox).Canvas.Brush.Color := clRed;
  (Sender as TPaintBox).Canvas.Ellipse(0,0,4,4);
end;

procedure TRaahaava.CreateDot;
var t: TPaintBox;
begin
  t := TPaintBox.Create(self);
  t.Parent := self;
  t.OnPaint := PaintBox1Paint;
  t.BringToFront;
  t.Width := 20;
  t.Height := 20;
//  t.Align := alClient;
end;

function TRaahaava.KuljetaPt(OWhat : TControl; f:TWinControl;ToPt:TPoint;
                             data : integer) : boolean;
var pt : TPoint;
begin
  Result := false;
  if ( OWhat = nil ) then exit;
  FAreaOver := TDragControl(f);

  FObject := TDragControl(OWhat);
  if ( Moving ) then exit;
  FDp := ToPt;
  Parent := f;
  Visible := true;
  Color := FObject.Color;
  FData := data;

  FOldMove   := FAreaOver.OnMouseMove;
  FOldUp     := FAreaOver.OnMouseUp;
  FAreaOver.OnMouseMove := ObjMouseMove;
  FAreaOver.OnMouseUp   := ObjMouseUp;

  FFrom.x   := FObject.Left; FFrom.y := FObject.Top;
  FOldParent := FObject.Parent;
//  FObject.OnMouseMove := ObjMouseMove;
//  FObject.OnMouseUp := ObjMouseUp;
  pt := Parent.ScreenToClient(FObject.ClientToScreen(FOrigo));
  FObject.Parent := self;
  FObject.Top := 0;
  FObject.Left := 0;
  FMoving := true;
  Width := FObject.Width;
  Height := FObject.Height;
  Left := pt.x;
  Top := pt.y;

//  OnMouseMove := ObjMouseMove;
//  OnMouseUp := ObjMouseUp;
//  FObject.Visible := false;
//  if ( OWhat is TWinControl ) then
//    ReleaseCapture //((OWhat as TWinControl).Handle);
//  Mouse.Capture := TControl(Owner);
//  SetCaptureControl(TControl(Self));

  CreateDot;
  SetCaptureControl(FAreaOver);

//  SetCaptureControl(FObject);
end;

function TRaahaava.Kuljeta(OWhat : TControl; dp:TPoint; data : integer) : boolean;
var p : TObject; f:TForm; pt:TPoint;
begin
  Result := false;
  if ( OWhat = nil ) then exit;
  if ( Moving ) then exit;
  p := OWhat;
  while ( p<> nil ) and (not ( p is TForm )) do
    p := (p as TControl).Parent;
  if ( p = nil ) then exit;
  f := p as TForm;

  pt := f.ScreenToClient(OWhat.ClientToScreen(FOrigo));

  Result := KuljetaPt(OWhat,f,dp,data)
end;

function InitRaahaava(var l:TRaahaava;f:TComponent;
                      arrive:TRaahaavaMeth) : boolean;
begin
  Result := false;
  l := TRaahaava.Create(f);
  if ( l = nil ) then exit;
  l.Visible := false;
  l.FAutoDestroy := true;
  l.OnArrive := arrive;
  Result := true;
end;


function RaahaaPt(OWhat : TControl; dp:TPoint; arrive:TRaahaavaMeth;
               data:integer) : boolean;
var Raahaava : TRaahaava;
begin
  Result := false;
  if ( OWhat = nil ) then exit;
  if not InitRaahaava(Raahaava,OWhat.Owner,arrive) then exit;
  Result := Raahaava.Kuljeta(OWhat,dp,data);
end;

function RaahaaXY(OWhat : TControl; x,y:integer; arrive:TRaahaavaMeth;
               data:integer) : boolean;
begin
  Result := RaahaaPt(OWhat,Point(x,y),arrive,data);
end;

function Raahaa(OWhat : TControl; arrive:TRaahaavaMeth;
               data:integer) : boolean;
begin
  Result := RaahaaXY(OWhat,0,0,arrive,data);
end;

procedure Register;
begin
  RegisterComponents('GKO', [TRaahaava]);
end;

(* KYLIX
procedure TRaahaava.PaintWindow(DC: HDC);
begin
  //
end;
*)

{$ifdef CLX}
{$else}
procedure TRaahaava.WmClose(var Message: TWMClose);
begin
  Free;
end;
{$endif}

end.