Delphi: установите флажок внутри DBGrid (тематический)

Я использую следующий код, чтобы показать флажок внутри DBGrid. Он работает (по крайней мере, ожидалось) как в тематическом, так и в нетематическом стиле VCL (проверено в XE2, XE7 и Берлине):

uses Vcl.Themes;

procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
  DataCol: Integer; Column: TColumn; State: TGridDrawState);
const
  CtrlState: Array[Boolean] of Integer = (DFCS_BUTTONCHECK, DFCS_BUTTONCHECK or DFCS_CHECKED);
  CtrlStateXP: Array[Boolean] of TThemedButton = (tbCheckBoxUncheckedNormal, tbCheckBoxCheckedNormal);
var
  CheckBoxRectangle : TRect;
  Details: TThemedElementDetails;
begin
  if Column.Field.DataType = ftBoolean then
  begin
    Column.Title.Alignment := taCenter;
    Column.Alignment := taCenter;
    TDBGrid(Sender).Canvas.FillRect(Rect);

    if ThemeServices.ThemesEnabled then
    begin
      Details := ThemeServices.GetElementDetails(CtrlStateXP[Column.Field.AsBoolean]);
      ThemeServices.DrawElement(TDBGrid(Sender).Canvas.Handle, Details, Rect);
    end
    else
    begin
      CheckBoxRectangle.Left   := Rect.Left + 2;
      CheckBoxRectangle.Right  := Rect.Right - 2;
      CheckBoxRectangle.Top    := Rect.Top + 2;
      CheckBoxRectangle.Bottom := Rect.Bottom - 2;
      DrawFrameControl(TDBGrid(Sender).Canvas.Handle, CheckBoxRectangle, DFC_BUTTON, CtrlState[Column.Field.AsBoolean]);
    end;
  end;
end;

Он работает нормально, за исключением того, что когда я перемещаюсь по строкам, стиль становится «странным», как показано ниже:

тематическая проблема

Любая помощь? Спасибо.


checkbox themes delphi dbgrid
person R.P Silveira    schedule 16.03.2017    source источник
comment
FillRect выглядит неправильно. Разве это не должно заставить тематические сервисы рисовать родительский фон?   -  person David Heffernan    schedule 16.03.2017

Ответы (1)


arrow_upward
1
arrow_downward

После некоторых попыток и исследований мне удалось адаптировать метод самостоятельно, просто добавив следующие строки:

  if not (gdFocused in State) then
    Grid.Canvas.Brush.Color := StyleServices.GetSystemColor(clHighlight);

Здесь я делюсь полным методом. Может кому пригодится :-)

uses Vcl.Themes;

procedure CheckBoxGrid(FieldName: String; ValueCheck: Variant; Grid: TDBGrid; const Rect: TRect; Column: TColumn; State: TGridDrawState);
const
  CtrlState: Array[Boolean] of Integer = (DFCS_BUTTONCHECK, DFCS_BUTTONCHECK or DFCS_CHECKED);
  CtrlStateXP: Array[Boolean] of TThemedButton = (tbCheckBoxUncheckedNormal, tbCheckBoxCheckedNormal);
var
  R: TRect;
  Details: TThemedElementDetails;
begin
  if Column.FieldName = FieldName then
  begin
    Column.Title.Alignment := taCenter;
    Column.Alignment := taCenter;
    Grid.Canvas.FillRect(Rect);

    if StyleServices.Enabled then
    begin
      Details := StyleServices.GetElementDetails(CtrlStateXP[Column.Field.Value = ValueCheck]);
      StyleServices.DrawElement(Grid.Canvas.Handle, Details, Rect);

      if not (gdFocused in State) then
        Grid.Canvas.Brush.Color := StyleServices.GetSystemColor(clHighlight);
    end
    else
    begin
      R := Rect;
      InflateRect(R, -2, -2);
      DrawFrameControl(Grid.Canvas.Handle, R, DFC_BUTTON, CtrlState[Column.Field.Value = ValueCheck]);
    end;
  end;
end;​
person R.P Silveira    schedule 17.03.2017