在 DBGrid 中使用 Canvas.TextOut - Delphi XE 3
Using Canvas.TextOut in DBGrid - Delphi XE 3
拜托,我需要帮助 Canvas 使用:
当用户将鼠标移到 DBGrid 的标题列上时,
标题描述在 Delphi XE 3 中消失。
delphI 7.
中不会出现此问题
按照下面的代码:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Graphics, Controls, Forms, Dialogs, Data.DB, Datasnap.DBClient,
Grids, DBGrids, Types, StdCtrls;
type
TAccessDBGrid = class(TCustomGrid);
type
TForm1 = class(TForm)
DataSource1: TDataSource;
grid1: TDBGrid;
cdsTabela: TClientDataSet;
cdsTabelacodigo_1: TIntegerField;
cdsTabelacodigo_2: TIntegerField;`enter code here`
procedure grid1DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
procedure FormCreate(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure grid1TitleClick(Column: TColumn);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
cdsTabela.CreateDataSet;
end;
procedure TForm1.FormResize(Sender: TObject);
begin
grid1.Refresh;
end;
procedure TForm1.grid1DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
var
S1 : string;
begin
with TAccessDBGrid(grid1) do
begin
RowHeights[0] := 29;
Canvas.Brush.Color := clBtnFace;
case Column.Index of
0:
begin
Column.Title.Caption := '';
S1 := 'Code';
end;
1:
begin
Column.Title.Caption := '';
S1 := 'Description';
end;
end;
TDBGrid(Sender).Canvas.Font.Color:= clBlack;
Canvas.TextOut(Rect.Left + 3, 19, S1);
end;
end;
procedure TForm1.grid1TitleClick(Column: TColumn);
begin
ShowMessage('Title Click! ');
end;
end
更多信息,请查看我发布的答案。
您发布的答案中包含的额外信息使您更容易理解您正在尝试做什么,这很好。请在以后的问题中尝试这样做,因为您更有可能更快地得到更好的答案。
无论如何,我建议您将 TDBGrid 替换为 Mike Shkolnik 的 TSMDBGrid。请参阅:http://www.scalabium.com/smdbgrid.htm 并观看动画。
他的网格包含一个 OnDrawColumnTitle
事件,我认为这比尝试使用 TDBGrid 更容易实现您想要的目标。我从你的评论中了解到你已经遵循了这个建议并成功地完成了你试图做的事情。
原回答如下:
我同意 Ken White 所说的,但除此之外,我认为您的代码
被误解了。要明白我的意思,试试这个:
保存一个 IDE 代码编辑器不重叠的调试布局
你的 Form1。这样做的目的是为了不强制 Form1 重新绘制
IDE 停在断点处。
将 DefaultDrawing
设置为 False。这一点是将其设置为
True 隐藏了你的 Grid1DrawColumnCell
有多糟糕。
在 Grid1DrawColumnCell
的第一行设置一个断点,即
with TAccessDBGrid(grid1)
.
编译并运行。请注意,调试器在几个断点处停止
在屏幕上绘制表单时的时间,但之后它不会
完全停止你的血压。因此,一旦表单为 on-screen,您的自定义绘画就永远不会发生,直到您导致网格刷新,例如使用表单的 OnResize
处理程序。
那么是什么原因导致Title Captions栏一移动鼠标就空白
在网格上。答案是,你愿意!看看为什么...
在VCL.DBGrids.Pas中,找到TCustomDBGrid.DrawCell中的DrawTitleCell,放上BP
WriteText(Canvas, TextRect, LFrameOffs, LFrameOffs, Caption, Alignment,...
运行 应用程序再次运行到您的 Grid1DrawColumnCell
已执行的位置
并且调试器在步骤 6 中设置的 WriteText
BP 处停止。评估 Caption
你会看到它是空的(当然,因为你的 Grid1DrawColumnCell
已经清除了它)。我想您可以在 DrawColumnCell 退出之前将 S1
值分配给列标题的标题,但是绘制它
仍然会一团糟,如果你尝试一下,你会看到
case Column.Index of
0: begin
// Column.Title.Caption := '';
S1 := 'Code';
Column.Title.Caption := S1;
end;
1: begin
// Column.Title.Caption := '';
S1 := 'Description';
Column.Title.Caption := S1;
end;
QED
所以基本上您是在 Grid1DrawColumnCell
上浪费时间。如果你
想知道是否可以 custom-draw 列 headers/titles,如果可以,如何,
我建议你在做一些研究后问一个新的问题。如果您没有找到任何东西,您可以考虑派生一个 TCustomDBGrid 后代并覆盖它的 DrawCell
;这样你就可以更好地控制整个绘图过程,并且可能更接近你想要实现的目标。
顺便说一句,以上是基于在 Delphi Seatlle 中编译的应用程序,它比 XE3 更新,但我怀疑这有什么区别。
我使用 Canvas.TextOut 而不是 Title.Caption 的原因是
我需要在标题中写 2 行:
Tests
Test One Test Two
我用“19”而不是Rect.Top因为我想写在Title里。
如果我使用Rect.Top,文本绘制在列
的编辑区
Canvas.TextOut(Rect.Left + 3, 19, S1);
下面是我的真实代码:
在 Grid1DrawColumnCell 中:
with TAccessDBGrid(grid1) do
begin
RowHeights[0] := 37;
Canvas.Brush.Color := clBtnFace;
case Column.Index of
0: begin
Column.Title.Caption := '';
S1 := 'Code';
end;
1: begin
Column.Title.Caption := '';
Canvas.Font.Color := clBlack;
S1 := 'Tests';
Canvas.Brush.Style := bsSolid;
Canvas.Brush.Color := clBtnFace;
Canvas.FillRect(Types.Rect(Rect.Left, 0, Rect.Left + 120, 18));
Canvas.TextOut(Rect.Left + 3, 1, S1);
Canvas.Brush.Style := bsSolid;
S1 := 'Test One';
end;
2: begin
Column.Title.Caption := '';
S1 := 'Test Two';
end;
end;
Canvas.Font.Color:= clBlack;
Canvas.TextOut(Rect.Left + 3, 19, S1);
end;
拜托,我需要帮助 Canvas 使用: 当用户将鼠标移到 DBGrid 的标题列上时, 标题描述在 Delphi XE 3 中消失。 delphI 7.
中不会出现此问题按照下面的代码:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Graphics, Controls, Forms, Dialogs, Data.DB, Datasnap.DBClient,
Grids, DBGrids, Types, StdCtrls;
type
TAccessDBGrid = class(TCustomGrid);
type
TForm1 = class(TForm)
DataSource1: TDataSource;
grid1: TDBGrid;
cdsTabela: TClientDataSet;
cdsTabelacodigo_1: TIntegerField;
cdsTabelacodigo_2: TIntegerField;`enter code here`
procedure grid1DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
procedure FormCreate(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure grid1TitleClick(Column: TColumn);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
cdsTabela.CreateDataSet;
end;
procedure TForm1.FormResize(Sender: TObject);
begin
grid1.Refresh;
end;
procedure TForm1.grid1DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
var
S1 : string;
begin
with TAccessDBGrid(grid1) do
begin
RowHeights[0] := 29;
Canvas.Brush.Color := clBtnFace;
case Column.Index of
0:
begin
Column.Title.Caption := '';
S1 := 'Code';
end;
1:
begin
Column.Title.Caption := '';
S1 := 'Description';
end;
end;
TDBGrid(Sender).Canvas.Font.Color:= clBlack;
Canvas.TextOut(Rect.Left + 3, 19, S1);
end;
end;
procedure TForm1.grid1TitleClick(Column: TColumn);
begin
ShowMessage('Title Click! ');
end;
end
更多信息,请查看我发布的答案。
您发布的答案中包含的额外信息使您更容易理解您正在尝试做什么,这很好。请在以后的问题中尝试这样做,因为您更有可能更快地得到更好的答案。
无论如何,我建议您将 TDBGrid 替换为 Mike Shkolnik 的 TSMDBGrid。请参阅:http://www.scalabium.com/smdbgrid.htm 并观看动画。
他的网格包含一个 OnDrawColumnTitle
事件,我认为这比尝试使用 TDBGrid 更容易实现您想要的目标。我从你的评论中了解到你已经遵循了这个建议并成功地完成了你试图做的事情。
原回答如下:
我同意 Ken White 所说的,但除此之外,我认为您的代码 被误解了。要明白我的意思,试试这个:
保存一个 IDE 代码编辑器不重叠的调试布局 你的 Form1。这样做的目的是为了不强制 Form1 重新绘制 IDE 停在断点处。
将
DefaultDrawing
设置为 False。这一点是将其设置为 True 隐藏了你的Grid1DrawColumnCell
有多糟糕。在
Grid1DrawColumnCell
的第一行设置一个断点,即with TAccessDBGrid(grid1)
.编译并运行。请注意,调试器在几个断点处停止 在屏幕上绘制表单时的时间,但之后它不会 完全停止你的血压。因此,一旦表单为 on-screen,您的自定义绘画就永远不会发生,直到您导致网格刷新,例如使用表单的
OnResize
处理程序。那么是什么原因导致Title Captions栏一移动鼠标就空白 在网格上。答案是,你愿意!看看为什么...
在VCL.DBGrids.Pas中,找到TCustomDBGrid.DrawCell中的DrawTitleCell,放上BP WriteText(Canvas, TextRect, LFrameOffs, LFrameOffs, Caption, Alignment,...
运行 应用程序再次运行到您的
Grid1DrawColumnCell
已执行的位置 并且调试器在步骤 6 中设置的WriteText
BP 处停止。评估Caption
你会看到它是空的(当然,因为你的Grid1DrawColumnCell
已经清除了它)。我想您可以在 DrawColumnCell 退出之前将S1
值分配给列标题的标题,但是绘制它 仍然会一团糟,如果你尝试一下,你会看到case Column.Index of 0: begin // Column.Title.Caption := ''; S1 := 'Code'; Column.Title.Caption := S1; end; 1: begin // Column.Title.Caption := ''; S1 := 'Description'; Column.Title.Caption := S1; end;
QED
所以基本上您是在 Grid1DrawColumnCell
上浪费时间。如果你
想知道是否可以 custom-draw 列 headers/titles,如果可以,如何,
我建议你在做一些研究后问一个新的问题。如果您没有找到任何东西,您可以考虑派生一个 TCustomDBGrid 后代并覆盖它的 DrawCell
;这样你就可以更好地控制整个绘图过程,并且可能更接近你想要实现的目标。
顺便说一句,以上是基于在 Delphi Seatlle 中编译的应用程序,它比 XE3 更新,但我怀疑这有什么区别。
我使用 Canvas.TextOut 而不是 Title.Caption 的原因是 我需要在标题中写 2 行:
Tests
Test One Test Two
我用“19”而不是Rect.Top因为我想写在Title里。 如果我使用Rect.Top,文本绘制在列
的编辑区Canvas.TextOut(Rect.Left + 3, 19, S1);
下面是我的真实代码:
在 Grid1DrawColumnCell 中:
with TAccessDBGrid(grid1) do
begin
RowHeights[0] := 37;
Canvas.Brush.Color := clBtnFace;
case Column.Index of
0: begin
Column.Title.Caption := '';
S1 := 'Code';
end;
1: begin
Column.Title.Caption := '';
Canvas.Font.Color := clBlack;
S1 := 'Tests';
Canvas.Brush.Style := bsSolid;
Canvas.Brush.Color := clBtnFace;
Canvas.FillRect(Types.Rect(Rect.Left, 0, Rect.Left + 120, 18));
Canvas.TextOut(Rect.Left + 3, 1, S1);
Canvas.Brush.Style := bsSolid;
S1 := 'Test One';
end;
2: begin
Column.Title.Caption := '';
S1 := 'Test Two';
end;
end;
Canvas.Font.Color:= clBlack;
Canvas.TextOut(Rect.Left + 3, 19, S1);
end;