Author: Tomas Rutkauskas
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:
1 unit Unit1;
2
3 interface
4
5 uses
6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 Dialogs, stdctrls, Grids, ImgList;
8
9 type
10 TAssignment = (aLeftToRight, aRightToLeft);
11 TForm1 = class(TForm)
12 StringGrid1: TStringGrid;
13 Arrows: TImageList;
14 procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
15 Rect: TRect; State: TGridDrawState);
16 procedure FormCreate(Sender: TObject);
17 procedure StringGrid1Click(Sender: TObject);
18 procedure StringGrid1KeyPress(Sender: TObject; var Key: Char);
19 private
20 function GetAssignment(index: Integer): TAssignment;
21 procedure SetAssignment(index: Integer; const Value: TAssignment);
22 procedure ValidateAssignmentIndex(index: INteger);
23 public
24 procedure ToggleAssignment(index: Integer);
25 property Assignment[index: Integer]: TAssignment read GetAssignment write
26 SetAssignment;
27 end;
28
29 var
30 Form1: TForm1;
31
32 implementation
33
34 {$R *.dfm}
35
36 {Return the top position of an object of height h vertically centered in rectangle
37 rect}
38
39 function CenterVertical(const rect: TRect; h: Integer): Integer;
40 begin
41 Result := (rect.bottom + rect.top - h) div 2;
42 end;
43
44 { Return the left position of an object of width w horizontally centered in
45 rectangle rect}
46
47 function CenterHorizontal(const rect: TRect; w: Integer): Integer;
48 begin
49 Result := (rect.right + rect.left - w) div 2;
50 end;
51
52 procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
53 Rect: TRect; State: TGridDrawState);
54 var
55 grid: TStringgrid;
56 begin
57 if (arow > 0) and (acol = 1) then
58 begin
59 grid := (Sender as TStringGrid);
60 grid.canvas.Brush.color := stringgrid1.color; {disables highlight}
61 grid.Canvas.FillRect(rect);
62 arrows.Draw(grid.canvas, CenterHorizontal(rect, arrows.Width),
63 CenterVertical(rect, arrows.Height), Ord(Assignment[arow] = aRightToLeft));
64 end;
65 end;
66
67 procedure TForm1.FormCreate(Sender: TObject);
68 var
69 i: Integer;
70 begin
71 with stringgrid1 do
72 begin
73 cells[0, 0] := 'Source';
74 cells[1, 0] := 'Link';
75 cells[2, 0] := 'Dest';
76 for i := 1 to rowcount - 1 do
77 begin
78 cells[0, i] := format('Source %d', [i]);
79 Assignment[i] := aLeftToRight;
80 cells[2, i] := format('Dest %d', [i]);
81 end;
82 end;
83 end;
84
85 procedure TForm1.StringGrid1Click(Sender: TObject);
86 var
87 pt: TPoint;
88 grid: TStringGrid;
89 acol, arow: Integer;
90 begin
91 grid := (Sender as TStringGrid);
92 pt := grid.ScreenToClient(mouse.cursorpos);
93 grid.MouseToCell(pt.X, pt.y, acol, arow);
94 if (aRow > 0) and (aCol = 1) then
95 ToggleAssignment(aRow);
96 end;
97
98 const
99 AssignmentStrings: array[TAssignment] of string = ('', #32);
100
101 function TForm1.GetAssignment(index: Integer): TAssignment;
102 begin
103 ValidateAssignmentIndex(index);
104 for Result := Low(Result) to High(Result) do
105 if AssignmentStrings[Result] = Stringgrid1.Cells[1, index] then
106 Exit;
107 raise
108 Exception.CreateFmt('The cell value "%s" is not valid as a code
109 for an assignment 'nggrid1.Cells[1, index], index]);
110 end;
111
112 procedure TForm1.SetAssignment(index: Integer; const Value: TAssignment);
113 begin
114 ValidateAssignmentIndex(index);
115 stringgrid1.Cells[1, index] := AssignmentStrings[value];
116 end;
117
118 procedure TForm1.ToggleAssignment(index: Integer);
119 const
120 toggles: array[TAssignment] of TAssignment = (aRightToLeft, aLeftToRight);
121 begin
122 Assignment[index] := toggles[Assignment[index]];
123 end;
124
125 procedure TForm1.ValidateAssignmentIndex(index: Integer);
126 begin
127 if (index < stringgrid1.FixedCols) or (index >= stringgrid1.RowCount) then
128 raise
129 Exception.CreateFmt('Assignment index %d is out of bounds, valid indices are
130 '+
131 '%d to %d.', [index, stringgrid1.fixedcols, stringgrid1.rowcount - 1]);
132 end;
133
134 procedure TForm1.StringGrid1KeyPress(Sender: TObject; var Key: Char);
135 var
136 grid: TStringgrid;
137 begin
138 grid := (Sender as TStringGrid);
139 if grid.Col = 1 then
140 begin
141 if Key = #32 then {spacebar}
142 ToggleAssignment(grid.Row);
143 Key := #0;
144 end;
145 end;
146
147 end.
|
