delphi - 将图形栏添加到 StringGrid col

Question

使用 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;

其中一列（“五”）需要在列中显示一个深蓝色水平条。它还应该在栏中显示一些居中的文本。我没有使用自定义绘图的经验。我将哪些属性设置为仅自定义绘制一列并为其他列使用默认绘图？

Answer 1

像往常一样将文本添加到单元格中。但是你必须在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;

如需更多选择，您可以考虑使用此DrawStatus例程。

Answer 2

在这里您可以查看示例（在网格中的单元格中绘制百分比），以在 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;

问候。