☆TStringGridのDrag&Drop: Delphi-fan

☆TStringGridのDrag&Drop

行単位でDrag&Dropにより、データを入れ替えることを前提としたサンプルです。行番号部分をクリックすると列選択となり、列の選択には、CtrlキーやShiftキーと左クリックによる選択やマウスのスライドによる範囲選択ができます。実際に使えるものにするには、まだまだ作りこまないといけませんが、まあ、そのあたりはサンプルということで(^^;

Stringgrid_2

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    StringGrid1: TStringGrid;
    procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure StringGrid1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure StringGrid1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure StringGrid1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure StringGrid1DragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure StringGrid1DragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
  private
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

const
  Flag = 1;

var
  CurrRow, FocusRow: Integer;
  Sliding: Boolean;

procedure TForm1.FormCreate(Sender: TObject);
var
  I,J: Integer;
begin
  StringGrid1.DefaultDrawing := False;
  StringGrid1.Align := alClient;
  StringGrid1.RowCount := 50;

  // とりあえずサンプルデータ
  for I := 1 to StringGrid1.RowCount -1 do
    for J := 1 to StringGrid1.ColCount -1 do
      StringGrid1.Cells[J,I] := 'ITEM'+IntToStr(I*J) ;
end;

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
  DRect: TRect;
  Mode: Integer;
begin
  DRect := Rect;
  InflateRect(DRect, -2, -2);   

  { 描画位置の設定・・・適当に }
  if ACol = 1 then        //右寄せ
    Mode := DT_RIGHT
  else if ACol = 2 then   //左寄せ
    Mode := DT_LEFT
  else
    Mode := DT_CENTER;    //中央

  { 固定行が選択されている場合の表示 }
  if Integer(StringGrid1.Objects[ACol,ARow]) = Flag then
  begin
    StringGrid1.Canvas.Brush.Color := clGray;
    StringGrid1.Canvas.FillRect(Rect);
    DrawEdge(StringGrid1.Canvas.Handle, Rect, BDR_SUNKENINNER, BF_BOTTOMRIGHT);
    DrawEdge(StringGrid1.Canvas.Handle, Rect, BDR_SUNKENINNER, BF_TOPLEFT);
    DrawText(StringGrid1.Canvas.Handle, PChar(IntToStr(ARow)),
      Length(IntToStr(ARow)), DRect, Mode);
    Exit;
  end;

  { 固定行の標準描画 }
  if (ACol = 0) and (ARow > 0) then
  begin
    StringGrid1.Canvas.Brush.Color := clBtnFace;
    StringGrid1.Canvas.FillRect(Rect);
    DrawEdge(StringGrid1.Canvas.Handle, Rect,BDR_RAISEDINNER, BF_BOTTOMRIGHT);
    DrawEdge(StringGrid1.Canvas.Handle, Rect,BDR_RAISEDINNER, BF_TOPLEFT);
    DrawText(StringGrid1.Canvas.Handle, PChar(IntToStr(ARow)),
      Length(IntToStr(ARow)), DRect, DT_CENTER);
    Exit;
  end;

  { 固定列の標準描画 }
  if (ARow = 0) then
  begin
    StringGrid1.Canvas.Brush.Color := clBtnFace;
    StringGrid1.Canvas.FillRect(Rect);
    DrawEdge(StringGrid1.Canvas.Handle, Rect,BDR_RAISEDINNER, BF_BOTTOMRIGHT);
    DrawEdge(StringGrid1.Canvas.Handle, Rect,BDR_RAISEDINNER, BF_TOPLEFT);

    if (ACol > 0) then
      DrawText(StringGrid1.Canvas.Handle, PChar(IntToStr(ACol)),
        Length(IntToStr(ACol)), DRect, DT_CENTER);
    Exit;
  end;

  { 行選択、セル選択の背景色の設定 }
  if (goRowSelect in StringGrid1.Options) and
     (Integer(StringGrid1.Objects[0,ARow]) = Flag) then
    StringGrid1.Canvas.Brush.Color := clAqua
  else
    StringGrid1.Canvas.Brush.Color := clWindow;

  StringGrid1.Canvas.FillRect(Rect);

  DrawText(StringGrid1.Canvas.Handle, PChar(StringGrid1.Cells[ACol,ARow]),
    Length(StringGrid1.Cells[ACol,ARow]), DRect, Mode);

  if (not (goRowSelect in StringGrid1.Options)) and (gdFocused in State) then
    StringGrid1.Canvas.DrawFocusRect(Rect);
end;

procedure TForm1.StringGrid1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

  procedure FlagClear;
  var
    I: Integer;
  begin
    for I := 0 to StringGrid1.Cols[0].Count - 1 do
      StringGrid1.Cols[0].Objects[I] := nil;
  end;

var
  I, ACol, ARow: Integer;
begin
  if (Button = mbRight) then Exit;

  { マウスの座標から現在のセル位置を取得します。 }
  StringGrid1.MouseToCell(X, Y, ACol, ARow);

  if (ACol <= 0) and (ARow <= 0) then Exit;

  { ０列目をクリックされた場合の処理 }
  if (ACol = 0) then
  begin
    {０列で１行目以上の場合にはDragを許可します。}
    if StringGrid1.Objects[0,ARow] = TObject(Flag) then
    begin
      StringGrid1.Row := ARow;
      StringGrid1.BeginDrag(True);
      Exit;
    end;

    { 行選択の処理 }
    CurrRow := Arow;
    Sliding := True;
    StringGrid1.Options := StringGrid1.Options + [goRowSelect];

    // CtrlキーかShiftキーが押されていない場合には、Flagを消去します。
    if (not (ssCtrl in Shift)) and (not (ssShift in Shift)) then
      FlagClear;

    if (ssCtrl in Shift) then
      StringGrid1.Objects[0, ARow] := TObject(Flag)
    else if (ssShift in Shift) then
    begin
      FlagClear;
      // 選択範囲にFlagを設定します。
      if (FocusRow < ARow) then
      begin
        for I := FocusRow to ARow do
          StringGrid1.Objects[0, I] := TObject(Flag);
      end
      else
      begin
        for I := FocusRow downto ARow do
         StringGrid1.Objects[0, I] := TObject(Flag);
      end
    end
    else
      StringGrid1.Objects[0,ARow] := TObject(Flag);

    { カーソルを現在の列に移動させます。 }
    StringGrid1.Row := ARow;
    FocusRow := ARow;
    StringGrid1.Invalidate;
  end
  else
  begin
    { ０列目以外の処理 }
    FlagClear;
    if ARow <> 0 then
      StringGrid1.Objects[0, ARow] := TObject(Flag);
    StringGrid1.Options := StringGrid1.Options - [goRowSelect];
    FocusRow := ARow;
  end;
end;

procedure TForm1.StringGrid1MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var
  ACol, ARow: Integer;
begin
  {マウスの座標から現在のセル位置を取得します。}
  StringGrid1.MouseToCell(X, Y, ACol, ARow);
  if (ACol <= 0) and (ARow <= 0) then Exit;

  if Sliding and (ARow <> CurrRow)then
  begin
   if Integer(StringGrid1.Objects[0,ARow]) = Flag then
     StringGrid1.Objects[0,ARow] := nil
   else
     StringGrid1.Objects[0,ARow] := TObject(Flag);

   StringGrid1.Invalidate;
   CurrRow := Arow;
  end;    
end;

procedure TForm1.StringGrid1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Sliding := False;
end;

procedure TForm1.StringGrid1DragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
var
  ACol, ARow: Integer;
begin
  if (Source is TStringGrid) then
    (Sender as TStringGrid).MouseToCell(X, Y, ACol, ARow);
    
  Accept := ((Sender is TStringGrid) and (Source is TStringGrid)) and
            ((Sender as TStringGrid) = (Source as TStringGrid)) and
            (ARow > 0);
end;

procedure TForm1.StringGrid1DragDrop(Sender, Source: TObject; X,
  Y: Integer);
var
   I, DestRow, ACol: Integer;
   SL: TStringList;
   Temp: TList;
begin
  Temp := TList.Create;
  try
    {挿入位置をマウス座標から取得します。}
    StringGrid1.MouseToCell(X, Y, ACol, DestRow);

    {DestRowまで選択行以外のものを保存します。}
    for I := 0 to DestRow -1 do
    begin
      if StringGrid1.Objects[0,I] <> TObject(Flag) then
      begin
        SL := TStringList.Create;
        SL.Assign(StringGrid1.Rows[I]);
        Temp.Add(SL);
      end;
    end;

    {選択行を保存します。}
    for I := 0 to StringGrid1.RowCount -1 do
    begin
      if StringGrid1.Objects[0,I] = TObject(Flag) then
      begin
        SL := TStringList.Create;
        SL.Assign(StringGrid1.Rows[I]);
        Temp.Add(SL);
      end;
    end;

    {DestRow以上で選択行以外を保存します。}
    for I := DestRow to StringGrid1.RowCount -1 do
    begin
      if StringGrid1.Objects[0,I] <> TObject(Flag) then
      begin
        SL := TStringList.Create;
        SL.Assign(StringGrid1.Rows[I]);
        Temp.Add(SL);
      end;
    end;

    {StringGrid1に設定します。}
    for I := 0 to Temp.Count -1 do
      StringGrid1.Rows[I].Assign(TStringList(Temp[I]));
  finally
    for I := 0 to Temp.Count -1 do
      TStringList(Temp[I]).Free;
    Temp.Free;
  end;
end;

end.

2008.01.04 TStringGrid | 固定リンク
Tweet

最近の記事

バックナンバー

お気に入り

AFsoft World
AFSoftさんのブログです。ホームページの方では、CADに必要な数学の解説からDelphiによる具体的な実装まで、豊富なサンプルと共に詳しく解説されています。又、JWW用の便利なソフトをたくさん公開しておられます。
Delphi Library [Mr.XRAY]
Excelの操作を始め、Delphiでのいろいろな処理を丁寧にわかりやすくまとめられておられます。又、Halbow資料館として、メーリングリストでもご活躍されたHalbowさんによるホームページ(Win32 API by Object Pascal of Delphi)を公開されておられます。
Embarcadero Blogs - Team Japan
Embarcaderoの日本人スタッフによるブログです。
Embarcadero日本語トップページ
ＤＥＫＯのアヤシいお部屋。
Unicodeに関する詳細な解説を始め「Delphi によるテクニック＆アルゴリズム」には、様々な情報が見やすくまとめられています。

@niftyが提供する
無料ブログはココログ！