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