Поместите TCheckBox в TStringGrid в Delphi - PullRequest
10 голосов
/ 15 марта 2011

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

Ответы [ 3 ]

27 голосов
/ 15 марта 2011

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

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 метод.

9 голосов
/ 15 марта 2011

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

3 голосов
/ 15 марта 2011

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

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

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

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

enter image description here

...