StringGridで固定セルをクリックするには (ID：28765)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

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

俺用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.

←解決時は質問者本人がここをチェックしてください。

戻る