如何使用自定义颜色填充字符串网格的单元格?

How to fill cell of a string grid using custom color?

我正在尝试编写自定义日期选择器(日历)。日期将显示在字符串网格上。我正在尝试用自定义颜色填充单击的单元格,并使选定的单元格文本加粗。

这是我的代码:

    type
      TStringGrid = Class(Vcl.Grids.TStringGrid)
      private
        FHideFocusRect: Boolean;
      protected
         Procedure Paint;override;
      public
         Property HideFocusRect:Boolean Read FHideFocusRect Write FHideFocusRect;
      End;


    TfrmNepaliCalendar = class(TForm)
    ...
    ...
    ...
    end;


    procedure TfrmNepaliCalendar.StringGridDrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    begin
       if gdSelected in State then begin
        StringGrid.Canvas.Brush.Color := [=10=]940A4B;
        StringGrid.Canvas.FillRect(Rect);

        StringGrid.Canvas.Font.Style := [fsBold];
        StringGrid.Canvas.Font.Color := clHighlightText;
        StringGrid.Canvas.TextOut(Rect.Left + 3, Rect.Top + 5, StringGrid.Cells[ACol,ARow]);

        StringGrid.HideFocusRect := True;
      end;
    end;


{ TStringGrid }

procedure TStringGrid.Paint;
var
  LRect: TRect;
begin
  inherited;
  if HideFocusRect then begin
    LRect := CellRect(Col,Row);
    if DrawingStyle = gdsThemed then InflateRect(LRect,-1,-1);

    DrawFocusrect(Canvas.Handle,LRect)
  end;
end;

输出,我得到:

问题 #1:我需要隐藏显示为所选单元格边框的不需要的矩形

问题 #2:避免单元格背景剪裁

在 OnDrawCell 过程中添加 FillRect

Rect.Left := Rect.Left-4;

似乎有效。


另一种选择

即使使用您的绘画程序插件,以上内容也不能完全解决焦点问题。有时会在单元格边框内看到一条白线。

但以下是替代方案,可以解决您的两个问题。它需要更多的编码,但不是很多。另一方面,不需要子类化 TStringGrid,也不需要 Rect 调整

基础是禁用默认绘图,所以设置网格属性 DefaultDrawing := false; 然后在OnDrawCell事件中加入:

procedure TForm1.StringGridDrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
begin
  if gdFixed in State then
  begin
    StringGrid.Canvas.Brush.Color := clGradientInactiveCaption;
    StringGrid.Canvas.Font.Style := [];
    StringGrid.Canvas.Font.Color := clBlack;
  end
  else
  if gdSelected in State then
  begin
    StringGrid.Canvas.Brush.Color := [=11=]940A4B;
    StringGrid.Canvas.Font.Style := [fsBold];
    StringGrid.Canvas.Font.Color := clHighlightText;
  end
  else
  begin
    StringGrid.Canvas.Brush.Color := [=11=]FFFFFF;
    StringGrid.Canvas.Font.Style := [];
    StringGrid.Canvas.Font.Color := clWindowText;
  end;

  StringGrid.Canvas.FillRect(Rect);
  StringGrid.Canvas.TextOut(Rect.Left + 3, Rect.Top + 5, StringGrid.Cells[ACol,ARow]);
end;

在禁用默认绘图的情况下,网格绘制网格框架和网格线,但将所有其他绘图留给程序员。需要注意的是,如果需要,您必须自己添加精美的主题图。 通过上面的编码,我得到了这个结果:

我假设你(想要)使用默认的 DefaultDrawing = True 设置,否则你的问题不存在。

  1. 要去掉focus rect,需要重新绘制(因为是异或运算,focus rect会消失),或者不绘制。

    利用OnDrawCell事件再次绘制:

    procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    begin
      if gdFocused in State then
        DrawFocusRect(StringGrid1.Canvas.Handle, Rect);
    end;
    

    完全阻止它绘制,例如通过禁用将焦点设置到 StringGrid 的可能性来完成。我假设您不使用它的编辑器,因此应该不会产生进一步的可用性问题。

    type
      TStringGrid = class(Vcl.Grids.TStringGrid)
      public
        function CanFocus: Boolean; override;
      end;
    
    function TStringGrid.CanFocus: Boolean;
    begin
      Result := False;
    end;
    

    这实际上是一个有点奇怪的工作解决方案,因为您仍然可以使用 Tab 键进入控件并且它会不断响应键盘事件。

  2. 我无法使用此代码(此处为 XE2)重现您的 cliping 问题:

    procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    begin
      if gdSelected in State then
      begin
        StringGrid1.Canvas.Brush.Color := [=12=]940A4B;
        StringGrid1.Canvas.FillRect(Rect);
        StringGrid1.Canvas.Font.Style := [fsBold];
        StringGrid1.Canvas.Font.Color := clHighlightText;
        StringGrid1.Canvas.TextOut(Rect.Left + 3, Rect.Top + 5,
          StringGrid1.Cells[ACol, ARow]);
      end;
    end;
    

    Rect 将是并且是正确的 CellRect。剪辑效果是由于其他原因造成的。

    但是如果 XE8 的源代码中确实存在像 这样的虚假 +4,这很容易被 -4 克服,那么这显然是一个错误,应该是已报告。