Articles   Members Online:
-Article/Tip Search
-News Group Search over 21 Million news group articles.
-Delphi/Pascal
-CBuilder/C++
-C#Builder/C#
-JBuilder/Java
-Kylix
Member Area
-Home
-Account Center
-Top 10 NEW!!
-Submit Article/Tip
-Forums Upgraded!!
-My Articles
-Edit Information
-Login/Logout
-Become a Member
-Why sign up!
-Newsletter
-Chat Online!
-Indexes NEW!!
Employment
-Build your resume
-Find a job
-Post a job
-Resume Search
Contacts
-Contacts
-Feedbacks
-Link to us
-Privacy/Disclaimer
Embarcadero
Visit Embarcadero
Embarcadero Community
JEDI
Links
How to use an image to display an assignment between two lists ofstrings in a TS Turn on/off line numbers in source code. Switch to Orginial background IDE or DSP color Comment or reply to this aritlce/tip for discussion. Bookmark this article to my favorite article(s). Print this article
05-Nov-02
Category
VCL-General
Language
Delphi 2.x
Views
83
User Rating
No Votes
# Votes
0
Replies
0
Publisher:
DSP, Administrator
Reference URL:
DKB
			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.


			
Vote: How useful do you find this Article/Tip?
Bad Excellent
1 2 3 4 5 6 7 8 9 10

 

Advertisement
Share this page
Advertisement
Download from Google

Copyright © Mendozi Enterprises LLC