Search code examples
delphidelphi-10.2-tokyo

Delphi 10 TDrawGrid - How do I get rows to refresh properly?

Using Delphi 10.2 Tokyo.

I use a DrawCell method to have all columns in a row the same color as the selected cell. This allows me to let user click in different cells but still show a "selected" row.

This uses the OnSelectCell method to invalidate the original row and newly selected row. Been using this method for years.

If I have a grid that has a horizontal scrollbar the grid does not draw properly when scrolled to the right and the user clicks in a cell.

Here is a simple example using a TDrawGrid with an OnDrawCell event and an OnSelectCell event:

The Form (DFM) code:

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 299
  ClientWidth = 635
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object DrawGrid1: TDrawGrid
    Left = 0
    Top = 0
    Width = 635
    Height = 299
    Align = alClient
    Color = clWhite
    ColCount = 15
    DefaultColWidth = 65
    DefaultRowHeight = 48
    DefaultDrawing = False
    DrawingStyle = gdsGradient
    RowCount = 12
    GradientEndColor = clBtnFace
    GradientStartColor = clBtnFace
    Options = [goThumbTracking]
    ParentShowHint = False
    ShowHint = True
    TabOrder = 0
    OnDrawCell = DrawGrid1DrawCell
    OnSelectCell = DrawGrid1SelectCell
    ColWidths = (
      65
      65
      65
      65
      65
      65
      65
      65
      65
      65
      65
      65
      65
      65
      65)
    RowHeights = (
      48
      48
      48
      48
      48
      48
      48
      48
      48
      48
      48
      48)
  end
end

The Unit (PAS) code:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,     System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Grids, Math;

type
  TGridCracker = class(TDrawGrid)// required to access protected method Invalidaterow - info gleaned from Team B member Peter Below on the Internet
  private
  public
  end;

  TForm1 = class(TForm)
    DrawGrid1: TDrawGrid;
    procedure DrawGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
    procedure DrawGrid1SelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.DrawGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
var MyCanvas : TCanvas;
  str : string;
  MyRect : TRect;
begin
  MyCanvas := TDrawGrid(Sender).Canvas;

  MyCanvas.Font.Name := 'Arial'; // drawgrid uses Tahoma 8pt as its default font, not Arial
  MyCanvas.Font.Size := 9;
  MyCanvas.Brush.Color := TDrawGrid(Sender).FixedColor;
  MyCanvas.Font.Color := TDrawGrid(Sender).Font.Color;
  MyCanvas.FillRect(Rect);

  if (ARow = 0) then begin
    str := EmptyStr;
    if (ACol > 0) then begin
        str := ACol.ToString;
    end
    else begin
      str := 'TEST';
    end;

    MyCanvas.Font.Color := clblack; // clGray;
    MyRect.Left := Rect.Left + 1;
    MyRect.Top := Rect.Top + 3;
    MyRect.Right := Rect.Right - 1;
    MyRect.Bottom := Rect.Bottom - 3;
    MyCanvas.FillRect(MyRect);
    MyCanvas.Brush.Color := clGray;
    MyCanvas.FrameRect(MyRect);
    MyCanvas.Brush.Color := clWhite;
    MyCanvas.Font.Style := MyCanvas.Font.Style + [fsBold];

    MyRect.Top := MyRect.Top + 2;
    DrawText(MyCanvas.Handle, pChar(str), -1, MyRect, DT_VCENTER or DT_CENTER);

    MyCanvas.Font.Style := MyCanvas.Font.Style - [fsBold];
  end
  else begin
    if (ACol = 0) then begin
      MyCanvas.Brush.Color := clMaroon;
      MyCanvas.FillRect(Rect);
    end
    else begin//ACol > 0
      if ARow = DrawGrid1.Row then begin
        MyCanvas.Brush.Color := clBlue;
      end
      else begin
        MyCanvas.Brush.Color := clwhite;
      end;

      MyCanvas.FillRect(Rect);

      // other cell drawing of text happens after here
    end;
  end;
end;

procedure TForm1.DrawGrid1SelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean);
begin
  TGridCracker(Sender).InvalidateRow(TGridCracker(Sender).Row);
  TGridCracker(Sender).InvalidateRow(ARow);
end;

end.

Run the program.

Click the horizontal scroll bar so column 14 is visible.

Click on column 13 in row 2.

Click on column 12 in row 3.

Notice the really messed up selection pattern?

Here is a screen capture of the result:

screen capture of borked selection

Ideally there should be one row of blue cells, not the jumbled mess. Row 3 should be solid blue.

Calling a DrawGrid1.Refresh within the OnSelectCell method does not even fix it.

Any ideas on how to make this really work? I cannot use RowSelect for this grid.

Cheers!

TJ

Solution

  • Apart from an unnecessary flicker your code does not seem to have any errors. That could be fixed by using the State of OnDrawCell event.

    procedure TForm1.DrawGrid1DrawCell(Sender: TObject; ....
var MyCanvas : TCanvas;
  str : string;
  MyRect : TRect;
begin
  MyCanvas := TDrawGrid(Sender).Canvas;

  if gdFixed in State then begin
    MyCanvas.Font.Name := 'Arial'; // drawgrid uses Tahoma 8pt as its default font, not Arial
    MyCanvas.Font.Size := 9;
    MyCanvas.Brush.Color := TDrawGrid(Sender).FixedColor;
    MyCanvas.Font.Color := TDrawGrid(Sender).Font.Color;
    MyCanvas.FillRect(Rect);
  end;

  if (ARow = 0) then begin
    ...


    The error is in InvalidateRow of TCustomGrid, it doesn't account for possible scroll. Same for column wise.

    You can use the protected BoxRect method which use GridRectToScreenRect (private) method to convert cell positions to screen coordinates.

    procedure TForm1.DrawGrid1SelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean);
var
  Grid: TDrawGrid;
  GR, R: TRect;
begin
  Grid := Sender as TDrawGrid;
  if ARow = Grid.Row then
    Exit;

  GR.Left := Grid.LeftCol;
  GR.Top := Grid.Row;
  GR.Width := Grid.VisibleColCount;
  GR.Height := 0;

  R := TGridCracker(Grid).BoxRect(GR.Left, GR.Top, GR.Right, GR.Bottom);
  InvalidateRect(Grid.Handle, R, False);

  GR.Top := ARow;
  GR.Bottom := ARow;

  R := TGridCracker(Grid).BoxRect(GR.Left, GR.Top, GR.Right, GR.Bottom);
  InvalidateRect(Grid.Handle, R, False);
end;