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

名前

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

本文

こんにちは。
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;

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

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

戻る