dsListBox (part 1)

{
This list box can handle items reorder with drag and drop. OnReorder event
occurs when drag and drop is complete, telling us from which to which
position item was dragged. When item is dragged visual inication of a new
position is drawn.
}


{
TdsListBox11 (drag drop reorder)

Let's start with a new project, save it into desired folder and declare some
vital things for our list box.
}

type
  TOnReorderEvent = procedure(Sender: TObject; const FromPos, ToPos: Integer) of object;

  TdsListBox1 = class(TListBox)
  private
    FDragDropReorder: Boolean;

    FOnReorder: TOnReorderEvent;
  protected
    procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); override;
  public
    constructor Create(AOwner: TComponent); override;

    procedure DragDrop(Source: TObject; X, Y: Integer); override;
  published
    property DragDropReorder: Boolean read FDragDropReorder write FDragDropReorder;
    property OnReorder: TOnReorderEvent read FOnReorder write FOnReorder;
  end;

{
Ancestor for our TdsListBox1 will be TListBox.

First of all, we declare our own even TOnReorderEvent. We will need this
for OnReorder event.

In the class declaration we declare FDragDropReorder which will tell us,
if dragging of items is allowed or not. We declare FOnReorder event as well.

Constructor is one thing I almost always override. This project is no exception.
}

constructor TdsListBox1.Create(AOwner: TComponent);
begin
  inherited;
  FDragDropReorder := true;
  DragMode := dmAutomatic;
end;

{
Classes have default behavior regarding classes's variables. All pointers
are set to nil, booleans are set to false, integers to 0,... As our list box
will primary be used when drag and drop is needed, we will set FDragDropReorder
to true in the constructor.
DragMode should be set to dmAutomatic. You can set it to dmManual, but then you
must do some additional things.

To implement drag and drop, you must first find the right method to override.
I did this by playing arround with drag and drop. You should be able to do that
by yourself. Read some help and you will soon understand the basics of drag
and drop. When that is clear to you, go to the VCL source and see, where
OnDragDrop and OnDragOver are called from. Soon you will find procedures
DragDrop and DragOver, which are virtual. That means we can override them.
Great, let's do that.
}

procedure TdsListBox1.DragOver(Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
var
  newpos: Integer;
begin
  inherited;

  if FDragDropReorder then
  begin
    Accept := (Self = Source);

    if not Accept then Exit;

    newpos := ItemAtPos(Point(X,Y), true);

    Accept := newpos <> ItemIndex;
  end;
end;

{
First of all, call inherited. Then check if Source is list box itself.
Source is object from which dragging started. If that is the case, we can
allow drop, so set Accept to true. Well, there are two more things to check.
If item is over itself, droping has no point, so we will not accept it.
You can get the position where item would drop with ItemAtPos.
}

procedure TdsListBox1.DragDrop(Source: TObject; X, Y: Integer);
var
  newpos: Integer;
begin
  inherited;

  if FDragDropReorder then
  begin
    if (Source = Self) then
    begin
      newpos := ItemAtPos(Point(X,Y), true);
      Items.Move(ItemIndex, newpos);

      if Assigned(FOnReorder) then FOnReorder(Self, ItemIndex, newpos + 1);

      ItemIndex := newpos;
    end;
  end;
end;

{
Here we check FDragDropReorder and Source = Self. If so, we can move item
to the new position. At the end we call OnReorder event if assigned and
select item which was moved.

Now we want to see where the item will drop. For this, declare:

procedure DrawBox(Anewpos: Integer);

And the code is:
}

procedure TdsListBox1.DrawBox(Anewpos: Integer);
var
  R: TRect;

  PenMode: TPenMode;
  PenWidth: Integer;
begin
  PenWidth := Canvas.Pen.Width;
  PenMode := Canvas.Pen.Mode;
  try
    Canvas.Pen.Mode := pmNot;

    if Anewpos <> - 1 then
    begin
      R := ItemRect(Anewpos);
      Canvas.DrawFocusRect(R);
    end;

  finally
    Canvas.Pen.Width := PenWidth;
    Canvas.Pen.Mode := PenMode;
  end;
end;

{
First remember pen mode and width, because we will change them. Then simply
get rect of an item with ItemRect function, draw focus rect, and at the end
set pen mode and width back to original value. Now you should place DrawBox
calls to the correct place. Correct these two procedures to:
}

procedure TdsListBox1.DragOver(Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
var
  newpos: Integer;
begin
  inherited;

  if FDragDropReorder then
  begin
    Accept := (Self = Source);

    if not Accept then Exit;

    newpos := ItemAtPos(Point(X,Y), true);

    Accept := newpos <> ItemIndex;

    DrawBox(newpos);
  end;
end;

procedure TdsListBox1.DragDrop(Source: TObject; X, Y: Integer);
var
  newpos: Integer;
begin
  inherited;

  if FDragDropReorder then
  begin
    if (Source = Self) then
    begin
      newpos := ItemAtPos(Point(X,Y), true);
      Items.Move(ItemIndex, newpos);

      if Assigned(FOnReorder) then FOnReorder(Self, ItemIndex, newpos + 1);

      ItemIndex := newpos;

      DrawBox(newpos);
    end;
  end;
end;

{
This code already does something, but sometimes doesn't erase rectangle.
That's not ok. Obviously we must somehow remember the old place, so we can
erase the rectangle correctly. Declare oldpos variable in the private section
of our class.

Oldpos: Integer;

In the constructor, set it to - 1:

Oldpos := -1;

Correct DrawBox to:
}

procedure TdsListBox1.DrawBox(Anewpos: Integer);
var
  R: TRect;

  PenMode: TPenMode;
  PenWidth: Integer;
begin
  if Anewpos <> Oldpos then
  begin
    PenWidth := Canvas.Pen.Width;
    PenMode := Canvas.Pen.Mode;
    try
      Canvas.Pen.Mode := pmNot;

      if Oldpos <> - 1 then
      begin
        R := ItemRect(OldPos);
        Canvas.DrawFocusRect(R);
      end;

      if Anewpos <> - 1 then
      begin
        R := ItemRect(Anewpos);
        Canvas.DrawFocusRect(R);
      end;

      OldPos := Anewpos;

    finally
      Canvas.Pen.Width := PenWidth;
      Canvas.Pen.Mode := PenMode;
    end;
  end;
end;

{
Obviously when Oldpos and Anwepos are the same, there is no need to do
any drawing. If they are different though, first clear the old rectangle with

      if Oldpos <> - 1 then
      begin
        R := ItemRect(OldPos);
        Canvas.DrawFocusRect(R);
      end;

and then draw new rectangle with

      if Anewpos <> - 1 then
      begin
        R := ItemRect(Anewpos);
        Canvas.DrawFocusRect(R);
      end;

And at the end remember the position.
One more thing. Set OldPos to -1 every time drag and drop is completed.
}

procedure TdsListBox1.DragDrop(Source: TObject; X, Y: Integer);
var
  newpos: Integer;
begin
  inherited;

  if FDragDropReorder then
  begin
    if (Source = Self) then
    begin
      newpos := ItemAtPos(Point(X,Y), true);
      Items.Move(ItemIndex, newpos);

      if Assigned(FOnReorder) then FOnReorder(Self, ItemIndex, newpos + 1);

      ItemIndex := newpos;

      DrawBox(newpos);
      Oldpos := -1;
    end;
  end;
end;

{
Now you have a list box which can do stuff like Delphi's list box for moving
components for the components palette.

We will do another improvement in one of the upcoming articles, which Delphi
doesn't have. If you move item enough down or up, list box should scroll. 
}