Скрытие focusRectangle для StringGrid: Delphi

Я пытаюсь скрыть границу (прямоугольник фокуса), которую Delphi рисует вокруг текущей выбранной ячейки в StringGrid. Я делаю рисунок владельца, чтобы настроить внешний вид сетки струн. Мне удалось избавиться от всего, кроме выделения.

Я использовал

 GR.Left := -1;
 GR.Top  := -1;
 GR.Right := -1;
 GR.Bottom := -1;
 StringGrid.Selection := GR;

Но это дает ошибки, если вы устанавливаете это очень быстро (у меня это работает в onMouseMove). Я имею в виду, что он работает нормально, но если я вызываю этот конкретный фрагмент кода достаточно быстро, я получаю исключение при рендеринге StringGrid (поэтому я не могу просто отбросить попытку, кроме как вокруг него).

Есть идеи о том, как я могу надежно решить эту проблему?


delphi ownerdrawn tstringgrid stringgrid
person Daisetsu    schedule 23.05.2013    source источник
comment
Привет, Дайетсу, вы пробовали TZColorStringGrid? Он является потомком TStringGrid и имеет возможность персонализировать каждую ячейку. Может быть, вы можете посмотреть: avemey.com   -  person Cristian Vasuica    schedule 23.05.2013

Ответы (3)


arrow_upward
2
arrow_downward

Вы можете использовать класс-переходник для TStringgrid и переопределить процедуру Paint, чтобы удалить нарисованный прямоугольник фокуса.

unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids;

type
  TStringgrid=Class(Grids.TStringGrid)
  private
    FHideFocusRect: Boolean;
  protected
     Procedure Paint;override;
  public
     Property HideFocusRect:Boolean Read FHideFocusRect Write FHideFocusRect;
  End;
  TForm2 = class(TForm)
    StringGrid1: TStringGrid;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
  public
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

procedure TStringgrid.Paint;
var
 L_Rect:Trect;
begin
  inherited;
   if HideFocusRect then
      begin
       L_Rect := CellRect(Col,Row);
       if DrawingStyle = gdsThemed then InflateRect(L_Rect,-1,-1);
       DrawFocusrect(Canvas.Handle,L_Rect)
      end;
end;

procedure TForm2.Button1Click(Sender: TObject);
begin
   StringGrid1.HideFocusRect := not StringGrid1.HideFocusRect;
end;

end.
person bummi    schedule 23.05.2013

arrow_upward
1
arrow_downward

В событии OnDrawCell добавить

with Sender as TStringgrid do
begin
    if (gdSelected in State) then
    begin
        Canvas.Brush.Color := Color;
        Canvas.Font.Color := Font.Color;
        Canvas.TextRect(Rect, Rect.Left +2,Rect.Top +2, Cells[Col,Row]);
    end;
end;

В событии OnSelectCell добавьте

CanSelect := False

person sav    schedule 31.03.2015

arrow_upward
0
arrow_downward

Установите для свойства DefaultDrawing значение false, а событие onDrawCell нарисуйте текст примерно так (это также меняет цвет строки и центральный текст в ячейке):

procedure GridDrawCell(Sender: TObject; ACol,ARow: Integer; Rect: TRect; State: TGridDrawState);
var S: string;
        c:TColor;
        SavedAlign: word;
begin
  S := Grid.Cells[ACol, ARow];
  SavedAlign := SetTextAlign(Grid.Canvas.Handle,TA_CENTER); 
  if (ARow mod 2 = 0)
  then c:=clWhite
  else c:=$00E8E8E8;
  // Fill rectangle with colour
  Grid.Canvas.Brush.Color := c;
  Grid.Canvas.FillRect(Rect);
  // Next, draw the text in the rectangle
  if (ACol=1) or (ACol=3) or (ACol=5) then
  begin
    Grid.Canvas.Font.Color := $005F5F5F; 
  end
  else
  begin
    Grid.Canvas.Font.Color := $005F5F5F;
  end;
    Grid.Canvas.TextRect(Rect,Rect.Left + (Rect.Right - Rect.Left) div 2, Rect.Top + 2, S);
    SetTextAlign(Grid.Canvas.Handle, SavedAlign);
end;
person Xalo    schedule 21.08.2015