delphi - Agregar barra gráfica a una columna StringGrid

delphi-2010 custom-draw

Question

Usando Delphi 2010 y un componente TStringGrid, actualmente muestro cinco filds desde una consulta de base de datos.

Aquí hay un ejemplo simplificado de lo que estoy haciendo

// configurar la grilla

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;

// mostrar los datos en la cuadrícula // nota, no estoy mostrando mi creación, ejecución o destrucción de la consulta

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;

Una de las columnas ("Cinco") necesita mostrar una barra horizontal azul marino en el col. También debería mostrar un texto centrado en la barra. No tengo experiencia usando el dibujo personalizado. ¿Qué propiedades configuro solo para dibujar una columna y usar el dibujo predeterminado para las otras columnas?

Answer 1

Aquí puede ver una muestra ( Dibujar porcentaje en una celda en una Cuadrícula ), para dibujar una barra en una celda de un TStringGrid. La explicación está en español, pero puedes descargar el código, que es muy simple. También puede usar la traducción automática a la derecha de la página.

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;

Saludos.

Answer 2

Agregue el texto a las celdas como lo haría normalmente. Pero debes dibujar esas barras en el evento OnDrawCell . Deje DefaultDrawing como está ( True por defecto), y borre el texto de la celda ya dibujado en esas columnas llenándolo con anticipación:

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;

Para obtener más opciones, puede considerar esta rutina DrawStatus .