Отрисовка ячеек в TStrungGrid

[bestonix]

Доброго здоровья уважаемые.

Есть такой вот код. Он отлично работает в Delphi, C++Builder. А вот в Lazarus получается нечто...
Вобщем вот. Сначала просто присваиваю значения ячейкам.
FMain.sgCostTest.Cells[0, 0] := '№ вопроса';
FMain.sgCostTest.Cells[1, 0] := 'Количество ответов';
FMain.sgCostTest.Cells[2, 0] := '№№ ответов';
FMain.sgCostTest.Cells[3, 0] := 'Количество баллов';
FMain.sgCostTest.Cells[4, 0] := 'Тема вопроса';
Затем в стандартном событии DrawCell пишу такой код. По задумке должно отрисовываться так, заголовки в центре с переносом слов.
procedure TFMain.sgCostTestDrawCell(Sender: TObject; aCol, aRow: Integer;
aRect: TRect; aState: TGridDrawState);
var
s : string;
Flag : cardinal;
H : integer;
begin
if (ARow and ACol > 0) then
case (ARow mod 2) of
0 : begin sgCostTest.Canvas.Font.Color := clBlack;
sgCostTest.Canvas.FillRect(aRect);
sgCostTest.Canvas.Brush.Color := TColor($CCFFCC);
end;
else begin
sgCostTest.Canvas.Font.Color := clBlack;
sgCostTest.Canvas.FillRect(aRect);
sgCostTest.Canvas.Brush.Color := TColor($CCCCFF);
end;
end;

sgCostTest.Canvas.FillRect(aRect);
s := UTF8ToAnsi(sgCostTest.Cells[aCol, aRow]);
//StrPCopy(s, sgCostTest.Cells[aCol, aRow]);
Flag := DT_CENTER;
if (aRow>0) then begin
case (aCol) of
4 : begin Flag := DT_LEFT; end;
else
Flag := DT_CENTER;
end;
end else Flag := DT_CENTER;

Flag := Flag or DT_WORDBREAK;
Inc(aRect.Left, 3);// := aRect.Left + 3;
Dec(aRect.Right, 3);// := aRect.Right - 3;
H := DrawText(sgCostTest.Canvas.Handle, PChar(s), Length(s), aRect, Flag);
if (H > sgCostTest.RowHeights[aRow]) then
sgCostTest.RowHeights[aRow] := H; //увеличиваем высоту }
end;

Результат во "прицепе". Что не так ?

Добавлено спустя 1 час 3 минуты 23 секунды:
Еще вопрос в этой же теме. Касается этой же странички, но немного по другому поводу.
Нужно на StriungGrid'е при выборе последней колонки чтобы по размерам колонки в соответствующей строке показывался ComboBox.
Пишу такой код, но Lazarus...
1. Кричит что нет такой функции как ClientToParent
2. Функция ClientToScreen ясно дело отрисовывает его по своему разумению относительно экранных координат.

procedure TFMain.sgCostTestClick(Sender: TObject);
var CellRect : TRect;
pt : TPoint;
begin
if sgCostTest.Col=4 then begin
CellRect := sgCostTest.CellRect(sgCostTest.Col, sgCostTest.Row);
pt := sgCostTest.ClientToScreen( Point(CellRect.Left, CellRect.Top) );
//pt := sgCostTest.ClientToParent(Point(CellRect.Left, CellRect.Top));
CB_Theme.Left := pt.X;
CB_Theme.Top := pt.Y-12;
CB_Theme.Width := CellRect.Right - CellRect.Left;
CB_Theme.Visible := true;
CB_Theme.BringToFront;
end;
end;

Подозреваю, что нужно подключить соответствующий модуль. Но не нашел где он находится

[dunin]

Дмитрий, ИМХО такая петрушка: у тебя два раза прорисовка идет. Компонент написан так, что тебе только кажется, что ты перекрываешь стандартную отрисовку. На самом деле она все равно отрабатывает. И получается, что твой текст накладывается сверху (или снизу - не суть важно).

Я бы копал в сторону:
1. Перед перерисовкой перезалить канву как-то. Типа перед своей затереть стандартную отрисовку (по опыту общения с Лазарусом - скорее всего не поможет).
2. Заглянул с исходник компонента - создал подобный со свой отрисовкой.

С последним ты запросто справишься.

[bestonix]

Дмитрий, ИМХО такая петрушка: у тебя два раза прорисовка идет. Компонент написан так, что тебе только кажется, что ты перекрываешь стандартную отрисовку. На самом деле она все равно отрабатывает. И получается, что твой текст накладывается сверху (или снизу - не суть важно).

Ничего не кажется. В Delphi, C++Builder работает жеж как надо. И полагаю в Лазаре тоже должно работать как ожидаю

Я бы копал в сторону:
1. Перед перерисовкой перезалить канву как-то. Типа перед своей затереть стандартную отрисовку (по опыту общения с Лазарусом - скорее всего не поможет).

Первое что пришло в голову. Но тогда прорисовка ничем хорошим не заканчивается. Пусто-пусто получается.

2. Заглянул с исходник компонента - создал подобный со свой отрисовкой.

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

[Putnick]

Уважаемый bestonix!
Простите, что вмешиваюсь, но не может ли быть так, что Вы забыли переключить свойство StringGrid.DefaultDrawing в False.
Сам несколько раз на такое нарывался, Лазарус почему-то отрабатывает OnDrawCell даже если стоит DefaultDrawing:=True, хотя должен бы использовать только стандартную отрисовку. В результате — сначала отрисовывается "как положено", а потом — "как надо".

Надеюсь, смог помочь. С уважением, Алексей.

[Максим]

Тынц.

[bestonix]

Уважаемый bestonix!
Простите, что вмешиваюсь, но не может ли быть так, что Вы забыли переключить свойство StringGrid.DefaultDrawing в False.
Сам несколько раз на такое нарывался, Лазарус почему-то отрабатывает OnDrawCell даже если стоит DefaultDrawing:=True, хотя должен бы использовать только стандартную отрисовку. В результате — сначала отрисовывается "как положено", а потом — "как надо".

Надеюсь, смог помочь. С уважением, Алексей.

Уважаемый Putnick, благодарю за вмешательство.
Действительно изменение св-ва на false решает эту задачу.
Но к сожалению на половину, цвет заголовков меняется на цвет ячеек ( в моём случае на радикально белый).

Добавлено спустя 1 минуту 34 секунды:

Тынц.

Уважаемый Максим, благодарю за ссылку. Добавил в закладки.

[GrayEddy]

Пример кода, DefaultDrawing := True

Код: Выделить всё

procedure TfmMain.grdEventsDrawCell(Sender: TObject; aCol, aRow: Integer;
  aRect: TRect; aState: TGridDrawState);
var
  TextStyle: TTextStyle;
begin
  if gdFixed in aState then begin
    if aRow > 0 then begin
      TextStyle := Canvas.TextStyle;
      TextStyle.Alignment := taCenter;
      TextStyle.Layout := tlCenter;
      TStringGrid(Sender).Canvas.TextStyle := TextStyle;
      TStringGrid(Sender).Canvas.TextRect(aRect, aRect.Left, aRect.Top, IntToStr(aRow));
      Exit; // <-------
    end;
  end;
  TStringGrid(Sender).DefaultDrawCell(aCol, aRow, aRect, aState);
end;

Добавлено спустя 10 минут 56 секунд:
Кстати, примеры отрисовки гридов можно найти тут: $Lazarus\Examples\GridExamples\*.*

[bestonix]

Кстати, примеры отрисовки гридов можно найти тут: $Lazarus\Examples\GridExamples\*.*

Спасибо, сейчас разберусь что и как