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

让人想犯罪 __ 提交于 2020-05-23 10:56:13

问题


I am trying to write custom date picker(calendar). The dates will be displayed on the stringgrid. I am trying to fill the clicked cell with a custom color and make that selected celltext bold.

Here is my code:

    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 := $00940A4B;
        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;

The output, I am getting:

Problem #1: I need to hide that unwanted rectangle appearing as border for the selected cell

Problem #2: Avoid the cell background clipping


回答1:


In the OnDrawCell procedure add just before FillRect

Rect.Left := Rect.Left-4;

Seems to work.


An alternative

The above doesn't fully solve the focus issue even with your paint procedure addon. Sometimes a white line is visible just inside the cell borders.

But the following is an alternative, that solves both your issues. It requires a little more coding, but not so much. On the other hand, subclassing TStringGrid is not needed, neither the Rect adjustment

The basis is to disable default drawing, so set the grids property DefaultDrawing := false; and then add to the OnDrawCell event:

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 := $00940A4B;
    StringGrid.Canvas.Font.Style := [fsBold];
    StringGrid.Canvas.Font.Color := clHighlightText;
  end
  else
  begin
    StringGrid.Canvas.Brush.Color := $00FFFFFF;
    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;

With default drawing disabled, the grid draws the grid frame and the grid lines, but leaves all other drawing to the programmer. The caveat is that you have to add fancy themed drawing yourself if you need it. With above coding I get this result:




回答2:


I assume you (want to) use the default DefaultDrawing = True setting, otherwise your question does not exist.

  1. To get rid of the focus rect, you need to draw it again (because it is a XOR-operation, the focus rect will disappear), or prevent it from being drawn.

    Drawing again is done by utilizing the OnDrawCell event:

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

    Preventing it from drawing at all e.g. is done by disabling the possibility to set focus to the StringGrid. I assume you do not use its editor, so that should give no further usability concerns.

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

    This actually is a bit strange working solution, because you are still able to tab into the control and it keeps responding to keyboard events.

  2. I cannot reproduce your cliping problem with this code (XE2 here):

    procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    begin
      if gdSelected in State then
      begin
        StringGrid1.Canvas.Brush.Color := $00940A4B;
        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;
    

    The Rect will be and ís the correct CellRect. The cliping effect is due to something else elsewhere.

    But if there really is a spurious +4 in the source code of XE8 like Tom Brunberg mentions, which is easily overcome with -4, then that obviously is a bug and should be reported.



来源:https://stackoverflow.com/questions/33120729/how-to-fill-cell-of-a-string-grid-using-custom-color

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!