Добавить графическую панель в столбец StringGrid

Используя Delphi 2010 и компонент TStringGrid, я в настоящее время отображаю пять полей из запроса к базе данных.

Вот упрощенный пример того, что я делаю

// устанавливаем сетку

procedure TGriddata.FormCreate(Sender: TObject);
begin
 grdMain.Rows[0].commatext:='"One","Two","Three","Four","Five"';
 grdMain.ColWidths[0]:= 50;
 grdMain.ColWidths[1]:= 175;
 grdMain.ColWidths[2]:= 175;
 grdMain.ColWidths[3]:= 100;
 grdMain.ColWidths[4]:= 300;
end;

// отображаем данные в сетке // обратите внимание, я не показываю создание, выполнение или уничтожение запроса

procedure TGriddata.load;
begin
 ... 
 grdMain.Cells[0,row]:= FieldByName('one').AsString;
 grdMain.Cells[1,row]:= FieldByName('two').AsString;
 grdMain.Cells[2,row]:= FieldByName('three').AsString;
 grdMain.Cells[3,row]:= FieldByName('four').AsString;
 //draw progress bar here
 ...
end;

В одном из столбцов («Пять») должна отображаться темно-синяя горизонтальная полоса в столбце. Он также должен отображать некоторый текст по центру панели. У меня нет опыта использования пользовательского чертежа. Какие свойства я могу установить, чтобы только пользовательское рисование одного столбца и использование рисунка по умолчанию для других столбцов?

Blow ThemUp 23.10.2012 источник

comment

См. этот комментарий Яна Бойда! - NGLN 23.10.2012

Ответы (2)

arrow_upward
10
arrow_downward

Добавьте текст в ячейки, как обычно. Но вы должны нарисовать эти полосы в событии OnDrawCell. Оставьте DefaultDrawing как есть (по умолчанию True), а уже нарисованный текст ячейки в этих столбцах сотрите, заполнив его заранее:

procedure TForm1.grdMainDrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
  Progress: Single;
  R: TRect;
  Txt: String;
begin
  with TStringGrid(Sender) do
    if (ACol = 4) and (ARow >= FixedRows) then
    begin
      Progress := StrToFloatDef(Cells[ACol, ARow], 0) / 100;
      Canvas.FillRect(Rect);
      R := Rect;
      R.Right := R.Left + Trunc((R.Right - R.Left) * Progress);
      Canvas.Brush.Color := clNavy;
      Canvas.Rectangle(R);
      Txt := Cells[ACol, ARow] + '%';
      Canvas.Brush.Style := bsClear;
      IntersectClipRect(Canvas.Handle, R.Left, R.Top, R.Right, R.Bottom);
      Canvas.Font.Color := clHighlightText;
      DrawText(Canvas.Handle, PChar(Txt), -1, Rect, DT_SINGLELINE or
        DT_CENTER or DT_VCENTER or DT_END_ELLIPSIS or DT_NOPREFIX);
      SelectClipRgn(Canvas.Handle, 0);
      ExcludeClipRect(Canvas.Handle, R.Left, R.Top, R.Right, R.Bottom);
      Canvas.Font.Color := clWindowText;
      DrawText(Canvas.Handle, PChar(Txt), -1, Rect, DT_SINGLELINE or
        DT_CENTER or DT_VCENTER or DT_END_ELLIPSIS or DT_NOPREFIX);
      SelectClipRgn(Canvas.Handle, 0);
    end;
end;

Пользовательские полосы в StringGrid

Дополнительные параметры можно найти в этой DrawStatus процедуре.

NGLN 23.10.2012

arrow_upward
4
arrow_downward

Здесь вы можете просмотреть образец (отрисовать процент в ячейке таблицы), чтобы нарисовать полоса в ячейке TStringGrid. Объяснение на испанском, но вы можете скачать код, это очень просто. Также вы можете использовать автоматический перевод справа на странице.

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

procedure TFormDrawCell.DBGrid1DrawColumnCell(Sender: TObject;
  const Rect: TRect; DataCol: Integer; Column: TColumn;
  State: TGridDrawState);
const
  STR_EMPTY = '';
  CHAR_PERCENT = '%';
  SPACE_TO_CENTER_CELLTEXT = 0;
var
  fValue: Integer;
  ActualPenColor, ActualBrushColor: TColor;
  EmptyDS: Boolean;
  DrawRect: TRect;
  fWidth1, fLeft2: Integer;
  StrValue: string;
begin
  if not (Column.FieldName = 'Precent') then
    Exit;

  if not (cbdraw.Checked) then
    Exit;

  EmptyDS := ((TDBGrid(Sender).DataSource.DataSet.EoF) and
              (TDBGrid(Sender).DataSource.DataSet.Bof));

  if (Column.Field.IsNull) then begin
    fValue := -1;
    StrValue := STR_EMPTY;
  end
  else begin
    fValue := Column.Field.AsInteger;
    StrValue := IntToStr(fValue) + CHAR_PERCENT;
  end;

  DrawRect := Rect;
  InflateRect(DrawRect, -1, -1);

  fWidth1 := (((DrawRect.Right - DrawRect.Left) * fValue) DIV 100);

  ActualPenColor := TDBGrid(Sender).Canvas.Pen.Color;
  ActualBrushColor := TDBGrid(Sender).Canvas.Brush.Color;
  TDBGrid(Sender).Canvas.Pen.Color := clHighlight;
  TDBGrid(Sender).Canvas.Brush.Color := clWhite;
  TDBGrid(Sender).Canvas.Rectangle(DrawRect);

  if (fValue > 0) then begin
    TDBGrid(Sender).Canvas.Pen.Color := clSkyBlue;
    TDBGrid(Sender).Canvas.Brush.Color := clSkyBlue;
    DrawRect.Right := DrawRect.Left + fWidth1;
    InflateRect(DrawRect, -1, -1);
    TDBGrid(Sender).Canvas.Rectangle(DrawRect);
  end;

  if not (EmptyDS) then begin
    DrawRect := Rect;
    InflateRect(DrawRect, -2, -2);
    TDBGrid(Sender).Canvas.Brush.Style := bsClear;
    fLeft2 := DrawRect.Left + (DrawRect.Right - DrawRect.Left) shr 1 -
              (TDBGrid(Sender).Canvas.TextWidth(StrValue) shr 1);
    TDBGrid(Sender).Canvas.TextRect(DrawRect, fLeft2,
                                    DrawRect.Top + SPACE_TO_CENTER_CELLTEXT, StrValue);
  end;

  TDBGrid(Sender).Canvas.Pen.Color := ActualPenColor;
  TDBGrid(Sender).Canvas.Brush.Color := ActualBrushColor;
end;

С Уважением.

Germán Estévez -Neftalí- 23.10.2012

comment

Пожалуйста, отредактируйте свой ответ и добавьте сюда код, а не просто ссылку на другое место. Если внешний сайт по какой-то причине недоступен, ваш ответ становится бессмысленным. Это также недоступно для поиска для будущих читателей сайта. Спасибо. - Ken White; 23.10.2012

comment

@KenWhite: я позволил себе опубликовать здесь соответствующую часть кода и немного упростил его, чтобы сделать его более читабельным. - Wouter van Nifterick; 02.11.2012

comment

@Wouter: Спасибо. Тем не менее, плакат должен был сделать это сам, особенно после того, как ему напомнили об этом. Судя по всему, просмотров было достаточно, чтобы через полчаса или около того вы получили от них благодарность, так что запрос должен был быть замечен. :-) - Ken White; 02.11.2012

Добавить графическую панель в столбец StringGrid

Ответы (2)

Вопросы по теме