StringGridの列にグラフィックバーを追加

Question

Delphi 2010とTStringGridコンポーネントを使用して、私は現在データベースクエリから5つのファイルを表示しています。ここで

iは//グリッド

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; 

//グリッド //ノートでデータを表示を設定

をやっているかの簡体一例ですが、私は私の創造を示すわけではありませんクエリの実行、破棄、または破棄

列の1つ（「5」）は、列に紺色の水平バーを表示する必要があります。また、バーの中央にテキストを表示する必要があります。カスタム図面を使ったexpereinceはありません。私はどのようなプロパティをカスタムに設定するだけで1つの列を描画し、他の列にはデフォルトの図面を使用しますか？

Answer 1

通常のようにテキストをセルに追加します。しかし、あなたはOnDrawCellイベントのバーを描く必要があります。 （デフォルトではTrue）であるとしてDefaultDrawingのままにして、事前にそれを充填することにより、これらの列ですでに描かれたセルのテキストを消去する：より多くのオプションについては、あなたがthis DrawStatus routineを検討するかもしれない

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; 

。

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; 

よろしく

。