Поместите TCheckBox в TStringGrid в Delphi

Я хочу поставить TCheckBox внутри TStringGrid в Delphi в каждой ячейке определенного столбца. Я использую Delphi XE.

Источник

3 ответа

Решение

Вы должны нарисовать свои собственные флажки, желательно с использованием визуальных тем, если они включены. Это простой набросок того, как это сделать:

const
  Checked: array[1..4] of boolean = (false, true, false, true);

procedure TForm4.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
const
  PADDING = 4;
var
  h: HTHEME;
  s: TSize;
  r: TRect;
begin
  if (ACol = 2) and (ARow >= 1) then
  begin
    FillRect(StringGrid1.Canvas.Handle, Rect, GetStockObject(WHITE_BRUSH));
    s.cx := GetSystemMetrics(SM_CXMENUCHECK);
    s.cy := GetSystemMetrics(SM_CYMENUCHECK);
    if UseThemes then
    begin
      h := OpenThemeData(StringGrid1.Handle, 'BUTTON');
      if h <> 0 then
        try
          GetThemePartSize(h,
            StringGrid1.Canvas.Handle,
            BP_CHECKBOX,
            CBS_CHECKEDNORMAL,
            nil,
            TS_DRAW,
            s);
          r.Top := Rect.Top + (Rect.Bottom - Rect.Top - s.cy) div 2;
          r.Bottom := r.Top + s.cy;
          r.Left := Rect.Left + PADDING;
          r.Right := r.Left + s.cx;
          DrawThemeBackground(h,
            StringGrid1.Canvas.Handle,
            BP_CHECKBOX,
            IfThen(Checked[ARow], CBS_CHECKEDNORMAL, CBS_UNCHECKEDNORMAL),
            r,
            nil);
        finally
          CloseThemeData(h);
        end;
    end
    else
    begin
      r.Top := Rect.Top + (Rect.Bottom - Rect.Top - s.cy) div 2;
      r.Bottom := r.Top + s.cy;
      r.Left := Rect.Left + PADDING;
      r.Right := r.Left + s.cx;
      DrawFrameControl(StringGrid1.Canvas.Handle,
        r,
        DFC_BUTTON,
        IfThen(Checked[ARow], DFCS_CHECKED, DFCS_BUTTONCHECK));
    end;
    r := Classes.Rect(r.Right + PADDING, Rect.Top, Rect.Right, Rect.Bottom);
    DrawText(StringGrid1.Canvas.Handle,
      StringGrid1.Cells[ACol, ARow],
      length(StringGrid1.Cells[ACol, ARow]),
      r,
      DT_SINGLELINE or DT_VCENTER or DT_LEFT or DT_END_ELLIPSIS);
  end;
end;

Конечно, в реальном сценарии Checked массив не является константой, и вы можете сохранить s метрики и h дескриптор темы между событиями рисования ячейки. Но принцип здесь.

http://privat.rejbrand.se/stringcheck1.png http://privat.rejbrand.se/stringcheck2.png

Чего здесь не хватает, так это функции для изменения состояния флажков. Возможно, вы захотите переключить состояние в OnClick обработчик. Если вы действительно серьезны, вам также следует реагировать на движение мыши и отображать эффект наведения мыши на флажки, если доступны темы.

РЕДАКТИРОВАНИЕ синим цветом: чтобы переключить состояние флажка, этот ответ объясняет, как вы можете использовать Invalidate метод.

Источник

Не пытайтесь разместить фактический TCheckBox контроль внутри TStringGrid, Используйте сетку OnDrawCell событие с Win32 API DrawFrameControl() вместо этого, чтобы нарисовать изображение элемента управления CheckBox внутри каждой ячейки по мере необходимости. Вы можете использовать OnClick/OnMouse... события с сеткой Objects[][] свойство для отслеживания проверенного состояния каждой ячейки при необходимости. Я считаю, что это намного проще в управлении, так как TStringGrid не был предназначен для размещения реальных элементов управления.

Источник

Я использую виртуальную сетку под названием ExGridView Романа Мочалова, которая поддерживает флажки.

Мой собственный модифицированный форк GridView, портированный для Unicode и т. Д., С именем TExGridView вместо TGridView и с демонстрацией флажков, находится здесь как битовая корзина как /wpostma/exgridview.

Компонент ExGridView имеет свойство Checkbox в инспекторе свойств, которое должно быть установлено в значение true. Затем необходимо настроить свойства столбца таким образом, чтобы тип столбца имел тип флажка, установленный на флажок или переключатель. Затем вы должны реализовать обратный вызов события GetCheckState. Посмотрите демоверсию, включенную в проект bitbucket.

Первоначальный источник этого кода был здесь, но он не может быть использован в последних версиях. Моя версия BitBucket протестирована и работает с Delphi 2007, 2009 и всеми версиями, актуальными на 2016 год (Delphi 10 Seattle).

Источник
Другие вопросы по тегам