Mirror

Align cells in a TStringGrid (3) (Views: 100)


Problem/Question/Abstract:

I would like to control Justification in a string grid. Column 0 LeftJustified, column 1 Centered, column 3 Right Justified, etc.. I would also like to control the foreground and background color of the Fixed row.

Answer:

unit PBExStringgrid;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Grids;

const
  GM_ACTIVATECELL = WM_USER + 123;

type
  TGMActivateCell = record
    msg: Cardinal;
    aCol, aRow: Integer;
    result: Integer;
  end;

  TPBExStringgrid = class;
  TExitCellEvent = procedure(Sender: TPBExStringgrid; aCol, aRow: Integer;
    const edittext: string) of object;
  TGetCellAlignmentEvent = procedure(Sender: TPBExStringgrid; aCol, aRow: Integer;
    State: TGridDrawState; var cellAlignment: TAlignment) of object;
  TCaptionClickEvent = procedure(sender: TPBExStringgrid; aCol, aRow: Integer) of
    object;

  TPBExStringgrid = class(Tstringgrid)
  private
    FExitCell: TExitCellEvent;
    FAlignment: TAlignment;
    FSetCanvasProperties: TDrawCellEvent;
    FGetCellAlignment: TGetCellAlignmentEvent;
    FCaptionClick: TCaptionClickEvent;
    FCellOnMouseDown: TGridCoord;

    procedure GMActivateCell(var msg: TGMActivateCell); message GM_ACTIVATECELL;
    procedure SetAlignment(const Value: TAlignment);
  protected
    function CreateEditor: TInplaceEdit; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
      override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
      override;
    procedure ExitCell(const edittext: string; aCol, aRow: Integer); virtual;
    procedure SetCanvasProperties(ACol, ARow: Longint; Rect: TRect;
      State: TGridDrawState); virtual;
    procedure DrawCell(ACol, ARow: Longint; Rect: TRect; State: TGridDrawState);
      override;
    procedure CaptionClick(aCol, aRow: LongInt); dynamic;
  public
    function GetCellAlignment(Acol, aRow: Longint; State: TGridDrawState): TAlignment;
      virtual;
    procedure DefaultDrawCell(ACol, ARow: Longint; Rect: TRect; State: TGridDrawState); virtual;
    procedure ActivateCell(aCol, aRow: Integer);
    procedure InvalidateCell(aCol, aRow: Integer);
    procedure InvalidateCol(aCol: Integer);
    procedure InvalidateRow(aRow: Integer);
    property InplaceEditor;
  published
    property OnExitCell: TExitCellEvent read FExitCell write FExitCell;
    property Alignment: TAlignment read FAlignment write SetAlignment;
    property OnSetCanvasProperties: TDrawCellEvent read FSetCanvasProperties
      write FSetCanvasProperties;
    property OnGetCellAlignment: TGetCellAlignmentEvent read FGetCellAlignment
      write FGetCellAlignment;
    property OnCaptionClick: TCaptionClickEvent read FCaptionClick write
      FCaptionClick;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('PBGoodies', [TPBExStringgrid]);
end;

type
  TExInplaceEdit = class(TInplaceEdit)
  private
    FLastCol, FLastRow: Integer;
    procedure WMKillFocus(var msg: TMessage); message WM_KILLFOCUS;
    procedure WMSetFocus(var msg: TMessage); message WM_SETFOCUS;
  public
    procedure CreateParams(var params: TCreateParams); override;
  end;

  { TPBExStringgrid }

procedure TPBExStringgrid.ActivateCell(aCol, aRow: Integer);
begin
  PostMessage(handle, GM_ACTIVATECELL, aCol, aRow);
end;

procedure TPBExStringgrid.CaptionClick(aCol, aRow: LongInt);
begin
  if Assigned(FCaptionClick) then
    FCaptionClick(self, aCol, aRow);
end;

function TPBExStringgrid.CreateEditor: TInplaceEdit;
begin
  result := TExInplaceEdit.Create(self);
end;

procedure TPBExStringgrid.DefaultDrawCell(ACol, ARow: Integer; Rect: TRect;
  State: TGridDrawState);
const
  flags: array[TAlignment] of DWORD = (DT_LEFT, DT_RIGHT, DT_CENTER);
var
  S: string;
begin
  Canvas.FillRect(Rect);
  S := Cells[aCol, aRow];
  if Length(S) > 0 then
  begin
    InflateRect(rect, -2, -2);
    DrawText(Canvas.Handle, PChar(S), Length(S), rect, DT_SINGLELINE or DT_NOPREFIX or
      DT_VCENTER or flags[GetCellAlignment(acol, arow, state)]);
  end;
end;

procedure TPBExStringgrid.DrawCell(ACol, ARow: Integer; Rect: TRect; State:
  TGridDrawState);
begin
  if Assigned(OnDrawCell) then
    inherited
  else
  begin
    SetCanvasProperties(aCol, aRow, rect, State);
    DefaultDrawCell(aCol, aRow, rect, State);
    Canvas.Font := Font;
    Canvas.Brush := Brush;
  end;
end;

procedure TPBExStringgrid.ExitCell(const edittext: string; aCol, aRow: Integer);
begin
  if Assigned(FExitCell) then
    FExitCell(self, aCol, aRow, edittext);
end;

function TPBExStringgrid.GetCellAlignment(Acol, aRow: Integer;
  State: TGridDrawState): TAlignment;
begin
  Result := FAlignment;
  if Assigned(FGetCellAlignment) then
    FGetCellAlignment(self, acol, arow, state, result);
end;

procedure TPBExStringgrid.GMActivateCell(var msg: TGMActivateCell);
begin
  Col := msg.aCol;
  Row := msg.aRow;
  EditorMode := true;
  InplaceEditor.SelectAll;
end;

procedure TPBExStringgrid.InvalidateCell(aCol, aRow: Integer);
begin
  inherited InvalidateCell(aCol, aRow);
end;

procedure TPBExStringgrid.InvalidateCol(aCol: Integer);
begin
  inherited InvalidateCol(aCol);
end;

procedure TPBExStringgrid.InvalidateRow(aRow: Integer);
begin
  inherited InvalidateRow(aRow);
end;

procedure TPBExStringgrid.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y:
  Integer);
begin
  inherited;
  if Button = mbLeft then
    MouseToCell(X, Y, FCellOnMouseDown.X, FCellOnMouseDown.Y)
  else
    FCellOnMouseDown := TGridCoord(Point(-1, -1));
end;

procedure TPBExStringgrid.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y:
  Integer);
var
  cell: TGridCoord;
begin
  if Button = mbLeft then
    MouseToCell(X, Y, Cell.X, Cell.Y);
  if CompareMem(@Cell, @FCellOnMouseDown, Sizeof(cell)) and
    ((Cell.X < FixedCols) or (Cell.Y < FixedRows)) then
    CaptionClick(Cell.X, Cell.Y);
  FCellOnMouseDown := TGridCoord(Point(-1, -1));
  inherited;
end;

procedure TPBExStringgrid.SetAlignment(const Value: TAlignment);
begin
  if FAlignment <> Value then
  begin
    FAlignment := Value;
    Invalidate;
    if Assigned(InplaceEditor) then
      TExInplaceEdit(InplaceEditor).RecreateWnd;
  end;
end;

procedure TPBExStringgrid.SetCanvasProperties(ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
begin
  if Assigned(FSetCanvasProperties) then
    FSetCanvasProperties(self, aCol, aRow, Rect, State);
end;

{ TExInplaceEdit }

procedure TExInplaceEdit.CreateParams(var params: TCreateParams);
const
  flags: array[TAlignment] of DWORD = (ES_LEFT, ES_RIGHT, ES_CENTER);
begin
  inherited;
  params.Style := params.Style or flags[TPBExStringgrid(grid).Alignment];
end;

procedure TExInplaceEdit.WMKillFocus(var msg: TMessage);
begin
  TPBExStringgrid(Grid).ExitCell(Text, FLastCol, FLastRow);
  inherited;
end;

procedure TExInplaceEdit.WMSetFocus(var msg: TMessage);
begin
  FLastCol := TPBExStringgrid(Grid).Col;
  FLastRow := TPBExStringgrid(Grid).Row;
  inherited;
end;

end.

<< Back to main page