Use an image to display an assignment between two lists of strings in a TStringGrid (Views: 27)
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. |