关于 Delphi 10 TDrawGrid：Delphi 10 TDrawGrid – 如何正确刷新行？

codeneng 2023-03-28 原文

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

使用 Delphi 10.2 Tokyo。

我使用 DrawCell 方法使一行中的所有列与所选单元格的颜色相同。这允许我让用户单击不同的单元格，但仍显示"选定"行。

这使用 OnSelectCell 方法使原始行和新选择的行无效。多年来一直使用这种方法。

如果我有一个带有水平滚动条的网格，则当向右滚动并且用户单击单元格时，该网格不会正确绘制。

下面是一个使用 TDrawGrid 和 OnDrawCell 事件和 OnSelectCell 事件的简单示例：

表格 (DFM) 代码：

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67

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) 代码：

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96

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。

干杯！

请参阅 qc.embarcadero.com/wc/qcmain.aspx?d=81060 这是一个自 delphi 开始以来就存在的错误

除了不必要的闪烁之外，您的代码似乎没有任何错误。这可以通过使用 OnDrawCell 事件的 State 来解决。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17

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(私有)方法将单元格位置转换为屏幕坐标。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23

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)例程中的一个错误：

1
2
3
4
5
6
7
8
9
10
11

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;

解决此问题的方法：

1
2
3
4
5
6
7
8
9
10
11
12

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);

或

1
2
3

for i := LeftCol to LeftCol+VisibleColCount do // this will invalidate only visible cells
InvalidateCell(i, ARow);
end;

TDrawGrid 新行 span class nbsp delphi delphi-10.2-tokyo

有关关于 Delphi 10 TDrawGrid：Delphi 10 TDrawGrid – 如何正确刷新行？的更多相关文章

ruby - 如何使用 Nokogiri 的 xpath 和 at_xpath 方法 - 2
我正在学习如何使用Nokogiri，根据这段代码我遇到了一些问题:require'rubygems'require'mechanize'post_agent=WWW::Mechanize.newpost_page=post_agent.get('http://www.vbulletin.org/forum/showthread.php?t=230708')puts"\nabsolutepathwithtbodygivesnil"putspost_page.parser.xpath('/html/body/div/div/div/div/div/table/tbody/tr/td/div
ruby - 如何从 ruby 中的字符串运行任意对象方法？ - 2
总的来说，我对ruby还比较陌生，我正在为我正在创建的对象编写一些rspec测试用例。许多测试用例都非常基础，我只是想确保正确填充和返回值。我想知道是否有办法使用循环结构来执行此操作。不必为我要测试的每个方法都设置一个assertEquals。例如:describeitem,"TestingtheItem"doit"willhaveanullvaluetostart"doitem=Item.new#HereIcoulddotheitem.name.shouldbe_nil#thenIcoulddoitem.category.shouldbe_nilendend但我想要一些方法来使用
python - 如何使用 Ruby 或 Python 创建一系列高音调和低音调的蜂鸣声？ - 2
关闭。这个问题是opinion-based.它目前不接受答案。想要改进这个问题？更新问题，以便editingthispost可以用事实和引用来回答它.关闭4年前。Improvethisquestion我想在固定时间创建一系列低音和高音调的哔哔声。例如:在150毫秒时发出高音调的蜂鸣声在151毫秒时发出低音调的蜂鸣声200毫秒时发出低音调的蜂鸣声250毫秒的高音调蜂鸣声有没有办法在Ruby或Python中做到这一点？我真的不在乎输出编码是什么(.wav、.mp3、.ogg等等)，但我确实想创建一个输出文件。
ruby-on-rails - 如何验证 update_all 是否实际在 Rails 中更新 - 2
给定这段代码defcreate@upgrades=User.update_all(["role=?","upgraded"],:id=>params[:upgrade])redirect_toadmin_upgrades_path,:notice=>"Successfullyupgradeduser."end我如何在该操作中实际验证它们是否已保存或未重定向到适当的页面和消息？最佳答案在Rails3中，update_all不返回任何有意义的信息，除了已更新的记录数(这可能取决于您的DBMS是否返回该信息)。http://ar.ru
ruby-on-rails - 'compass watch' 是如何工作的/它是如何与 rails 一起使用的 - 2
我在我的项目目录中完成了compasscreate.和compassinitrails。几个问题:我已将我的.sass文件放在public/stylesheets中。这是放置它们的正确位置吗？当我运行compasswatch时，它不会自动编译这些.sass文件。我必须手动指定文件:compasswatchpublic/stylesheets/myfile.sass等。如何让它自动运行？文件ie.css、print.css和screen.css已放在stylesheets/compiled。如何在编译后不让它们重新出现的情况下删除它们？我自己编译的.sass文件编译成compiled/t
ruby - 如何将脚本文件的末尾读取为数据文件(Perl 或任何其他语言) - 2
我正在寻找执行以下操作的正确语法(在Perl、Shell或Ruby中):#variabletoaccessthedatalinesappendedasafileEND_OF_SCRIPT_MARKERrawdatastartshereanditcontinues. 最佳答案 Perl用__DATA__做这个:#!/usr/bin/perlusestrict;usewarnings;while(){print;}__DATA__Texttoprintgoeshere 关于ruby-如何将脚
ruby - 如何指定 Rack 处理程序 - 2
Rackup通过Rack的默认处理程序成功运行任何Rack应用程序。例如:classRackAppdefcall(environment)['200',{'Content-Type'=>'text/html'},["Helloworld"]]endendrunRackApp.new但是当最后一行更改为使用Rack的内置CGI处理程序时，rackup给出“NoMethodErrorat/undefinedmethod`call'fornil:NilClass”:Rack::Handler::CGI.runRackApp.newRack的其他内置处理程序也提出了同样的反对意见。例如Rack
ruby - 如何每月在 Heroku 运行一次 Scheduler 插件？ - 2
在选择我想要运行操作的频率时，唯一的选项是“每天”、“每小时”和“每10分钟”。谢谢!我想为我的Rails3.1应用程序运行调度程序。最佳答案这不是一个优雅的解决方案，但您可以安排它每天运行，并在实际开始工作之前检查日期是否为当月的第一天。关于ruby-如何每月在Heroku运行一次Scheduler插件？，我们在StackOverflow上找到一个类似的问题： https://stackoverflow.com/questions/8692687/
ruby-on-rails - 如何从 format.xml 中删除 <hash></hash> - 2
我有一个对象has_many应呈现为xml的子对象。这不是问题。我的问题是我创建了一个Hash包含此数据，就像解析器需要它一样。但是rails自动将整个文件包含在.........我需要摆脱type="array"和我该如何处理？我没有在文档中找到任何内容。最佳答案我遇到了同样的问题；这是我的XML:我在用这个:entries.to_xml将散列数据转换为XML，但这会将条目的数据包装到中所以我修改了:entries.to_xml(root:"Contacts")但这仍然将转换后的XML包装在“联系人”中，将我的XML代码修改为
ruby - 如何使用文字标量样式在 YAML 中转储字符串？ - 2
我有一大串格式化数据(例如JSON)，我想使用Psychinruby同时保留格式转储到YAML。基本上，我希望JSON使用literalstyle出现在YAML中:---json:|{"page":1,"results":["item","another"],"total_pages":0}但是，当我使用YAML.dump时，它不使用文字样式。我得到这样的东西:---json:!"{\n\"page\":1,\n\"results\":[\n\"item\",\"another\"\n],\n\"total_pages\":0\n}\n"我如何告诉Psych以想要的样式转储标量？解

关于 Delphi 10 TDrawGrid：Delphi 10 TDrawGrid – 如何正确刷新行？

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

有关关于 Delphi 10 TDrawGrid：Delphi 10 TDrawGrid – 如何正确刷新行？的更多相关文章

随机推荐