☆TabControlのDrag&Drop

TabControlのDrag&Dropのサンプルです。(自コントロール内の処理としています)
TabControlのTabsは、TStringsなので移動はとても簡単です。

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls;

type
  TForm1 = class(TForm)
    TabControl1: TTabControl;
    procedure TabControl1DragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure TabControl1DragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure TabControl1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
  I: Integer;
begin
  // タブ名の設定
  for I := 1 to 10 do
    TabControl1.Tabs.Add(IntToStr(I));
end;

procedure TForm1.TabControl1DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  // ちょっとややこしいですけど、自分自身の間でしか許可しない設定です。 
  Accept := ((Sender is TTabControl) and (Source is TTabControl)) and
    ((Sender as TTabControl) = TabControl1) and 
    (TabControl1.TabIndex <> TabControl1.IndexOfTabAt(X,Y));
end;

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

procedure TForm1.TabControl1DragDrop(Sender, Source: TObject; X, Y: Integer);
var
  DstIndex, SrcIndex: Integer;
begin
  SrcIndex := TabControl1.IndexOfTabAt(X, Y);
  DstIndex := TabControl1.TabIndex;
  TabControl1.Tabs.Move(DstIndex,SrcIndex);
end;

end.

|

☆ListViewのDrag&Drop

ViewStyleがvsReportに設定されたListViewのDrag&Dropの処理です。
ListViewは、Ctrl+左クリックで飛び飛び選択?Shift+左クリックで範囲選択?を行えますね。
ということで次の2点を考慮した処理にしたいと思います。

1.複数選択されたアイテムを扱える。
2.他のListViewへのDrag&Dropができる。(同じアイテムを表示している場合)
  ※自アプリ内に限ります。他アプリではOLE Drag&Drop処理が必要です。

通常DropTargetがnilの場合には、処理させないことが多いんじゃないかと思います。しかし今回は、他のListViewへのDrag&Dropも考慮するので、nilの場合には最後に追加する形で処理させたいと思います。

ListView1DragOver、ListView1DragDropは、ListView1、ListView2共に設定しておいて下さい。

procedure MakeSampleData(ListView: TListView);
var
  Column: TListColumn;
  ListItem: TListItem;
  I: Integer;
  S,S1,S2,S3: String;
begin
  ListView.ViewStyle := vsReport;

  // Columnの設定
  for I := 0 to 2 do
  begin
    Column := ListView.Columns.Add;
    case I of
      0: S := 'name';
      1: S := 'address';
      2: S := 'telephone';
    end;
    Column.Caption := S;
    Column.Width := 100;
  end;

  // ListItemの設定
  for I := 0 to 6 do
  begin
    ListItem := ListView.Items.Add;
    case I of
      0: begin
          S1 := '(1) hiderin';
          S2 := 'kyoto';
          S3 := '075-xxx-xxxx';
         end;
      1: begin
          S1 := '(2) yuki';
          S2 := 'tokyo';
          S3 := '03-xxxx-xxxx';
         end;
      2: begin
          S1 := '(3) picasso';
          S2 := 'barcelona';
          S3 := '932-xxx-xxx';
         end;
      3: begin
          S1 := '(4) momo';
          S2 := 'kobe';
          S3 := '078-xxx-xxxx';
         end;
      4: begin
          S1 := '(5) john';
          S2 := 'newyork';
          S3 := '212-xxx-xxxx';
         end;
      5: begin
          S1 := '(6) taro';
          S2 := 'fukuoka';
          S3 := '092-xxx-xxxx';
         end;
      6: begin
          S1 := '(7) jun';
          S2 := 'sapporo';
          S3 := '011-xxx-xxxx';
         end;
    end;

    ListItem.Caption := S1;
    ListItem.SubItems.Add(S2);
    ListItem.SubItems.Add(S3);
  end;
  ListView.DragMode := dmAutomatic;
  ListView.MultiSelect := True;
  
  // ドラッグ中のイメージをさせない---なんか中途半端で嫌なので(^^;
  ListView.ControlStyle := ListView.ControlStyle - [csDisplayDragImage];
end;



procedure TForm1.FormCreate(Sender: TObject);
begin
  // アイテムを作成します。
  MakeSampleData(ListView1);
  MakeSampleData(ListView2);
end;

procedure TForm1.ListView1DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  Accept := True;
end;

procedure TForm1.ListView1DragDrop(Sender, Source: TObject; X, Y: Integer);
var
  I: Integer;
begin
  for I := 0 to (Source as TListView).SelCount -1 do
  begin
    if ((Sender as TListView).DropTarget = nil) then
      // 追加
      (Sender as TListView).Items.Add.Assign((Source as TListView).Selected)
    else
      // 挿入
      (Sender as TListView).Items.Insert(
        (Sender as TListView).DropTarget.Index).Assign(
        (Source as TListView).Selected);

    (Source as TListView).Selected.Delete;
  end;
end;


Drag&Drop時に隠れているアイテムをスクロール表示させるには、TreeViewで行った方法がそのまま使えます。 ぜひ実装してより実用的なものにして下さい。

参考
☆TreeViewのDrag&Drop

|

☆DBGridでのBeginDrag

DBGridのOnMouseDownは、セルのある場所では動きません。OnMouserDownでの処理を行いたい場合には、通常コンポーネントにしてMouseDownをoverrideし、そこで処理をさせています。 ただ、Drag開始のためだけにコンポーネントを作るのも面倒なので、何か方法がないかいろいろと試し、次のようにOnMouseMoveを使えばうまくいきました。
// BDEでTableにDEMOSのanimals.dbfを設定して試しました。
// Memo1とTable1-DataSource1-DBGrid1を配置しています。

var
  FieldIndex: Integer;

procedure TForm1.DBGrid1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  Cell: TGridCoord;
begin
  // BeginDrag
  if (csLButtonDown in DBGrid1.ControlState) then
  begin
    Cell := DBGrid1.MouseCoord(X, Y);
    FieldIndex := Cell.X - 1;
    DBGrid1.BeginDrag(False);
  end;
end;
Memo1のDrag&Dropの設定を行います。
procedure TForm1.Memo1DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  Accept := True;
end;


procedure TForm1.Memo1DragDrop(Sender, Source: TObject; X, Y: Integer);
begin
  Memo1.Lines.Add(Table1.Fields[FieldIndex].AsString);
end;
一番簡単なのは、DragModeをdmAutomaticにすることですが、常にDrag&Drop処理だけで使うわけではないので除外ですね。

※Delphi Users' Forumへコメントしたものです(^^;

|

☆TreeViewのDrag&Drop

TreeView Drag drop delphi・・・このキーワードでここに来られる方がおられます。以前に .NET(Windowsフォームアプリケーション)での処理を書いていますので、それが該当するんでしょうね。
でもおそらくWIN32での処理をお探しだと思いますので、その処理を書きたいと思います。

簡単に説明すると「TreeView1.OnDragDropで Node の Selected、DropTarget、MoveTo を使って処理するだけです。」と書いてしまえばいいんでしょうが、せっかくなので縮小ノードの展開及び非表示部分のスクロール処理、並びにターゲットの選択部分によるノードの移動処理を含めたサンプルにしたいと思います。

でもTreeViewは奥深いので、Node.DataやOnChange等が原因で様々な問題が起こります。又、DragModeをdmAutomaticで使うとクリックしたかっただけなのに、ノード移動させてしまったという問題も比較的よく起こります。くれぐれもご注意を(笑)

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ImgList, ExtCtrls;

type
  TForm1 = class(TForm)
    TreeView1: TTreeView;
    ImageList1: TImageList;
    Timer1: TTimer;
    Timer2: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure TreeView1DragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure TreeView1DragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure TreeView1EndDrag(Sender, Target: TObject; X, Y: Integer);
    procedure Timer1Timer(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}


//テスト用アイコン作成
procedure MakeTestIcon(ImageList: TImageList);
var
  Bitmap: TBitmap;
begin
  Bitmap := TBitmap.Create;
  try
    Bitmap.Height := 16;
    Bitmap.Width := 16;
    Bitmap.Canvas.Brush.Color := clRed;
    Bitmap.Canvas.FillRect(Rect(2,2,14,14));
    ImageList.Add(Bitmap,nil);
    Bitmap.Canvas.Brush.Color := clBlue;
    Bitmap.Canvas.FillRect(Rect(2,2,14,14));
    ImageList.Add(Bitmap,nil);
  finally
    Bitmap.Free;
  end;
end;

// 初期設定いろいろ
procedure TForm1.FormCreate(Sender: TObject);
const
  FileName = 'data.txt';
var
  Node: TTreeNode;
  Path: String;
begin
  // 展開用タイマー設定
  Timer1.Enabled := False;
  Timer1.Interval := 1500;

  // スクロール用タイマー設定
  Timer2.Enabled := False;
  Timer2.Interval := 50;

  // アイコンの作成
  MakeTestIcon(ImageList1);

  // TreeView1の設定
  TreeView1.Images := ImageList1;
  TreeView1.ReadOnly := True;
  TreeView1.DragMode := dmAutomatic;
  TreeView1.Height := 150;

  // データの読み込み
  Path := ExtractFilePath(Application.ExeName);
  TreeView1.LoadFromFile(Path + FileName);

  Node := TreeView1.Items.GetFirstNode;
  repeat
    Node.ImageIndex := 1;
    Node.StateIndex := 2;
    Node := Node.GetNext;
  until Node = nil;

  // スクロールの際、ごみが出るから(^^;
  TreeView1.ControlStyle := TreeView1.ControlStyle - [csDisplayDragImage];
end;

var
  ScrollBarCommand: Integer;

procedure TForm1.TreeView1DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);

  function IsSelfOrMyChild(dtNode, slNode: TTreeNode): Boolean;
  begin
    Result := False;
    while (dtNode <> nil) do
    begin
      if (slNode = dtNode) then
      begin
        Result := True;
        Exit;
      end;
      dtNode := dtNode.Parent;
    end;
  end;

const
  Offset = 20;
var
  slNode, dtNode: TTreeNode;
begin
  slNode := TreeView1.Selected;
  dtNode := TreeView1.DropTarget;

  Accept := ((Sender as TTreeView) = (Source as TTreeView)) and
            (not IsSelfOrMyChild(dtNode, slNode));

  if not Accept then Exit;
  
  // ノードを展開させます。
  if (dtNode <> nil) then
  begin
    if Timer1.Enabled and (Timer1.Tag <> dtNode.AbsoluteIndex) then
      Timer1.Enabled := False;
    if (not dtNode.Expanded) and dtNode.HasChildren then
    begin
      Timer1.Tag := dtNode.AbsoluteIndex;
      Timer1.Enabled := True;
    end;
  end;

  // 表示されていない部分をスクロールさせます。
  if (Y < Offset) or (Y >= TreeView1.ClientHeight - Offset) then
    begin
      if (Y < Offset) then
        ScrollBarCommand := SB_LINEUP
      else
        ScrollBarCommand := SB_LINEDOWN;
      Timer2.Enabled := True;
    end
  else
    begin
      ScrollBarCommand := -1;
      Timer2.Enabled := False;
    end;
end;

procedure TForm1.TreeView1DragDrop(Sender, Source: TObject; X, Y: Integer);
var
  srcNode, dstNode: TTreeNode;
  HT: THitTests;
begin
  // Explorer等は、ファイル名でソートされていますが、
  // ソートではなく意図したノードの順番に移動させたい場合があります。
  // そのような時に私のアプリでは、
  // アイコンで挿入移動、文字列で子追加移動という仕様にしています。
  // これって結構便利だと思うんですけど、あまり採用されてないみたい。

  srcNode :=TreeView1.Selected;           // 選択ノード
  dstNode := TreeView1.DropTarget;        // ドロップターゲットノード

  HT := TreeView1.GetHitTestInfoAt(X, Y);
  if (htOnIcon in HT) then
    srcNode.MoveTo(dstNode, naInsert)     // アイコンを選択している場合
  else
    srcNode.MoveTo(dstNode, naAddChild);  // 項目を選択している場合
end;

procedure TForm1.TreeView1EndDrag(Sender, Target: TObject; X, Y: Integer);
begin
  ScrollBarCommand := -1;
  Timer1.Enabled := False;
  Timer2.Enabled := False;
end;

// 閉じているノードを展開させます。
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  TreeView1.Items[Timer1.Tag].Expanded := True;
  Timer1.Enabled := False;
end;

// スクロールさせます。
procedure TForm1.Timer2Timer(Sender: TObject);
begin
  if (ScrollBarCommand > -1) then
    SendMessage(TreeView1.Handle, WM_VSCROLL, ScrollBarCommand, 0);
end;

end.

プログラムと同じフォルダに、下記の内容を書き込んだテキストファイルを作成して下さい。
ファイル名は、data.txtです。
node-01
	node-02
	node-03
		node-04
		node-05
node-06
	node-07
		node-08
node-09
	node-10
node-11
node-12
node-13
node-14
	node-15
node-16
node-17
node-18
node-19
node-20
node-21
	node-22
node-23

|