Implement autoscroll for a TScrollbox when dragging

Problem/Question/Abstract:

I have a form with a TScrollBox on it. At runtime I dynamically add any number of a custom control I created. These controls need to interact via Drag and Drop, however, when I drag from one control and move to the edge of the TScrollBox it doesn't automatically scroll to reveal the additional controls.

Answer:

Add a handler to the forms OnDragOver event so you get aware when the user drags the mouse outside the scrollbox. You can the start a timer that fires scroll messages at the scrollbox to get it to move. In the example below all edits are on the scrollbox and share the edit drag handlers. The timer is set to 100 msecs and initially disabled.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Buttons, ComCtrls, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    ScrollBox1: TScrollBox;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Edit5: TEdit;
    Edit6: TEdit;
    Edit7: TEdit;
    Edit8: TEdit;
    Edit9: TEdit;
    Edit10: TEdit;
    Edit11: TEdit;
    Edit12: TEdit;
    Edit13: TEdit;
    Label1: TLabel;
    Timer1: TTimer;
    procedure Edit1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState;
      var Accept: Boolean);
    procedure Edit1DragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure Timer1Timer(Sender: TObject);
    procedure FormDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState;
      var Accept: Boolean);
  private
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Edit1DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  Accept := Source is TEdit and (Sender <> Source);
end;

procedure TForm1.Edit1DragDrop(Sender, Source: TObject; X, Y: Integer);
begin
  (Sender as TEdit).SelText := (Source as TEdit).Text;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  pt: TPoint;
begin
  {figure out where the mouse is}
  GetCursorPos(pt);
  pt := ScreenToClient(pt);
  with scrollbox1.boundsrect, pt do
    if (x > left) and (x < right) then
    begin
      if y < top then
        scrollbox1.perform(WM_VSCROLL, SB_LINEUP, 0)
      else if y > bottom then
        scrollbox1.perform(WM_VSCROLL, SB_LINEDOWN, 0)
      else
        timer1.enabled := false;
    end
    else
      timer1.enabled := false;
end;

procedure TForm1.FormDragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  accept := false;
  if State = dsDragLeave then
    timer1.enabled := false
  else if (source is TEdit) then
  begin
    {Figure if mouse is above or below the scrollbox, that determines
    whether we enable the scroll timer.}
    with scrollbox1.boundsrect do
      timer1.enabled := (x > left) and (x < right) and ((y < top) or (y > bottom));
  end;
end;

end.