TDBGrid: данные OnDrawColumnCell перекрываются

Я работаю над Delphi 10.2 и SQL Server 2008.

Мне нужно изменить какое-то значение в TDBGrid. когда я изменяю значение с помощью OnDrawColumnCell, данные перекрываются, когда я нажимаю на этот столбец, и то же самое отлично работает в Delphi 7.

введите здесь описание изображения

Пример кода:

Создайте таблицу и вставьте некоторые данные в SQL Server 2008.

CREATE TABLE [dbo].[Persons](
    [P_ID] [int] IDENTITY(1,1) NOT NULL PRIMARY KEY,
    [LastName] [varchar](15) NOT NULL,
)
insert into Persons (LastName) values ('LastName')

Создание нового приложения VCL Forms — Delphi

Для отображения данных в DBGrid я использую TADOCOnnection, TADOQuery, TDataSource и TDBGrid.

установить TADOQuery.SQL на "select LastName from Persons"

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, DBGrids, DB, ADODB, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    ADOConnection1: TADOConnection;
    ADOQuery1: TADOQuery;
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    procedure FormShow(Sender: TObject);
    procedure DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
      DataCol: Integer; Column: TColumn; State: TGridDrawState);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormShow(Sender: TObject);
begin
  ADOQuery1.Active := False;
  ADOQuery1.Active := True;
end;

procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
  DataCol: Integer; Column: TColumn; State: TGridDrawState);
Var
  CellData : String;
begin
  CellData := Column.Field.DisplayText;

  if Column.Field.FieldName = 'LastName' then
  begin
    CellData := 'change';
    DBGrid1.Canvas.TextRect(Rect, Rect.Left, Rect.Top, CellData);
  end
  else
    DBGrid1.DefaultDrawColumnCell(Rect, DataCol, Column, state);
end;

end.

delphi delphi-10.2-tokyo tdbgrid
person DelphiLearner    schedule 13.04.2018    source источник
comment
Для Delphi 7 вы, вероятно, не включили манифест для тем, и приложение было отрисовано с тем древним видом Windows 2000. Короче говоря, вы просто рисуете текст, и вот что происходит. Этого не достаточно. Перед этим необходимо очистить фон (с помощью DrawCellHighlight(..) или DrawCellBackground(..)). Если вам нужен подробный ответ на это, пожалуйста, дайте мне знать.   -  person Günther the Beautiful    schedule 13.04.2018
comment
@GünthertheBeautiful: Не могли бы вы дать мне подробный ответ.   -  person DelphiLearner    schedule 13.04.2018
comment
Кажется, что это большая работа, чтобы изменить текст. Почему бы просто не создать вычисляемое поле, провести тестирование в OnCalcs, а затем использовать вычисляемое поле в сетке? Или я что-то упускаю...   -  person John Easley    schedule 13.04.2018
comment
@JohnEasley: мне нужно добавить несколько раскрывающихся списков в dbgrid .... поэтому мне нужно обработать OnDrawColumnCell. если в dbgrid нет раскрывающихся списков, я выберу CalcFeild. Спасибо.   -  person DelphiLearner    schedule 17.04.2018

Ответы (2)


arrow_upward
2
arrow_downward

Это общая проблема рисования, не связанная с SQL Server или TDBGrid в частности. То же самое относится к рисованию в VCL TCanvas или что-то подобное.

Очистите область перед рисованием текста

Вы звоните Canvas.TextRect(..), но не более того. Текст нарисуется, но не более того. Сначала вам придется очистить область: представьте, что вы рисуете белый фон, а затем рисуете черный текст.

TDBGrid предлагает удобный метод DrawCellBackground(..). Поскольку этот метод не является общедоступным, его необходимо реализовать с помощью вспомогательных классов.

Пример реализации

Следующий код использует DrawCellHighlight(..) для очистки области рисования ячейки, когда ячейка выбрана, и DrawCellBackground(..) в противном случае.

type
    TDBGridHelper = class helper for TDBGrid
        public const textPaddingPx = 2; // Siehe TDBGrid::DefaultDrawColumnCell
        public procedure writeText(
            const   inRect:         TRect;
            const   text:           String;
            const   State:          TGridDrawState;
            const   columnIndex:    Integer
        );
    end;

procedure TDBGridHelper.writeText(
    const   inRect:         TRect;
    const   text:           String;
    const   State:          TGridDrawState;
    const   columnIndex:    Integer
);
const
    cellGridPx = 1;
var
    backgroungRect: TRect;
begin
    backgroungRect := inRect;
    backgroungRect.Inflate(-cellGridPx, -cellGridPx);

    if (Vcl.Grids.gdSelected in State) then
        DrawCellHighlight(inRect, State, columnIndex, 0)
    else
        DrawCellBackground(backgroungRect, self.Color, State, Columnindex, 0);

    Canvas.TextRect(
        inRect,
        inRect.Left + textPaddingPx,
        inRect.Top + textPaddingPx,
        text
    );
end;

Использование события TDBGrid.OnDrawColumnCell было абсолютно правильным, теперь вы можете упростить его до чего-то вроде

procedure TYourFrame.dbGridDrawColumnCell(
    Sender: TObject;
    const Rect: TRect;
    DataCol: Integer;
    Column: TColumn;
    State: TGridDrawState
);
var
    columnText:     String;
begin
    columnText := '---';
    if Assigned(Column.Field) then begin
        if (Column.FieldName = 'yourField') then
            columnText := getDeviationColumnText(Column.Field.AsSingle)
        else
            // This is the default text
            columnText := Column.Field.DisplayText; 
    end;
    (Sender as TDBGrid).writeText(Rect, columnText, State, Column.Index);
end;
person Günther the Beautiful    schedule 13.04.2018
comment
Есть ли другой способ сделать? . Потому что у меня около 30 форм :) - person DelphiLearner; 13.04.2018
comment
Вам просто нужно написать свой вспомогательный класс один раз, и ваши события OnDrawColumnCell останутся прежними. За исключением того, что DBGrid1.Canvas.TextRect(..) теперь становится DBGrid1.writeText(..). - person Günther the Beautiful; 13.04.2018
comment
Я добавил еще один ответ, который определенно является неправильным подходом, но также выполнит свою работу. - person Günther the Beautiful; 13.04.2018

arrow_upward
0
arrow_downward

Если прохождение 30 форм слишком утомительно, вы можете отключить «Темы выполнения», чтобы вернуться к тому причудливому виду Windows 2000 и алгоритмам рисования, которые были с ним.

  1. Выберите «Проект» > «Параметры» > «Приложение».
  2. Снимите флажок «Включить темы выполнения».

Источник: http://docwiki.embarcadero.com/RADStudio/en/Disabling_Themes_in_the_IDE_and_in_Your_Application

person Günther the Beautiful    schedule 13.04.2018
comment
не удалось снять флажок «Включить темы выполнения». я очищаю и создаю проект, и он возвращается к предыдущему значению. - person DelphiLearner; 13.04.2018