StringGridで固定セルをクリックするには

解決

Fusa URL 2007-11-30 22:12:39 No: 28761

StringGridを使っています。

ListViewのようにStringGridのヘッダ部分をクリックしたいのですが
FixedCellの部分をクリックする処理が
よくわかりません。

上のセルと左のセル
FixedRowとFixedColはそれぞれ1に設定しています。

どのようにすればいいでしょうか？

よろしくお願いします。

Ru 2007-11-30 22:33:13 No: 28762

マウスアップ時の操作で良ければ・・・
参考（http://www2.big.or.jp/~osamu/Delphi/delphi-browse.cgi?index=085820）

procedure TForm1.StringGrid1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
ACol, ARow: Longint;
begin

TStringGrid(Sender).MouseToCell(X, Y, ACol, ARow);

  if ARow = 0 then
  begin
    ShowMessage('列: ' + IntToStr(ACol));
  end;

end;

Ru 2007-11-30 22:38:12 No: 28763

失礼しました。
座標からの転換なのでマウスダウン時でもできそうですね。

sasa 2007-11-30 23:06:10 No: 28764

Girds.pasを少しいじれば…。

TCustomGrid.MouseDown
(中略)
  CellHit := CalcCoordFromPoint(X, Y, DrawInfo);
  ↑この下に以下を記述
===============================================================
    if ((CellHit.X >= 0) and (CellHit.X < FixedCols)) or
       ((CellHit.Y >= 0) and (CellHit.Y < FixedRows)) then
    begin
      Click;
    end;
===============================================================

ofZ 2007-12-01 04:19:58 No: 28765

ボタン的に凹ませたいんだよね？

俺用Gridから抜粋してきた。
つぎはぎコンポーネントからの抜粋なので、変数名に規則性がないのはご愛敬

unit 適当なユニット名;

interface

uses
Windows, Messages, Classes, Controls, Grids;

type
{固定セルがクリックされたときのイベント}
TFixedCellClickEvent = procedure(Sender: TObject; Col, ARow: Longint) of object;

  TXpGrid = class(TStringGrid)
  private
    FMouseDownCol,
    FMouseDownRow: LongInt;  {MouseDownしたセル}
    FBtnDown: Boolean;
  protected
    {固定セルがクリックされたときのイベント}
    FOnFixedCellClick  :TFixedCellClickEvent;
    {固定セルをクリックできるようにするか}
    FFixedCellClick  :Boolean;
  public
    constructor Create(AOwner: TComponent); override;
  protected
    procedure DrawCellBtn(aCol, aRow: Longint;aDown: Boolean);
    procedure MouseDown(Button: TMouseButton;
        Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton;
        Shift: TShiftState; X, Y: Integer); override;
  published
    property FixedCellClick :Boolean read FFixedCellClick write FFixedCellClick;
    property OnFixedCellClick: TFixedCellClickEvent read FOnFixedCellClick write FOnFixedCellClick;
  end;

procedure Register;

implementation

uses
Forms, Graphics;

procedure Register;
  begin
    RegisterComponents('Samples', [TXpGrid]);
  end;

constructor TXpGrid.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FixedCellClick := False;
  FMouseDownCol := -1;
  FMouseDownRow := -1;
end;

procedure TXpGrid.DrawCellBtn(aCol, aRow: Longint; aDown: Boolean);
var
  cellsRect: TRect;
  DC: THandle;
begin
  cellsRect := CellRect(aCol,aRow);
  Canvas.Brush.Color := clBtnFace;
  Canvas.Brush.Style := bsSolid;
  DC := Canvas.Handle;
  if aDown then begin
    DrawEdge(DC, cellsRect, BDR_SUNKENINNER, BF_TOPLEFT);
    DrawEdge(DC, cellsRect, BDR_SUNKENOUTER, BF_BOTTOMRIGHT);
    Dec(cellsRect.Bottom);
    Dec(cellsRect.Right);
    Inc(cellsRect.Top);
    Inc(cellsRect.Left);
    DrawEdge(DC, cellsRect, BDR_SUNKENOUTER, BF_TOPLEFT or BF_MIDDLE);
  end
  else begin
    InvalidateCell(aCol, aRow);
  end;
  Canvas.TextOut(cellsRect.Left + 2, cellsRect.Top + 2, Cells[aCol, aRow]);
end;

procedure TXpGrid.MouseDown(Button:TMouseButton;Shift:TShiftState;X,Y:Integer);
var
  fCol, fRow: Longint;
  hCur: HCURSOR;
begin
  inherited MouseDown(Button,Shift,x,y);
  FMouseDownCol := -1;
  FMouseDownRow := -1;
  FBtnDown := False;
  if Button = mbLeft then begin
    MouseToCell(X, Y, fCol, fRow);
    if FFixedCellClick and
       (((fCol >= 0) and (fCol < FixedCols)) or
  ((fRow >= 0) and (fRow < FixedRows))) then begin
      hCur := GetCursor;
      if (Screen.Cursors[crVSplit] <> hCur) and
   (Screen.Cursors[crHSplit] <> hCur) then begin
  FMouseDownCol := fCol;
  FMouseDownRow := fRow;
  FBtnDown := True;
  DrawCellBtn(FMouseDownCol, FMouseDownRow, True);
      end;
    end;
  end;
end;

procedure TXpGrid.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  mCol,mRow: Longint;
begin
  inherited MouseMove(Shift, X, Y);
  if FBtnDown then begin
    MouseToCell(X, Y, mCol, mRow);
    DrawCellBtn(FMouseDownCol, FMouseDownRow, (mCol = FMouseDownCol) and (mRow = FMouseDownRow));
  end;
end;

procedure TXpGrid.MouseUp(Button:TMouseButton;Shift:TShiftState; X,Y: Integer);
var
  mCol,mRow: Longint;
begin
  inherited MouseUp(Button, Shift, x, y);
  if Button = mbLeft then begin
    if FBtnDown then begin
      MouseToCell(X, Y, mCol, mRow);
      DrawCellBtn(FMouseDownCol, FMouseDownRow, False);
      if Assigned(FOnFixedCellClick) and
   (FMouseDownCol = mCol) and (FMouseDownRow = mRow) then begin
  FOnFixedCellClick(Self, FMouseDownCol, FMouseDownRow);
      end;
    end;
    FMouseDownCol := -1;
    FMouseDownRow := -1;
    FBtnDown := False;
  end;
end;

end.

KHE00221 2007-12-02 00:23:15 No: 28766

Canvas.Brush.Color := clBtnFace;
  Canvas.Brush.Style := bsSolid;
  DC := Canvas.Handle;
  if aDown then begin
    DrawEdge(DC, cellsRect, BDR_SUNKENINNER, BF_TOPLEFT);
    DrawEdge(DC, cellsRect, BDR_SUNKENOUTER, BF_BOTTOMRIGHT);
    Dec(cellsRect.Bottom);
    Dec(cellsRect.Right);
    Inc(cellsRect.Top);
    Inc(cellsRect.Left);
    DrawEdge(DC, cellsRect, BDR_SUNKENOUTER, BF_TOPLEFT or BF_MIDDLE);
  end

ですが

BF_MIDDLE を入れると DrawCell 等で FixedCell に色を付けていても
それを無視して描画してしまうようです。

Canvas.Brush.Color 等も無視されるみたいです
(設定した色で描画されない)

凹んだ様に見せるには

DC := Canvas.Handle;
if aDown then
begin
DrawEdge(DC, cellsRect, BDR_SUNKENINNER, BF_RECT);
end;

のみで十分なようです

また

MouseToCelはTStringGrid 外(左と上のみ)にマウスが移動した際 0 0 を返す様で

で mCol = FMouseDownCol と mRow = FMouseDownRow のみでは

FixedCell を Downした状態でそのまま StringGrid からカーソルが離れると見た目が Downしたままになってしまいます。

条件に X>0 と Y>0 を追加すれば StringGrid からカーソルが離れた場合 FixedCellが凹んだ状態で表示されるようになります

BDS 2006 + XP

えっ？。 2007-12-02 03:10:43 No: 28767

>> Fusa さん

あの、「DelFusa Blog」のDelFusaさんですか？。

Fusa URL 2007-12-02 10:57:57 No: 28768

ええ...まあ....
質問しちゃ、、、いかんかのお、、、

ミ;゜Д゜A``

教えてくださって、ありがとうです。明日、試します。
お返事遅くてごめん。

ofZ 2007-12-03 17:31:20 No: 28769

KHE00221 さん
いろいろツッコミありがとうございます。
まぁ、普段Gridなんて使わないので、手抜き・・・モゴモゴ

そんなわけで、Fusaさんは、KHE00221さんのレスを参考に、いいの作ってください。

お邪魔しました。

Fusa 2007-12-04 19:09:58 No: 28770

こんにちは。
Ruさん、sasaさん、ofZさん、KHE00221さん、とてもありがとうございます。
すごく参考になりました。

>まぁ、普段Gridなんて使わないので、手抜き・・・モゴモゴ

ははは。意外とそういうのありますよね。
私もGridはあんまし使ってなかったみたいでして...
固定セルの描画が、今時XPスタイルでもないのよね。

Delphi-fan さんの所を参考にすれば実現できるのかな。
http://hiderin.air-nifty.com/delphi/2007/10/index.html#entry-21088217

これ調べてて気がついたのですが
D2007からなのかなあ、SpeedButtonは独自でXPまねっこ実装してる。
VCLの改良ってどういう優先度で起こっているのでしょうね。
少し不思議。

とりあえず、以前から、GridのOwnerDraw系はテクニックをまとめてたりしたので

DelFusaBlog StringGrid/DrawGridのOwnerDraw
http://delfusa.blog65.fc2.com/blog-entry-38.html

それに付随する形で、コンポーネント化せずに実装してみました。

コンポーネント化したほうが遙かによかったですが
一応、ソース、のせておきます。
────────────────────
object DrawGrid1: TDrawGrid
  DefaultDrawing = False
  Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goDrawFocusSelected]
  OnDrawCell = DrawGrid1DrawCell
  OnMouseDown = DrawGrid1MouseDown
  OnMouseUp = DrawGrid1MouseUp
end

────────────────────
type
  TForm1 = class(TForm)
    DrawGrid1: TDrawGrid;
    procedure DrawGrid1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure DrawGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure DrawGrid1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
  private
    FMouseDownGridPoint: TPoint;
  public
    { Public declarations }
  end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
FMouseDownGridPoint := Point(-1, -1);
end;

procedure TForm1.DrawGrid1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  ACol, ARow: Longint;
begin
  TDrawGrid(Sender).MouseToCell(X, Y, ACol, ARow);
  FMouseDownGridPoint := Point(ACol, ARow);
  TDrawGrid(Sender).Repaint;
end;

procedure TForm1.DrawGrid1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  ACol, ARow: Longint;
begin
  TDrawGrid(Sender).MouseToCell(X, Y, ACol, ARow);

FMouseDownGridPoint := Point(-1, -1);
TDrawGrid(Sender).Repaint;
end;

procedure TForm1.DrawGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
  PenBuffer: TPen;
  BrushBuffer: TBrush;
  FontBuffer: TFont;
  DC: HDC;
  R: TRect;

  {↓FixedCellの枠を描画する}
  procedure DrawFixedFrame(ARect: TRect; Click: Boolean=False);
  begin
    if (Sender as TDrawGrid).Ctl3D then
    with (Sender as TDrawGrid) do
    begin
      Canvas.Pen.Style := psSolid;
      Canvas.Pen.Mode := pmCopy;
      with ARect do begin
        if Click then
          Canvas.Pen.Color := clBtnShadow
        else
          Canvas.Pen.Color := clBtnHighlight;
        Canvas.MoveTo( Right - 1, Top );
        Canvas.LineTo( Left, Top);
        Canvas.LineTo( Left, Bottom - 1 );
        if Click then
          Canvas.Pen.Color := clBtnHighlight
        else
          Canvas.Pen.Color := clBtnShadow;
        Canvas.LineTo( Right - 1, Bottom - 1 );
        Canvas.LineTo( Right - 1, Top );
      end;
    end;
  end;

  {↓パラメータを一時保存}
  procedure BufferingOn;
  begin
    with Sender as TDrawGrid do
    begin
      PenBuffer.Assign(Canvas.Pen);
      BrushBuffer.Assign(Canvas.Brush);
      FontBuffer.Assign(Canvas.Font);
    end;
  end;

  {↓パラメータを復帰}
  procedure BufferingOff;
  begin
    with Sender as TDrawGrid do
    begin
      Canvas.Pen.Assign(PenBuffer);
      Canvas.Brush.Assign(BrushBuffer);
      Canvas.Font.Assign(FontBuffer);
    end;
  end;

begin
  PenBuffer := TPen.Create;
  BrushBuffer := TBrush.Create;
  FontBuffer := TFont.Create;

  with Sender as TDrawGrid do
  try
    BufferingOn;
    {↓固定セル}
    if gdFixed in State then
    begin

      if (FMouseDownGridPoint.X=ACol)
        and (FMouseDownGridPoint.Y=ARow) then
      begin
        Canvas.Brush.Color := FixedColor;
        Canvas.FillRect(Rect);
        {↑セル内を色で塗りつぶす}
        DrawFixedFrame(Rect, True);
        {↑クリック時の枠を描画}
      end else
      begin
        Canvas.Brush.Color := FixedColor;
        Canvas.FillRect(Rect);
        {↑セル内を色で塗りつぶす}

        DrawFixedFrame(Rect);
        {↑枠を描く}
      end;
    end else

    {↓セレクトセル}
    if gdSelected in State then
    begin
      if (goDrawFocusSelected in Options) then
      begin
        Canvas.Brush.Color := clHighlight;
        Canvas.FillRect(Rect);
      end else
      if ((not (goDrawFocusSelected in Options))
             and (Focused) and (ACol = Col) and (ARow = Row)) then
      begin
        Canvas.Brush.Color := clWindow;
        Canvas.FillRect(Rect);
      end else
      begin
        Canvas.Brush.Color := clHighlight;
        Canvas.FillRect(Rect);
      end;
      {↑セル内を選択色で塗りつぶす}

      Canvas.DrawFocusRect(Rect);
      {↑枠を描く}
    end else

    {↓普通のセル}
    begin
      Canvas.Brush.Color := clWindow;
      Canvas.FillRect(Rect);
    end;

    BufferingOff;
  finally
    PenBuffer.Free;
    BrushBuffer.Free;
    FontBuffer.Free;
  end;
end;

────────────────────

Fusa 2007-12-06 09:54:13 No: 28771

ちょっと修正して
Tipsとしてまとめておきました。

Delphi Technic - DelFusa Floor
http://delfusa.main.jp/delfusafloor/technic/technic_f.html

えっ？。 2007-12-14 03:11:11 No: 28772

解決？！。未解決？！。

フ〜ン .. そうなんだ。

Fusa 2007-12-14 09:44:38 No: 28773

おっと、完全に忘却してました。どもっありがとう！