Выделение ячейки в StringGrid

@ExBan · Регистрация: 28.07.2020

Студворк — интернет-сервис помощи студентам

Ребят всем привет есть такое дело, переношу я значит текст в ячейках но при этом мне нужно выключить DefaultDrawing если я это делаю у меня проподает выделение ячейки что можно сделать чтобы ее снова выделить.
Включить DefaultDrawing не получится по скольку 2 раза отобразится текст помогите пожалуйста
Вот текст события drawcell:

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
procedure TForm1.SGDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
var
  Format: Word;
  txt: string;
begin
  with Sender as TStringGrid do
  begin
    Options := Options + [goRowSizing];
    Options := Options + [goColSizing];
    txt := Cells[ACol, ARow];
    Canvas.FillRect(Rect);
    Canvas.Font.Size := 10;
    DrawText(Canvas.Handle, PChar(Cells[ACol, ARow]), Length(Cells[ACol, ARow]), Rect, DT_CENTER or DT_WORDBREAK or DT_EXPANDTABS);
  end;
end;

@krapotkin · 21.09.2020, 19:53

если вы сами рисуете ячейку, так и рисуйте
если у вас State = dsSelected то рисуйте фон и текст другим цветом

@ExBan · 22.09.2020, 09:21 **[ТС]**

Нет вы меня скорее всего не правильно поняли мне нужно выделать ячейку по которой я кликнул мышкой при включенной функции DefaultDrawing эта ячейка выделяется пунктиром по краю ячейки вот мне и нужно сделать это выделение только вот как я не могу допереть

Добавлено через 1 час 5 минут
krapotkin, Не могли бы вы подсказать как именно рисовать этот фон и текст, просто если я прописываю условие

Delphi
1
if state = dsSelected of

то у меня на dsSelected выдает ошибку

@AzAtom · 22.09.2020, 09:29

ExBan, версия дельфи какая?

@ExBan · 22.09.2020, 09:32 **[ТС]**

AzAtom, 10.2

@mr-Crocodile · 22.09.2020, 09:37

Сообщение от ExBan

то у меня на dsSelected выдает ошибку

там, по моему,

Delphi
1
gdSelected

DenNik · 22.09.2020, 09:37

Сообщение от ExBan

if state = dsSelected of

сплошная ошибка!!!

Delphi
1
if gdSelected in State then

@AzAtom · 22.09.2020, 09:39

ExBan, вот так нормально?

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
  Format: Word;
  txt: string;
begin
  with Sender as TStringGrid do
  begin
//    Options := Options + [goRowSizing]; // Их можно один раз заранее настроить при создании формы
//    Options := Options + [goColSizing];
    if gdSelected in State then Canvas.Brush.Color := clGray
                           else Canvas.Brush.Color := clWhite;
    txt := Cells[ACol, ARow];
    Canvas.FillRect(Rect);
    Canvas.Font.Size := 10;
    DrawText(Canvas.Handle, PChar(Cells[ACol, ARow]), Length(Cells[ACol, ARow]), Rect, DT_CENTER or DT_WORDBREAK or DT_EXPANDTABS);
  end;
end;

@mr-Crocodile · 22.09.2020, 09:40

ну и проверять лучше

Delphi
1
if (gdSelected in State)

а ещё, в исходниках проверяется

Delphi
1
2
and (gdFocused in State) or 
([goDrawFocusSelected, goRowSelect] * Options <> [])) then

ОПОЗДАЛ...

DenNik · 22.09.2020, 09:41

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
var
  Format: Word;
  txt: string;
begin
  with Sender as TStringGrid do
  begin
    Options := Options + [goRowSizing];
    Options := Options + [goColSizing];
    txt := Cells[ACol, ARow];
    Canvas.FillRect(Rect);
    Canvas.Font.Size := 10;
    DrawText(Canvas.Handle, PChar(Cells[ACol, ARow]), Length(Cells[ACol, ARow]), Rect, DT_CENTER or DT_WORDBREAK or DT_EXPANDTABS);
  end;
end;

1. Опции настраиваются один раз. Зачем при каждой отрисовке ячейки настраивать одно и тоже?!
2. Опции - это множество. Можно так: Options := Options + [goRowSizing,goColSizing] - [goEditing];
3. Format не используется в коде. Зачем объявлена эта переменная? тоже самое насчёт txt

@AzAtom · 22.09.2020, 09:48

Если нужен пунктир, то можно так:

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
  Format: Word;
  txt: string;
  OCol: TColor;
  OStyle: TPenStyle;
begin
  with Sender as TStringGrid do
  begin
    txt := Cells[ACol, ARow];
    Canvas.FillRect(Rect);
    if gdSelected in State then begin
      OStyle := Canvas.Pen.Style;
      Canvas.Pen.Style := psDot;
      OCol := Canvas.Pen.Color;
      Canvas.Pen.Color := clRed;
      Canvas.Rectangle(Rect);
      Canvas.Pen.Color := OCol;
      Canvas.Pen.Style := OStyle;
    end;
    Canvas.Font.Size := 10;
    DrawText(Canvas.Handle, PChar(Cells[ACol, ARow]), Length(Cells[ACol, ARow]), Rect, DT_CENTER or DT_WORDBREAK or DT_EXPANDTABS);
  end;
end;

@ExBan · 22.09.2020, 09:56 **[ТС]**

DenNik, просто там много стриггридов которые используют drawcell было просто удобно добавить опцию сюда чтобы все они получили эту опцию

Добавлено через 1 минуту
AzAtom, все четко работает, можешь объяснить почему теперь defaultdrawing не рисует текст заново?

@AzAtom · 22.09.2020, 10:02

Сообщение от ExBan

почему теперь defaultdrawing не рисует текст заново?

С твоим первым вариантом тоже текст было видно один раз. Он двоится, если не заливать ячейку.

Если DefaultDrawing включен, то ячейка будет рисоваться дважды. Первый раз сам грид рисует, а второй раз рисует обработчик. Просто в твоём случае уже нарисованный текст закрашивается.

Добавлено через 1 минуту

Сообщение от ExBan

он оставляет пунктир активным

Странно. У меня нормально всё двигается, никаких лишних следов не остаётся.

DenNik · 22.09.2020, 10:03

Сообщение от ExBan

Включить DefaultDrawing не получится

ты можешь отключать DefaultDrawing в нужный момент. Пример: фиксированные ячейки рисуются Vcl, обычные - вручную

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
procedure TForm2.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
begin
  with StringGrid1 do
  begin
    DefaultDrawing:= (gdFixed in State);
    if not DefaultDrawing then
    begin
      Canvas.Brush.Color:= clLime;
      if (gdSelected in State) then Canvas.Brush.Color:= clNavy;
      Canvas.FillRect(CellRect(ACol,ARow));
      Canvas.TextOut(Rect.Left+3,Rect.Top+2,Cells[ACol,ARow]);
    end;
  end;
end;

@ExBan · 22.09.2020, 10:05 **[ТС]**

AzAtom, есть такой вопрос можно ли текст вывести по центру не только по горизонтали но и по вертикали?

DenNik · 22.09.2020, 10:08

Сообщение от ExBan

удобно добавить опцию сюда чтобы все они получили эту опцию

ну так и настрой один раз ВСЕ гриды. Зачем дёргать миллион раз одно и тоже? а по-хорошему: пишется наследник грида, в котором задаётся нужный функционал

Добавлено через 2 минуты

Сообщение от ExBan

можно ли текст вывести по центру не только по горизонтали но и по вертикали?

ну вот ты написал

Сообщение от ExBan

DT_CENTER or DT_WORDBREAK or DT_EXPANDTABS

почему бы не поковыряться в исходниках и не посмотреть, что ещё есть, кроме этих флагов? )
это намёк, если что

@ExBan · 22.09.2020, 10:22 **[ТС]**

DenNik, Весь прикол в том что я ковырялся в них но у меня не получилось выравнять текст вот и спрашиваю) я приписывал dt_vcenter

Добавлено через 5 минут
DenNik, Все разобрался спасибо)

DenNik · 22.09.2020, 10:28

отично. вот, разбирайся ещё. здесь реализован наследник и методы, о которых ты стопудово не знал)

Кликните здесь для просмотра всего текста

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
unit Unit2;
 
interface
 
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Grids;
 
type
  TStringGrid = class(Vcl.Grids.TStringGrid)  {НАСЛЕДНИК}
  protected
    procedure DrawCell(ACol: Integer; ARow: Integer; ARect: TRect;
      AState: TGridDrawState); override;
  end;
 
  TForm2 = class(TForm)
    StringGrid1: TStringGrid;
    procedure FormCreate(Sender: TObject);
  end;
 
var
  Form2: TForm2;
 
implementation
 
{$R *.dfm}
 
procedure TForm2.FormCreate(Sender: TObject);
begin
  StringGrid1.Cells[0,0]:= 'Hello';
  StringGrid1.Cells[1,1]:= 'World';
end;
 
{ TStringGrid }
 
procedure TStringGrid.DrawCell(ACol, ARow: Integer; ARect: TRect;
  AState: TGridDrawState);
var
  aText: string;
begin
  if DefaultDrawing then inherited else
  begin
    if (gdFixed in AState) then DrawCellBackground(ARect,FixedColor,AState,ACol,ARow) else
    if (gdSelected in AState) then DrawCellHighlight(ARect,AState,ACol,ARow) else
    DrawCellBackground(ARect,Color,AState,ACol,ARow);
    Canvas.Brush.Style:= bsClear;
    Canvas.Rectangle(Bounds(ARect.Left-1,ARect.Top-1,ARect.Width+2,ARect.Height+2));
    Canvas.Font:= Font;
    aText:= Cells[ACol,ARow];
    Canvas.TextRect(ARect,aText,[tfCenter,tfVerticalCenter,tfSingleLine]);
  end;
end;
 
end.

с отключённым DefFraw

DenNik · 22.09.2020, 10:35

Canvas.Rectangle убери - это с другого проекта копипаста

DenNik · 22.09.2020, 11:23

Нашёл в недрах Vcl функцию GradientFillCanvas (используется в том числе при отрисовке TStringGrid). Можно творить красоту

Новые блоги и статьи Все статьи Все блоги /
Модель заражения группы наркоманов alhaos 17.04.2026 Условия задачи сформулированы тут Суть: - Группа наркоманов из 10 человек. - Только один инфицирован ВИЧ. - Колются одной иглой. - Колются раз в день. - Колются последовательно через. . .	Мысли в слух. Про "навсегда". kumehtar 16.04.2026 Подумалось тут, что наверное очень глупо использовать во всяких своих установках понятие "навсегда". Это очень сильное понятие, и я только начинаю понимать край его смысла, не смотря на то что давно. . .	My Business CRM MaGz GoLd 16.04.2026 Всем привет, недавно возникла потребность создать CRM, для личных нужд. Собственно программа предоставляет из себя базу данных клиентов, в которой можно фиксировать звонки, стадии сделки, а также. . .	Знаешь почему 90% людей редко бывают счастливыми? kumehtar 14.04.2026 Потому что они ждут. Ждут выходных, ждут отпуска, ждут удачного момента. . . а удачный момент так и не приходит.
Фиксация колонок в отчете СКД Maks 14.04.2026 Фиксация колонок в СКД отчета типа Таблица. Задача: зафиксировать три левых колонки в отчете. Процедура ПриКомпоновкеРезультата(ДокументРезультат, ДанныеРасшифровки, СтандартнаяОбработка) / / . . .	Настройки VS Code Loafer 13.04.2026 { "cmake. configureOnOpen": false, "diffEditor. ignoreTrimWhitespace": true, "editor. guides. bracketPairs": "active", "extensions. ignoreRecommendations": true, . . .	Оптимизация кода на разграничение прав доступа к элементам формы Maks 13.04.2026 Алгоритм из решения ниже реализован на нетиповом документе, разработанного в конфигурации КА2. Задачи, как таковой, поставлено не было, проделанное ниже исключительно моя инициатива. Было так:. . .	Контроль заполнения и очистка дат в зависимости от значения перечислений Maks 12.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "ПланированиеПерсонала", разработанного в конфигурации КА2. Задача: реализовать контроль корректности заполнения дат назначения. . .

@krapotkin 6851 / 4677 / 1465 Регистрация: 14.04.2014 Сообщений: 20,674 Записей в блоге: 21
	21.09.2020, 19:53
	если вы сами рисуете ячейку, так и рисуйте если у вас State = dsSelected то рисуйте фон и текст другим цветом 0

@AzAtom Модератор 4149 / 2360 / 812 Регистрация: 15.11.2015 Сообщений: 9,461
	22.09.2020, 09:29
	ExBan, версия дельфи какая? 0

@ExBan 0 / 0 / 0 Регистрация: 28.07.2020 Сообщений: 47
	22.09.2020, 09:32 [ТС]
	AzAtom, 10.2 0

@ExBan 0 / 0 / 0 Регистрация: 28.07.2020 Сообщений: 47
	22.09.2020, 09:56 [ТС]
	DenNik, просто там много стриггридов которые используют drawcell было просто удобно добавить опцию сюда чтобы все они получили эту опцию Добавлено через 1 минуту AzAtom, все четко работает, можешь объяснить почему теперь defaultdrawing не рисует текст заново? 0

@ExBan 0 / 0 / 0 Регистрация: 28.07.2020 Сообщений: 47
	22.09.2020, 10:05 [ТС]
	AzAtom, есть такой вопрос можно ли текст вывести по центру не только по горизонтали но и по вертикали? 0

@ExBan 0 / 0 / 0 Регистрация: 28.07.2020 Сообщений: 47
	22.09.2020, 10:22 [ТС]
	DenNik, Весь прикол в том что я ковырялся в них но у меня не получилось выравнять текст вот и спрашиваю) я приписывал dt_vcenter Добавлено через 5 минут DenNik, Все разобрался спасибо) 0

DenNik Житель Земли 3004 / 3026 / 390 Регистрация: 26.07.2011 Сообщений: 11,465 Записей в блоге: 1
	22.09.2020, 10:35
	`Canvas.Rectangle` убери - это с другого проекта копипаста 0

DenNik Житель Земли 3004 / 3026 / 390 Регистрация: 26.07.2011 Сообщений: 11,465 Записей в блоге: 1
	22.09.2020, 11:23
	Нашёл в недрах Vcl функцию `GradientFillCanvas` (используется в том числе при отрисовке TStringGrid). Можно творить красоту Миниатюры 1

Выделение ячейки в StringGrid

Решение