// included by controls.pp {****************************************************************************** TDragObject ****************************************************************************** ***************************************************************************** * * * This file is part of the Lazarus Component Library (LCL) * * * * See the file COPYING.LCL, included in this distribution, * * for details about the copyright. * * * * 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. * * * ***************************************************************************** } { TDragObject } procedure TDragObject.Assign(Source: TDragObject); begin FDragTarget := Source.FDragTarget; FDragHandle := Source.FDragHandle; FDragPos := Source.FDragPos; FDragTargetPos := Source.FDragTargetPos; FMouseDeltaX := Source.FMouseDeltaX; FMouseDeltaY := Source.FMouseDeltaY; end; function TDragObject.Capture: HWND; begin // ToDo Result:=0; end; procedure TDragObject.Finished(Target: TObject; X, Y: Integer; Accepted: Boolean); begin end; function TDragObject.GetName: string; begin Result := ClassName; end; procedure TDragObject.ReleaseCapture(Handle: HWND); begin end; procedure TDragObject.MouseMsg(var Msg: TLMessage); var P: TPoint; begin Assert(False, 'Trace:******************8'); Assert(False, 'Trace:DRAGOBJECT.MOUSEMSG'); Assert(False, 'Trace:******************8'); try case Msg.Msg of LM_MOUSEMOVE: begin P := SmallPointToPoint(TLMMouse(Msg).Pos); ClientToScreen(DragCapture, P); DragTo(P); end; LM_LBUTTONUP, LM_RBUTTONUP: begin Assert(False, 'Trace:******************'); Assert(False, 'Trace:******************'); DragDone(True); Assert(False, 'Trace:******************'); Assert(False, 'Trace:******************'); end; CN_KEYUP: Begin if Msg.WParam = VK_CONTROL then DragTo(DragObject.DragPos); end; CN_KEYDOWN: begin case Msg.WParam of VK_CONTROL: begin DragTo(DragObject.DragPos); end; VK_ESCAPE: begin Msg.Result := 1; DragDone(False); end; end; end; end; except if DragControl <> nil then DragDone(False); raise; end; end; function TDragObject.GetDragImages: TDragImageList; begin Result := nil; end; function TDragObject.GetDragCursor(Accepted: Boolean; X, Y: Integer): TCursor; begin if Accepted then Result := crDrag else Result := crNoDrop; end; procedure TDragObject.HideDragImage; begin // do nothing end; function TDragObject.Instance: THandle; begin // ToDo Result:=0; end; procedure TDragObject.ShowDragImage; begin // do nothing end; { TDragControlObject } function TDragControlObject.GetDragCursor(Accepted: Boolean; X, Y: Integer ): TCursor; begin Result:=inherited GetDragCursor(Accepted, X, Y); end; function TDragControlObject.GetDragImages: TDragImageList; begin Result:=inherited GetDragImages; end; procedure TDragControlObject.HideDragImage; begin inherited HideDragImage; end; procedure TDragControlObject.ShowDragImage; begin inherited ShowDragImage; end; { TDragDockObject } procedure TDragDockObject.SetBrush(Value: TBrush); begin end; procedure TDragDockObject.AdjustDockRect(ARect: TRect); begin end; procedure TDragDockObject.DrawDragDockImage; begin end; procedure TDragDockObject.EndDrag(Target: TObject; X, Y: Integer); begin inherited EndDrag(Target, X, Y); end; procedure TDragDockObject.EraseDragDockImage; begin end; function TDragDockObject.GetDragCursor(Accepted: Boolean; X, Y: Integer ): TCursor; begin Result:=inherited GetDragCursor(Accepted, X, Y); end; function TDragDockObject.GetFrameWidth: Integer; begin Result:=4; end; constructor TDragDockObject.Create(AControl: TControl); begin inherited Create(AControl); end; destructor TDragDockObject.Destroy; begin inherited Destroy; end; procedure TDragDockObject.Assign(Source: TDragObject); begin inherited Assign(Source); end; // included by controls.pp