Delphi: How to make cells' texts in TStringGrid center aligned?

This one is a much better solution that the others and on them there was a mistype on procedures TStringGrid.SetCellsAlignment and TStringGrid.SetCellsAlignment the (-1 < Index) compare was correct, but then and else parts were swapped... The correct version (this one) will show that when index is bigger than -1 it will overwrite value stored else it will add a new entry, the others will do just the oposite bringing a list out of index message, thanks for detecting such.

I have also make able to be all in another separated unit, so here it is (hope now it is correct and thanks for detecting such mistypes):

unit AlignedTStringGrid;

interface

uses Windows,SysUtils,Classes,Grids;

type 
  TStringGrid=class(Grids.TStringGrid)
  private
    FCellsAlignment:TStringList;
    FColsDefaultAlignment:TStringList;
    function GetCellsAlignment(ACol,ARow:Integer):TAlignment;
    procedure SetCellsAlignment(ACol,ARow:Integer;const Alignment:TAlignment);
    function GetColsDefaultAlignment(ACol:Integer):TAlignment;
    procedure SetColsDefaultAlignment(ACol:Integer;const Alignment:TAlignment);
  protected
    procedure DrawCell(ACol,ARow:Longint;ARect:TRect;AState:TGridDrawState);override;
  public
    constructor Create(AOwner:TComponent);override;
    destructor Destroy;override;
    property CellsAlignment[ACol,ARow:Integer]:TAlignment read GetCellsAlignment write SetCellsAlignment;
    property ColsDefaultAlignment[ACol:Integer]:TAlignment read GetColsDefaultAlignment write SetColsDefaultAlignment;
  end;

implementation

constructor TStringGrid.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
  FCellsAlignment:=TStringList.Create;
  FCellsAlignment.CaseSensitive:=True;
  FCellsAlignment.Sorted:=True;
  FCellsAlignment.Duplicates:=dupIgnore;
  FColsDefaultAlignment:=TStringList.Create;
  FColsDefaultAlignment.CaseSensitive:=True;
  FColsDefaultAlignment.Sorted:=True;
  FColsDefaultAlignment.Duplicates:=dupIgnore;
end;

destructor TStringGrid.Destroy;
begin
  FCellsAlignment.Free;
  FColsDefaultAlignment.Free;
  inherited Destroy;
end;

procedure TStringGrid.SetCellsAlignment(ACol,ARow: Integer; const Alignment: TAlignment);
var
  Index:Integer;
begin
  if (-1 < Index) then begin
    FCellsAlignment.Objects[Index]:= TObject(Alignment);
  end else begin
    FCellsAlignment.AddObject(IntToStr(ACol) + '-' + IntToStr(ARow), TObject(Alignment));
  end;
end;

function TStringGrid.GetCellsAlignment(ACol,ARow: Integer): TAlignment;
var
  Index:Integer;
begin
  Index:= FCellsAlignment.IndexOf(IntToStr(ACol)+'-'+IntToStr(ARow));
  if (-1 < Index) then begin
    GetCellsAlignment:= TAlignment(FCellsAlignment.Objects[Index]);
  end else begin
    GetCellsAlignment:= ColsDefaultAlignment[ACol];
  end;
end;

procedure TStringGrid.SetColsDefaultAlignment(ACol: Integer; const Alignment: TAlignment);
var
  Index:Integer;
begin
  Index:= FColsDefaultAlignment.IndexOf(IntToStr(ACol));
  if (-1 < Index) then begin
    FColsDefaultAlignment.Objects[Index]:= TObject(Alignment);
  end else begin
    FColsDefaultAlignment.AddObject(IntToStr(ACol), TObject(Alignment));
  end;
end;

function TStringGrid.GetColsDefaultAlignment(ACol:Integer):TAlignment;
var
  Index:Integer;
begin
  Index:= FColsDefaultAlignment.IndexOf(IntToStr(ACol));
  if (-1 < Index) then begin
    GetColsDefaultAlignment:= TAlignment(FColsDefaultAlignment.Objects[Index]);
  end else begin
    GetColsDefaultAlignment:=taLeftJustify;
  end;
end;

procedure TStringGrid.DrawCell(ACol,ARow:Longint;ARect:TRect;AState:TGridDrawState);
var
  Old_DefaultDrawing:Boolean;
begin
  if DefaultDrawing then begin
    case CellsAlignment[ACol,ARow] of
      taLeftJustify: begin
        Canvas.TextRect(ARect,ARect.Left+2,ARect.Top+2,Cells[ACol,ARow]);
      end;
      taRightJustify: begin
        Canvas.TextRect(ARect,ARect.Right -2 -Canvas.TextWidth(Cells[ACol,ARow]), ARect.Top+2,Cells[ACol,ARow]);
      end;
      taCenter: begin
        Canvas.TextRect(ARect,(ARect.Left+ARect.Right-Canvas.TextWidth(Cells[ACol,ARow]))div 2,ARect.Top+2,Cells[ACol,ARow]);
      end;
    end;
  end;
  Old_DefaultDrawing:= DefaultDrawing;
  DefaultDrawing:=False;
  inherited DrawCell(ACol,ARow,ARect,AState);
  DefaultDrawing:= Old_DefaultDrawing;
end;

end.

This is a whole unit, save it to a file called AlignedTStringGrid.pas.

Then on any form you have a TStringGrid add ,AlignedTStringGrid at the end of the interface uses clause.

Note: The same can be done for rows, but for now I do not know how to mix both (cols and rows) because of how to select priority, if anyone is very interested on it let me know.

P.D.: The same idea is possible to be done for TEdit, just search on stackoverflow.com for TEdit.CreateParams or read post How to set textalignment in TEdit control


There's no property to center the text in TStringGrid, but you can do that at DrawCell event as:

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
  S: string;
  SavedAlign: word;
begin
  if ACol = 1 then begin  // ACol is zero based
    S := StringGrid1.Cells[ACol, ARow]; // cell contents
    SavedAlign := SetTextAlign(StringGrid1.Canvas.Handle, TA_CENTER);
    StringGrid1.Canvas.TextRect(Rect,
      Rect.Left + (Rect.Right - Rect.Left) div 2, Rect.Top + 2, S);
    SetTextAlign(StringGrid1.Canvas.Handle, SavedAlign);
  end;
end;

The code I posted from here

UPDATE:

to center text while writing in the cell, add this code to GetEditText Event:

procedure TForm1.StringGrid1GetEditText(Sender: TObject; ACol, ARow: Integer;
  var Value: string);
var
  S : String;
  I: Integer;
  IE : TInplaceEdit ;
begin
  for I := 0 to StringGrid1.ControlCount - 1 do
    if StringGrid1.Controls[i].ClassName = 'TInplaceEdit' then
    begin
      IE := TInplaceEdit(StringGrid1.Controls[i]);
      ie.Alignment := taCenter
    end;
end;

Tags:

Delphi