我使用 OnDrawCell 事件对 Delphi TStringGrid 进行自定义绘图。单元格覆盖的区域没有问题,但是如何在最右边一列和最后一行下方绘制背景?
(编辑)绘画不是必需的,我只想设置用于背景的颜色。我正在使用 XE2 并研究 VCL 样式。即使在默认绘图中,在字符串网格中设置颜色,接缝也完全没有效果。
TIA
我使用 OnDrawCell 事件对 Delphi TStringGrid 进行自定义绘图。单元格覆盖的区域没有问题,但是如何在最右边一列和最后一行下方绘制背景?
(编辑)绘画不是必需的,我只想设置用于背景的颜色。我正在使用 XE2 并研究 VCL 样式。即使在默认绘图中,在字符串网格中设置颜色,接缝也完全没有效果。
TIA
这是我在谷歌上找到的一些代码(它不是来自我,我找不到作者的名字,也许它来自 StackExchange 以某种方式......)。它定义了 TStringGrid 的后代并实现了新的背景绘图。(该示例使用位图,但您可以轻松更改...)
type
TStringGrid = class(Grids.TStringGrid)
private
FGraphic: TGraphic;
FStretched: Boolean;
function BackgroundVisible(var ClipRect: TRect): Boolean;
procedure PaintBackground;
protected
procedure Paint; override;
procedure Resize; override;
procedure TopLeftChanged; override;
public
property BackgroundGraphic: TGraphic read FGraphic write FGraphic;
property BackgroundStretched: Boolean read FStretched write FStretched;
end;
TForm1 = class(TForm)
StringGrid: TStringGrid;
Image: TImage;
procedure FormCreate(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TStringGrid }
function TStringGrid.BackgroundVisible(var ClipRect: TRect): Boolean;
var
Info: TGridDrawInfo;
R: TRect;
begin
CalcDrawInfo(Info);
SetRect(ClipRect, 0, 0, Info.Horz.GridBoundary, Info.Vert.GridBoundary);
R := ClientRect;
Result := (ClipRect.Right < R.Right) or (ClipRect.Bottom < R.Bottom);
end;
procedure TStringGrid.Paint;
begin
inherited Paint;
PaintBackground;
end;
procedure TStringGrid.PaintBackground;
var
R: TRect;
begin
if (FGraphic <> nil) and BackgroundVisible(R) then
begin
with R do
ExcludeClipRect(Canvas.Handle, Left, Top, Right, Bottom);
if FStretched then
Canvas.StretchDraw(ClientRect, FGraphic)
else
Canvas.Draw(0, 0, FGraphic);
end;
end;
procedure TStringGrid.Resize;
begin
inherited Resize;
PaintBackground;
end;
procedure TStringGrid.TopLeftChanged;
begin
inherited TopLeftChanged;
PaintBackground;
end;
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
// Usage:
StringGrid.BackgroundGraphic := Image.Picture.Graphic;
StringGrid.BackgroundStretched := True;
end;