DBGridのPopupMenuで・・・。

Delphi2007で作ったDBGridから派生させた自作コンポーネントをDelphi XE2で動作確認していたところ、セルの編集時、設定したPopupMenuが表示されないことが確認されました。Delphi2007の時は、セル編集時、設定されたPopupMenuが表示されていましたが、Delphi XE2では、デフォルトのものが表示されてしまいます。


次のようなシンプルな構成でDBGridとStringGridにPopupMenuを割り当てて、Delphi2007、Delphi2009、Delphi XE2で試してみました。

[Delphi2007]　
DBGrid、InplaceEditor共割り当てたPopupMenuが表示されています。

[Delphi2009]　
セル編集時、デフォルトのPopupMenuが表示されてしまいます。

[Delphi XE2]　
Delphi2009と同じく、デフォルトのPopupMenuが表示されています。

ということで、この動作は、Delphi2009から変わっていたようです。いつもながらスマートな方法とは言えないんですけど、下記の処理でInplaceEditorにもPopupMenuを割り当てることができました。

type
   TDummyDBG = class(TCustomDBGrid);
   TDummyCG  = class(TCustomGrid);
   TDummyCtl = class(TControl);

procedure TForm1.FormShow(Sender: TObject);
var
  Options1: TDBGridOptions;
  Options2: TGridOptions;
begin
  // DBGridの場合
  Options1 := DBGrid1.Options;
  try
    DBGrid1.Options := DBGrid1.Options + [dgEditing, dgAlwaysShowEditor];
    TDummyDBG(DBGrid1).ShowEditor;
    if Assigned(TDummyDBG(DBGrid1).InplaceEditor) then
      TDummyCtl(TDummyDBG(DBGrid1).InplaceEditor).PopupMenu := DBGrid1.PopupMenu;
  finally
    DBGrid1.Options := Options1;
  end;

  // StringGridの場合
  Options2 := StringGrid1.Options;
  try
    StringGrid1.Options := StringGrid1.Options + [goEditing, goAlwaysShowEditor];
    TDummyCG(StringGrid1).ShowEditor;
    if Assigned(TDummyCG(StringGrid1).InplaceEditor) then
      TDummyCtl(TDummyCG(StringGrid1).InplaceEditor).PopupMenu := StringGrid1.PopupMenu;
  finally
    StringGrid1.Options := Options2;
  end;
end;

☆TStringGridのDrag&Drop

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

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.

☆TStringGridでの縦書き(日本語)

マトリックス表を作るときに、横書きでは、幅が広くなりすぎて見づらいので、 縦書きを試してみました。アルファベット(RENAULT)が反対向いていますが、 今回、処理したかったのは日本語なので良しとしておきます(^^;
（BMWは全角で入力しています）

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    StringGrid1: TStringGrid;
    procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
const
  S1 = ',トヨタ,日産,マツダ,ホンダ,スズキ,スバル,三菱';
  S2 = ',ダイハツ,いすゞ,ＢＭＷ,RENAULT,フォード';
var
  I, J: Integer;
  SL: TStringList;
begin
  // サンプルデータの設定
  SL:= TStringList.Create;
  try
    SL.CommaText := S1+S2;
    J := SL.Count;
    StringGrid1.ColCount := J;
    StringGrid1.Rows[0].Assign(SL);

    StringGrid1.RowCount := 3;
    StringGrid1.FixedCols := 1;
    StringGrid1.FixedRows := 1;
    StringGrid1.RowHeights[0] := 80;
    for I := 0 to J -1 do
      StringGrid1.ColWidths[I] := 25;
  finally
    SL.Free;
  end;
end;

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);

  // 縦書きの描画
  procedure VerticalTextDraw(S: String);
  var
    LF: TLogFont;
    I: Integer;
  begin
    StringGrid1.Canvas.Font.Height := 12;
    StringGrid1.Canvas.Font.Name := '@MS UI Gothic';

    GetObject(StringGrid1.Canvas.Font.Handle,SizeOf(LF), @LF);

    LF.lfEscapement := -900;
    StringGrid1.Canvas.Font.Handle := CreateFontIndirect(LF);
    I := ((Rect.Right - Rect.Left) div 2 + StringGrid1.Canvas.TextWidth('W'));
    StringGrid1.Canvas.TextOut(Rect.Left + I, Rect.Top + 5, S);
  end;

begin
  if (ARow = 0) then
  begin
    StringGrid1.Canvas.FillRect(Rect);
    VerticalTextDraw(StringGrid1.Cells[ACol,ARow]);
  end;
end;

end.