項目のD&D移動時の移動位置表示 （TabControl／PageControl）

今回は TabControl／PageControl のD&Dでのタブ移動の処理です。

余りよろしくない方法な気もしますが。まずは、TabControlでもPageControlでも同じイベント処理が使えるように、またPageControlでタブの移動が出来るようにTCustomTabControlに対するヘルパークラスを作成。これでTCustomTabControlのTabsとTabIndexに対するアクセスを確保します。

  TTabsAccessHelper = class helper for TCustomTabControl
  private
    function GetActiveTabIndex: Integer;
    function GetTabItems: TStrings;
    procedure SetActiveTabIndex(const Value: Integer);
    procedure SetTabItems(const Value: TStrings);
  public
    property ActiveTabIndex: Integer read GetActiveTabIndex write SetActiveTabIndex;
    property TabItems: TStrings read GetTabItems write SetTabItems;
  end;

{ TTabsAccessHelper }

function TTabsAccessHelper.GetActiveTabIndex: Integer;
begin
  Result := TabIndex;
end;

function TTabsAccessHelper.GetTabItems: TStrings;
begin
  Result := Tabs;
end;

procedure TTabsAccessHelper.SetActiveTabIndex(const Value: Integer);
begin
  TabIndex := Value;
end;

procedure TTabsAccessHelper.SetTabItems(const Value: TStrings);
begin
  Tabs := Value;
end;

前回と同じく、OnStartDrag、OnDragOver、OnDragDrop、OnMouseDownを実装します。
FPrevIdxはフォーム変数です。

procedure TForm1.StartDrag(Sender: TObject; var DragObject:
    TDragObject);
begin
  FPrevIdx := -1;
end;

procedure TForm1.MouseDown(Sender: TObject; Button: TMouseButton;
    Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
    (Sender As TControl).BeginDrag(False, 5);
end;

procedure TForm1.PageControl1DragDrop(Sender, Source: TObject; X, Y: Integer);
var
  CurIndex: Integer;
  NewIndex: Integer;

  TabControl: TTabControl;
  PageControl: TPageControl;
begin
  if Sender is TPageControl then
  begin
    PageControl := Sender as TPageControl;
    NewIndex := PageControl.IndexOfTabAt(X,Y);
    CurIndex := PageControl.ActivePageIndex;
    PageControl.Pages[CurIndex].PageIndex := NewIndex;
  end else if Sender is TTabControl then
  begin
    TabControl := Sender as TTabControl;
    NewIndex := TabControl.IndexOfTabAt(X,Y);
    CurIndex := TabControl.ActiveTabIndex;

    TabControl.Tabs.Move(CurIndex, NewIndex);
    TabControl.TabIndex := NewIndex;
  end;

  FPrevIdx := -1;
end;

procedure TForm1.PageControl1DragOver(Sender, Source: TObject; X, Y: Integer;
    State: TDragState; var Accept: Boolean);
var
  TargetIdx: Integer;
  CurIndex: Integer;
  tabRect: TRect;

  TabControl: TCustomTabControl;
begin
  TabControl := Sender as TCustomTabControl;
  TargetIdx := TabControl.IndexOfTabAt(X, Y);
  CurIndex := TabControl.ActiveTabIndex;
  // 移動先と現在のインデックスが同じ場合はドロップ不可
  Accept := (Sender = Source) And (TargetIdx <> CurIndex);

  TabControl.Canvas.Pen.Color := clRed;
  TabControl.Canvas.Pen.Mode := pmXor;
  TabControl.Canvas.Pen.Style := psSolid;
  TabControl.Canvas.Pen.Width := 5;

  if Accept then
  begin
    if FPrevIdx > -1 then
    begin
      tabRect := TabControl.TabRect(FPrevIdx);

      if FPrevIdx > CurIndex then
      begin
        TabControl.Canvas.MoveTo(tabRect.Right, tabRect.Top);
        TabControl.Canvas.LineTo(tabRect.Right, tabRect.Bottom);
      end else begin
        TabControl.Canvas.MoveTo(tabRect.Left, tabRect.Top);
        TabControl.Canvas.LineTo(tabRect.Left, tabRect.Bottom);
      end;
    end;

    if TargetIdx > -1 then
    begin
      tabRect := TabControl.TabRect(TargetIdx);

      if (TargetIdx >= TabControl.ActiveTabIndex) then
      begin
        TabControl.Canvas.MoveTo(tabRect.Right, tabRect.Top);
        TabControl.Canvas.LineTo(tabRect.Right, tabRect.Bottom);
      end else begin
        TabControl.Canvas.MoveTo(tabRect.Left, tabRect.Top);
        TabControl.Canvas.LineTo(tabRect.Left, tabRect.Bottom);
      end;
      FPrevIdx := TargetIdx;
    end;
  end;
end;

追記

PageControlは、TabSheetの方がついてきませんね。PageControlの方は使えません。orz

追記２

OnDragDropを修正しました。TTabsAccessHelperのTabItemsは不要になりました。PageControlの移動も大丈夫になりました。