The Wiert Corner – irregular stream of stuff

Jeroen W. Pluimers on .NET, C#, Delphi, databases, and personal interests

  • My work

  • My badges

  • Twitter Updates

  • My Flickr Stream

  • Pages

  • All categories

  • Enter your email address to subscribe to this blog and receive notifications of new posts by email.

    Join 1,808 other followers

Delphi – TCustomGrid.InvalidateCol and InvalidateRow bug that has been there since at least Delphi 4^H^H^H^H^H^H^H^H 2 and 1

Posted by jpluimers on 2010/01/12

I just re-reported this in in QC as 81060, but wanted to let you know that there is a bug in TCustomGrid.InvalidateCol and TCustomGrid.InvalidateRow which has been there since at least Delphi 4 Delphi 1 (InvalidateRow) and Delphi 2 (InvalidateCol) and still present in Delphi 2010.

Both methods will not invalidate the entire Row/Col but only the Left/Top most cells of that Row/Col.
So the invalidate the absolute rectangle in stead of the visible rectangle.

You will see this behaviour when you have a virtual grid that is larger than the actual grid on the screen, you scroll through that grid, and perform your own drawing.

Boths bugs are easy to fix, have been reported in QC as number 8472 before (and reported even before QC existed), but denied as ‘test case error’  in stead of being investigated further.
The earliest reference I could find on them is as number 531 in the Delphi Buglist, by Rune Moberg, long time and well respected Delphi developer and bikedude.

Some of the 3rd party grid vendors are also to blame: they seemed to have worked around it without pressing the Delphi team to solve the issue.
For instance, the infamous rxgrid, just invalidates all Rows within InvalidateCol. Now that is pure overkill, as my solution will show.Lets first start with a screenshot some code.

unit MainFormUnit;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    DrawGrid: TDrawGrid;
    Memo1: TMemo;
    Button5: TButton;
    UseWorkaroundCheckBox: TCheckBox;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure DrawGridDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
  private
    FHighlightedColumn: Integer;
    FHighlightedRow: Integer;
    procedure SetHighlightedColumn(const Value: Integer);
    procedure SetHighlightedRow(const Value: Integer);
    property HighlightedColumn: Integer read FHighlightedColumn write SetHighlightedColumn;
    property HighlightedRow: Integer read FHighlightedRow write SetHighlightedRow;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

type
  TCustomGridHack = class(TCustomGrid);

procedure TForm1.Button1Click(Sender: TObject);
begin
  HighlightedRow := 10;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  HighlightedRow := 20;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  HighlightedColumn := 10;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  HighlightedColumn := 20;
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
  DrawGrid.Invalidate();
end;

procedure TForm1.SetHighlightedColumn(const Value: Integer);
begin
  TCustomGridHack(DrawGrid).InvalidateCol(HighlightedColumn);
  FHighlightedColumn := Value;
  TCustomGridHack(DrawGrid).InvalidateCol(HighlightedColumn);
end;

procedure TForm1.SetHighlightedRow(const Value: Integer);
begin
  TCustomGridHack(DrawGrid).InvalidateRow(HighlightedRow);
  FHighlightedRow := Value;
  TCustomGridHack(DrawGrid).InvalidateRow(HighlightedRow);
end;

procedure TForm1.DrawGridDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
var
  aSize: TSize;
  aTopDelta: Integer;
  aOldBrushColor: TColor;
  aCanvas: TCanvas;
  s: string;
  HOR_MARGIN: Integer;
begin
  aCanvas := DrawGrid.Canvas;
  aOldBrushColor := aCanvas.Brush.Color;
  try
    if ACol = HighlightedColumn then
      aCanvas.Brush.Color := clRed
    else
      if ARow = HighlightedRow then
        aCanvas.Brush.Color := clGreen;

    s := Format('c=%d,r=%d', [ACol, ARow]);

    aSize := aCanvas.TextExtent(s);
    aTopDelta := (Rect.Bottom - Rect.Top - aSize.cy) div 2;

    HOR_MARGIN := 2;
    aCanvas.TextRect(
      Rect,
      Rect.Left + HOR_MARGIN,
      Rect.Top + aTopDelta,
      s)
  finally
    aCanvas.Brush.Color := aOldBrushColor;
  end;
end;

end.

So, we have 4 buttons, 2 of which set the HighlightedRow and 2 that set the HighlightedColumn.
The OnDrawCell event is used to draw the HighlightedColumn with a Red background and the HighlightedRow with a Green background.
InvalidateCol and InvalidateRow are used to force a repaint of the affected cells (well, that is the idea, it works out differently).

This is the DFM file for this form:

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 348
  ClientWidth = 643
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Panel1: TPanel
    Left = 0
    Top = 0
    Width = 643
    Height = 121
    Align = alTop
    Caption = 'Panel1'
    TabOrder = 0
    object Button1: TButton
      Left = 12
      Top = 10
      Width = 75
      Height = 25
      Caption = 'Row 10'
      TabOrder = 0
      OnClick = Button1Click
    end
    object Button2: TButton
      Left = 93
      Top = 10
      Width = 75
      Height = 25
      Caption = 'Row 20'
      TabOrder = 1
      OnClick = Button2Click
    end
    object Button3: TButton
      Left = 12
      Top = 41
      Width = 75
      Height = 25
      Caption = 'Col 10'
      TabOrder = 2
      OnClick = Button3Click
    end
    object Button4: TButton
      Left = 93
      Top = 41
      Width = 75
      Height = 25
      Caption = 'Col 20'
      TabOrder = 3
      OnClick = Button4Click
    end
    object Memo1: TMemo
      Left = 174
      Top = 10
      Width = 463
      Height = 105
      ScrollBars = ssVertical
      TabOrder = 4
    end
    object Button5: TButton
      Left = 12
      Top = 72
      Width = 156
      Height = 25
      Caption = 'All'
      TabOrder = 5
      OnClick = Button5Click
    end
    object UseWorkaroundCheckBox: TCheckBox
      Left = 12
      Top = 98
      Width = 156
      Height = 17
      Caption = 'UseWorkaroundCheckBox'
      TabOrder = 6
    end
  end
  object DrawGrid: TDrawGrid
    Left = 0
    Top = 121
    Width = 643
    Height = 227
    Align = alClient
    ColCount = 25
    RowCount = 25
    TabOrder = 1
    OnDrawCell = DrawGridDrawCell
    ExplicitTop = 41
    ExplicitHeight = 307
  end
end

And the steps to reproduce are these:

  1. run app
  2. click “Row 10” and “Col 10”
  3. scroll to make cell “c=10,r=10” visible in the center
  4. click “Row 20 and ” Col 20″
    This calls both InvalidateRow(10), InvalidateRow(20),
    InvalidateCol(10) and InvalidateCol(20)
  • //expected:
    The complete Row 10 and Col 10 are to be painted with a white background
  • //actual:
    c=10,r=0..c=10,r=8 are being repainted, c=10,r=9..c=10,r=25 are not being repainted
    c=0,r=10..c=9,r=10 are being repainted, c=10,r=10..c=10,r=10 are not being repainted

Lets see how these steps work out:

After step 1:

After step 3:

After step 4:

Now lets look at the offending code (it is not the whole Grids unit, of which you can find a copy here)

unit Grids;

interface

type
  TCustomGrid = class(TCustomControl)
  private
    procedure InvalidateRect(ARect: TGridRect);
  protected
    procedure InvalidateCell(ACol, ARow: Longint);
    procedure InvalidateCol(ACol: Longint);
    procedure InvalidateRow(ARow: Longint);
  end;

implementation

procedure TCustomGrid.InvalidateCell(ACol, ARow: Longint);
var
  Rect: TGridRect;
begin
  Rect.Top := ARow;
  Rect.Left := ACol;
  Rect.Bottom := ARow;
  Rect.Right := ACol;
  InvalidateRect(Rect);
end;

procedure TCustomGrid.InvalidateCol(ACol: Longint);
var
  Rect: TGridRect;
begin
  if not HandleAllocated then Exit;
  Rect.Top := 0;
  Rect.Left := ACol;
  Rect.Bottom := VisibleRowCount+1;
  Rect.Right := ACol;
  InvalidateRect(Rect);
end;

procedure TCustomGrid.InvalidateRect(ARect: TGridRect);
var
  InvalidRect: TRect;
begin
  if not HandleAllocated then Exit;
  GridRectToScreenRect(ARect, InvalidRect, True);
  Windows.InvalidateRect(Handle, @InvalidRect, False);
end;

procedure TCustomGrid.InvalidateRow(ARow: Longint);
var
  Rect: TGridRect;
begin
  if not HandleAllocated then Exit;
  Rect.Top := ARow;
  Rect.Left := 0;
  Rect.Bottom := ARow;
  Rect.Right := VisibleColCount+1;
  InvalidateRect(Rect);
end;

end.

Both InvalidateCol and InvalidateRect only invalidate the topmost or leftmost portion of the grid cells.
By coincidence, they also invalidate the FixedCols and FixedRows (becuase they are always at the top and left).

Note that a descending class cannot use InvalidateRect, as it is private.
Luckily, InvalidateCell is protected, and calls InvalidateRect in turn.
Even more lucky, the Windows.InvalidateRect does not fire WM_PAINT messages on each call, but the rects are being accumulated in one region right before the next WM_PAINT is being sent. And since there can be only one WM_PAINT can be in a message queue for a window, the performance is not really bad at all.

So here is the workaround:

procedure FixedInvalidateCol(AGrid: TCustomGridHack; ACol: Longint);
var
  ARect: TGridRect;
  ARow: Integer;
begin
  with AGrid do
  begin
    if not HandleAllocated then
      Exit;
    ARect.Top := TopRow; // bug in VCL: was 0
    ARect.Left := ACol;
    ARect.Bottom := TopRow+VisibleRowCount+1; // bug in VCL: forgot to add TopRow
    ARect.Right := ACol;
  //  InvalidateRect(ARect); // problem in VCL: TCustomGrid.InvalidateRect is private, so divert to TCustomGrid.InvalidateCell
    for ARow := ARect.Top to ARect.Bottom do
      AGrid.InvalidateCell(ACol, ARow);

    // now take into account the fixed Rows, which the VCL by accident does:
    for ARow := 0 to FixedRows-1 do
      AGrid.InvalidateCell(ACol, ARow);
  end;
end;

procedure FixedInvalidateRow(AGrid: TCustomGridHack; ARow: Longint);
var
  ARect: TGridRect;
  ACol: Integer;
begin
  with AGrid do
  begin
    if not HandleAllocated then
      Exit;
    ARect.Top := ARow;
    ARect.Left := LeftCol; // bug in VCL: was 0
    ARect.Bottom := ARow;
    ARect.Right := LeftCol+VisibleColCount+1; // bug in VCL: forgot to add LeftCol
  //  InvalidateRect(ARect); // problem in VCL: TCustomGrid.InvalidateRect is private, so divert to TCustomGrid.InvalidateCell
    for ACol := ARect.Left to ARect.Right do
      InvalidateCell(ACol, ARow);

    // now take into account the fixed Cols, which the VCL by accident does:
    for ACol := 0 to FixedCols-1 do
      AGrid.InvalidateCell(ACol, ARow);
  end;
end;

The workaround transposes the ARect to it will invalidate the visible portion of the grid, and the fixed portion.

The workaround can be used for any TCustomGrid or descending class.
In our library, I have fixed it in an intermediate class (we only use a small subset of TCusomGrid, all descending from one baseclass).

PS:
I just managed to restore the RTL/VCL sources for Delphi 1 through 3.
Delphi 1 introduced the InvalidateRow bug.
Delphi 2 introduced the InvalidateCol bug.

2 Responses to “Delphi – TCustomGrid.InvalidateCol and InvalidateRow bug that has been there since at least Delphi 4^H^H^H^H^H^H^H^H 2 and 1”

  1. marian d said

    How much Delphi team sucks?

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

 
%d bloggers like this: