The*_*ner 6 delphi paint tstringgrid
我使用OnDrawCell事件自定义绘制Delphi TStringGrid.单元格覆盖的区域没有问题,但如何绘制最右边的列右下方和最后一行的背景?
(编辑)绘画不是真的有必要,我只想设置用于背景的颜色.我正在使用XE2并调查VCL样式.即使在默认绘图中,在stringgrid中设置Colors,接缝也完全没有效果.
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;
Run Code Online (Sandbox Code Playgroud)
归档时间: |
|
查看次数: |
2386 次 |
最近记录: |