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:
- run app
- click “Row 10” and “Col 10”
- scroll to make cell “c=10,r=10” visible in the center
- 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.
marian d said
How much Delphi team sucks?
jpluimers said
Normally it is quite OK, but some bugs take a long time to fix.
So at the time of writing, it is not: http://qc.embarcadero.com/wc/qcmain.aspx/qcmain.aspx?d=81060