Use an image to display an assignment between two lists of strings in a TStringGrid

Problem/Question/Abstract:

I want to show an assignment of two lists of strings in a TStringGrid or something similar. In the first column I write the first list and in the third the other list. In the second column I want to show an icon of an arrow. When the user clicks the arrow it changes the direction of the assignment. Is there a possibility to show icons in a column?

Answer:

You can do that without problems using a TStringGrid. You use the grid's OnDrawCell handler to draw a cells content yourself. What you need, of course, is a way to store the direction of the assignment somewhere, so you know which of the arrows to draw. You could use a special string stored into the cell in column 2 for this, e.g. an empty string to signify -> and a blank character to signify <-. You also need a handler for the grids OnClick event, so you can detect clicks on a cell to invert the assignment.

Lets make an example application. Create a new form, drop a TImageList and a TStringGrid onto it. Set the stringgrid to 3 columns, 0 fixed columns. Load the two arrow bitmaps into the imagelist, the one for left-to-right assignment at index 0, the other at index 1. Name the imagelist "Arrows". Add handlers for the forms OnCreate event and for the stringgrid's OnDrawCell, OnClick, and OnKeyPress events. Modify the unit as below:

unit Unit1;

interface

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

type
  TAssignment = (aLeftToRight, aRightToLeft);
  TForm1 = class(TForm)
    StringGrid1: TStringGrid;
    Arrows: TImageList;
    procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure FormCreate(Sender: TObject);
    procedure StringGrid1Click(Sender: TObject);
    procedure StringGrid1KeyPress(Sender: TObject; var Key: Char);
  private
    function GetAssignment(index: Integer): TAssignment;
    procedure SetAssignment(index: Integer; const Value: TAssignment);
    procedure ValidateAssignmentIndex(index: INteger);
  public
    procedure ToggleAssignment(index: Integer);
    property Assignment[index: Integer]: TAssignment read GetAssignment write
      SetAssignment;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{Return the top position of an object of height h vertically centered in rectangle rect}

function CenterVertical(const rect: TRect; h: Integer): Integer;
begin
  Result := (rect.bottom + rect.top - h) div 2;
end;

{ Return the left position of an object of width w horizontally centered in rectangle rect}

function CenterHorizontal(const rect: TRect; w: Integer): Integer;
begin
  Result := (rect.right + rect.left - w) div 2;
end;

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
  grid: TStringgrid;
begin
  if (arow > 0) and (acol = 1) then
  begin
    grid := (Sender as TStringGrid);
    grid.canvas.Brush.color := stringgrid1.color; {disables highlight}
    grid.Canvas.FillRect(rect);
    arrows.Draw(grid.canvas, CenterHorizontal(rect, arrows.Width),
      CenterVertical(rect, arrows.Height), Ord(Assignment[arow] = aRightToLeft));
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  i: Integer;
begin
  with stringgrid1 do
  begin
    cells[0, 0] := 'Source';
    cells[1, 0] := 'Link';
    cells[2, 0] := 'Dest';
    for i := 1 to rowcount - 1 do
    begin
      cells[0, i] := format('Source %d', [i]);
      Assignment[i] := aLeftToRight;
      cells[2, i] := format('Dest %d', [i]);
    end;
  end;
end;

procedure TForm1.StringGrid1Click(Sender: TObject);
var
  pt: TPoint;
  grid: TStringGrid;
  acol, arow: Integer;
begin
  grid := (Sender as TStringGrid);
  pt := grid.ScreenToClient(mouse.cursorpos);
  grid.MouseToCell(pt.X, pt.y, acol, arow);
  if (aRow > 0) and (aCol = 1) then
    ToggleAssignment(aRow);
end;

const
  AssignmentStrings: array[TAssignment] of string = ('', #32);

function TForm1.GetAssignment(index: Integer): TAssignment;
begin
  ValidateAssignmentIndex(index);
  for Result := Low(Result) to High(Result) do
    if AssignmentStrings[Result] = Stringgrid1.Cells[1, index] then
      Exit;
  raise
    Exception.CreateFmt('The cell value "%s" is not valid as a code
                        for an assignment ' + 'for row %d', [Stringgrid1.Cells[1, index], index]);
end;

procedure TForm1.SetAssignment(index: Integer; const Value: TAssignment);
begin
  ValidateAssignmentIndex(index);
  stringgrid1.Cells[1, index] := AssignmentStrings[value];
end;

procedure TForm1.ToggleAssignment(index: Integer);
const
  toggles: array[TAssignment] of TAssignment = (aRightToLeft, aLeftToRight);
begin
  Assignment[index] := toggles[Assignment[index]];
end;

procedure TForm1.ValidateAssignmentIndex(index: Integer);
begin
  if (index < stringgrid1.FixedCols) or (index >= stringgrid1.RowCount) then
    raise
      Exception.CreateFmt('Assignment index %d is out of bounds, valid indices are ' +
      '%d to %d.', [index, stringgrid1.fixedcols, stringgrid1.rowcount - 1]);
end;

procedure TForm1.StringGrid1KeyPress(Sender: TObject; var Key: Char);
var
  grid: TStringgrid;
begin
  grid := (Sender as TStringGrid);
  if grid.Col = 1 then
  begin
    if Key = #32 then {spacebar}
      ToggleAssignment(grid.Row);
    Key := #0;
  end;
end;

end.