Delphi 10 TDrawGrid - 如何让行正确刷新？
Delphi 10 TDrawGrid - How do I get rows to refresh properly?
使用 Delphi 10.2 东京。
我使用 DrawCell 方法使一行中的所有列与所选单元格的颜色相同。这允许我让用户点击不同的单元格，但仍然显示 "selected" 行。
这使用OnSelectCell 方法使原始行和新选择的行无效。多年来一直使用这种方法。
如果我有一个带有水平滚动条的网格，当向右滚动并且用户在单元格中单击时，网格无法正确绘制。
这里是一个简单的例子，使用一个 TDrawGrid 和一个 OnDrawCell 事件和一个 OnSelectCell 事件：
表单 (DFM) 代码：
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
单位（PAS）代码：
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.
运行 程序。
单击水平滚动条使第 14 列可见。
单击第 2 行中的第 13 列。
单击第 3 行中的第 12 列。
注意到真正混乱的选择模式了吗？
这是结果的屏幕截图：
理想情况下应该有一排蓝色单元格，而不是乱七八糟的一团糟。第 3 行应为纯蓝色。
在 OnSelectCell 方法中调用 DrawGrid1.Refresh 甚至无法修复它。
关于如何让它真正起作用的任何想法？我无法为此网格使用 RowSelect。
干杯！
TJ
除了不必要的闪烁之外，您的代码似乎没有任何错误。这可以通过使用 OnDrawCell 事件的 State 来解决。
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
...
错误在 TCustomGrid 的 InvalidateRow 中，它没有考虑可能的滚动。列方面相同。
您可以使用受保护的 BoxRect 方法，该方法使用 GridRectToScreenRect（私有）方法将单元格位置转换为屏幕坐标。
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;
这是由于 VCL TCustomGrid.InvalidateRow（和 TCustomGrid.InvalidateCol）例程中的错误：
procedure TCustomGrid.InvalidateRow(ARow: Longint);
var
Rect: TGridRect;
begin
if not HandleAllocated then Exit;
Rect.Top := ARow;
Rect.Left := 0; // this should be Rect.Left:=LeftCol; --> index of the first column in the scrollable region that is visible
Rect.Bottom := ARow;
Rect.Right := VisibleColCount+1;
InvalidateRect(Rect);
end;
解决此问题的解决方案：
type TGridCracker = class(TDrawGrid)
protected
procedure InvalidateRow(ARow: Longint);
end;
procedure TGridCracker.InvalidateRow(ARow: Integer);
var i: Integer;
begin
if not HandleAllocated then
Exit;
for i := 0 to ColCount-1 do // this will invalidate all cells, visible and hidden
InvalidateCell(i, ARow);
或
for i := LeftCol to LeftCol+VisibleColCount do // this will invalidate only visible cells
InvalidateCell(i, ARow);
end;
使用 Delphi 10.2 东京。
我使用 DrawCell 方法使一行中的所有列与所选单元格的颜色相同。这允许我让用户点击不同的单元格，但仍然显示 "selected" 行。
这使用OnSelectCell 方法使原始行和新选择的行无效。多年来一直使用这种方法。
如果我有一个带有水平滚动条的网格，当向右滚动并且用户在单元格中单击时，网格无法正确绘制。
这里是一个简单的例子，使用一个 TDrawGrid 和一个 OnDrawCell 事件和一个 OnSelectCell 事件：
表单 (DFM) 代码：
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
单位（PAS）代码：
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.
运行 程序。
单击水平滚动条使第 14 列可见。
单击第 2 行中的第 13 列。
单击第 3 行中的第 12 列。
注意到真正混乱的选择模式了吗？
这是结果的屏幕截图：
理想情况下应该有一排蓝色单元格，而不是乱七八糟的一团糟。第 3 行应为纯蓝色。
在 OnSelectCell 方法中调用 DrawGrid1.Refresh 甚至无法修复它。
关于如何让它真正起作用的任何想法？我无法为此网格使用 RowSelect。
干杯！
TJ
除了不必要的闪烁之外，您的代码似乎没有任何错误。这可以通过使用 OnDrawCell 事件的 State 来解决。
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
...
错误在
TCustomGrid 的 InvalidateRow 中，它没有考虑可能的滚动。列方面相同。
您可以使用受保护的 BoxRect 方法，该方法使用 GridRectToScreenRect（私有）方法将单元格位置转换为屏幕坐标。
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;
这是由于 VCL TCustomGrid.InvalidateRow（和 TCustomGrid.InvalidateCol）例程中的错误：
procedure TCustomGrid.InvalidateRow(ARow: Longint);
var
Rect: TGridRect;
begin
if not HandleAllocated then Exit;
Rect.Top := ARow;
Rect.Left := 0; // this should be Rect.Left:=LeftCol; --> index of the first column in the scrollable region that is visible
Rect.Bottom := ARow;
Rect.Right := VisibleColCount+1;
InvalidateRect(Rect);
end;
解决此问题的解决方案：
type TGridCracker = class(TDrawGrid)
protected
procedure InvalidateRow(ARow: Longint);
end;
procedure TGridCracker.InvalidateRow(ARow: Integer);
var i: Integer;
begin
if not HandleAllocated then
Exit;
for i := 0 to ColCount-1 do // this will invalidate all cells, visible and hidden
InvalidateCell(i, ARow);
或
for i := LeftCol to LeftCol+VisibleColCount do // this will invalidate only visible cells
InvalidateCell(i, ARow);
end;