In every Windows form, the user is allowed to use the tab key to cycle thru all controls on the form. When building a form, the developer can select the tab order to fit his needs. For example if the form looks like a grid, he set tab order so that the focus goes horizontally first. Alternatively, he can select that controls are visited in column order. Of course the crazy developer can select any order.
Every form has SelectFirst and SelectNext methods which according to their name allow to programmatically select a given control, or to find the next one. There is also the ActiveControl property which can be used to query which form’s control currently has the focus, or to change it.
Finally, it is worth mentioning the TScreen event OnActiveControlChange which can be used to track the changes in the control having the focus.
In an application I’m writing, I have the need to discover the taborder on any form to do some action and processing according to that tab order. I need to know the tab order without actually selecting any control. So SelectFirst and SelectNext are not useful to me. Since I couldn’t find any easy way to get the tab order, I designed some code to do it…
Getting taborder list
On a form, the controls are organized in a hierarchy. Some controls such as panels or group boxes can contain other controls. Containers can contain other containers. Each container has his own tab order. When a container receives the focus, it is either himself which receive it, or the first control inside the container. This is the container’s TabStop property which governs that behavior.
Actually each control has a TabStop property which make the control appear in the tab cycle or not. By default, containers do not have their TabStop property set while most others do.
TabOrder within a container is governed by the TabOrder property assigned to each control. The first control to receive the focus has TabOrder equal to zero. The next one has TabOrder set to one and so on. When focus has reached the last control of a container, the next adjacent control will receive the focus. The adjacent control is the one having a TabOrder equal to the container’s TabOrder plus one.
To get a list of controls ordered by TabOrder (I mean global TabOrder, considering the whole form) it is enough to traverse the controls hierarchy (It’s a tree) and sort the list by TabOrder at each level.
Traversing the control hierarchy is easy since each control has a list on contained controls. This list is the Controls[] indexed property. Only controls inheriting from TWinControl can receive focus. So the code to build the tree looks like this:
1 2 3 4 5 6 7 8 9 10 11 12 13 | procedure TTabOrderSearchRecord.RecurseControls(<br> Ctrl : TWinControl);<br>var<br> I : Integer;<br>begin<br> if not Assigned(Ctrl) then<br> Exit;<br> FList.Add(Ctrl);<br> for I := 0 to Ctrl.ControlCount - 1 do begin<br> if Ctrl.Controls[I] is TWinControl then<br> RecurseControls(TWinControl(Ctrl.Controls[I]));<br> end;<br>end;<br> |
Not surprisingly this code is recursive. Each iteration adds a control to the list and then all contained controls recursively.
The list is not sorted by tab order! To do that sort, we must record for each control his own TabOrder as well as all the TabOrder of all of his hierarchy. You can see this TabOrder hierarchy just like a directory tree on disk: you have directories having files and subdirectories. Here we have controls containing other controls or not. Just like a file path gives the complete specification of a file in the directory hierarchy, we can build a TabOrder path as we traverse the tree.
I use a string to build the TabOrder path. At each iteration, I append the new TabOrder. A string is required because the hierarchy could be deep. There is no serious limit on the complexity of a form. I know forms having several hundred controls.
The function RecurseControls can be changed as shown below to build a list sorted by TabOrder. The trick is to add an argument to the function and append the current TabOrder to it.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 | procedure TTabOrderSearchRecord.RecurseControls(<br> Ctrl : TWinControl;<br> const Level : String = '');<br>var<br> I : Integer;<br> CI : TTabOrderItem;<br>begin<br> if not Assigned(CtrlsItems) then<br> CtrlsItems := TInterfacedList<ttaborderitem>.Create;<br> if not Assigned(Ctrl) then<br> Exit;<br><br> CI := TTabOrderItem.Create;<br> CI.Ctrl := Ctrl;<br> CI.Level := Level;<br> CtrlsItems.AddItem(CI);<br><br> for I := 0 to Ctrl.ControlCount - 1 do begin<br> if Ctrl.Controls[I] is TWinControl then<br> RecurseControls(TWinControl(Ctrl.Controls[I]),<br> Level +<br> Format('%03.3d',<br> [TWinControl(Ctrl.Controls[I]).TabOrder + 2]));<br> end;<br> if Level = '' then<br> CtrlsItems.Sort(CompareTabOrderItem);<br>end;<br></ttaborderitem> |
This initial call remains the same, so the “Levelé argument take the default value which is the empty string. Each time the function recurse to process a container, the “Level” argument is appended the TabOrder expressed as a 3 digits number (This allow 999 controls per container which is probably enough).
At the end of the function, the level is tested to sort the list only in the case of the outer call.
Assembling the pieces
To make the code as easy to use as possible, I decided to use a record with methods instead of a class. This eliminates the need of creating an instance of the class. Before explaining how it works, let’s see how to use it.
The following code will iterate thru the list and display the name of each control:
1 2 3 4 5 6 7 8 9 10 11 12 | procedure TForm1.Button1Click(Sender: TObject);<br>var<br> Ctrl : TWinControl;<br> SR : TTabOrderSearchRecord;<br>begin<br> Ctrl := SR.FindFirst(Self);<br> while Assigned(Ctrl) do begin<br> Display(Ctrl.Name);<br> Ctrl := SR.FindNext(Ctrl);<br> end;<br> SR.FindClose;<br>end;<br> |
As you can see, I modeled the API to looks like what we do to scan a folder for files. There is a FindFirst method, a FindNext and a FindClose. Very easy to use.
The actual list is built when invoking FindFirst method and destroyed when calling FindClose. FindClose is actually optional and only required if you want to free memory before the record goes out of scope.
Here is the complete declaration, including the class which is used for the sorted list.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 | TTabOrderItem = class<br> Ctrl : TWinControl;<br> Level : String;<br> end;<br><br> TTabOrderSearchRecord = record<br> public<br> function FindFirst(Container: TWinControl): TWinControl;<br> function FindNext(FromCtrl: TWinControl): TWinControl;<br> function FindLast(Container: TWinControl): TWinControl;<br> function FindPrevious(FromCtrl: TWinControl): TWinControl;<br> function IndexOf(Container : TWinControl;<br> FromCtrl : TWinControl): Integer;<br> procedure FindClose;<br> strict private<br> CtrlsItems : IInterfaceList<ttaborderitem>;<br> procedure RecurseControls(Ctrl : TWinControl;<br> const Level : String = '');<br> end;<br></ttaborderitem> |
The implementation is quite simple but one thing is worth mentioning: I mean the use of an interface to hold the list. I used an interface because Delphi use automatic reference counting and will free to list as soon as it is no more used. This is very important for a record so that the list is freed when the record goes out of scope without using an explicit call.
TInterfaceList
The list is built around the simple TList and makes use of generics so that it can be reuse for many things. I used composition instead of inheritance to expose the minimal interface I wanted.
The interface itself is defined as an interface, again using generics to make it reusable.
1 2 3 4 5 6 7 8 | IInterfaceList<t>= interface(IInterface)<br> function Item(Index : Integer) : T;<br> function AddItem(Ctrl : T) : Integer;<br> function IndexOf(Ctrl : T) : Integer;<br> function ItemCount : Integer;<br> procedure Sort(Compare: TCompareFunction<t>);<br> end;<br></t></t> |
Since it is an interface, there is no direct implementation. The actual implementation is defined in a class. I derived the class from TInterfacedObject to get reference counting required for hosting an interface.
1 2 3 4 5 6 7 8 9 10 11 12 13 | TInterfacedList<t :="" class=""> = class(TInterfacedObject, IInterfaceList<t>)<br> strict private<br> FList : TList;<br> public<br> constructor Create;<br> destructor Destroy; override;<br> function Item(Index : Integer) : T;<br> function AddItem(Ctrl : T) : Integer;<br> function IndexOf(Ctrl : T) : Integer;<br> function ItemCount : Integer;<br> procedure Sort(Compare: TCompareFunction<t>);<br> end;<br></t></t></t> |
There is a constraint in the type used as a variable: it is limited to a class. This is required because the implementation uses some typecast which are only valid when the type is a class.
The sort method requires a comparison function so that it works whatever the type is.
1 2 | TCompareFunction<t> = function (Item1, Item2 : T) : Integer;<br></t> |
Complete implementation
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 | function CompareTabOrderItem(Item1, Item2: TTabOrderItem): Integer;<br>begin<br> if Item1.Level = Item2.Level then<br> Result := 0<br> else if Item1.Level < Item2.Level then<br> Result := -1<br> else<br> Result := 1;<br>end;<br><br>procedure TTabOrderSearchRecord.RecurseControls(<br> Ctrl : TWinControl;<br> const Level : String = '');<br>var<br> I : Integer;<br> CI : TTabOrderItem;<br>begin<br> if not Assigned(CtrlsItems) then<br> CtrlsItems := TInterfacedList<ttaborderitem>.Create;<br> if not Assigned(Ctrl) then<br> Exit;<br><br> CI := TTabOrderItem.Create;<br> CI.Ctrl := Ctrl;<br> CI.Level := Level;<br> CtrlsItems.AddItem(CI);<br><br> for I := 0 to Ctrl.ControlCount - 1 do begin<br> if Ctrl.Controls[I] is TWinControl then<br> RecurseControls(TWinControl(Ctrl.Controls[I]),<br> Level +<br> Format('%03.3d',<br> [TWinControl(Ctrl.Controls[I]).TabOrder + 2]));<br> end;<br> if Level = '' then<br> CtrlsItems.Sort(CompareTabOrderItem);<br>end;<br><br>procedure TTabOrderSearchRecord.FindClose;<br>begin<br> CtrlsItems := nil;<br>end;<br><br>function TTabOrderSearchRecord.FindFirst(Container: TWinControl): TWinControl;<br>var<br> I : Integer;<br>begin<br> //CtrlsItems := TInterfacedList<ttaborderitem>.Create;<br> RecurseControls(Container);<br> I := -1;<br> repeat<br> Inc(I);<br> until (I >= CtrlsItems.ItemCount) or<br> (CtrlsItems.Item(I).Ctrl.CanFocus and<br> CtrlsItems.Item(I).Ctrl.TabStop);<br> if I >= CtrlsItems.ItemCount then<br> Result := nil<br> else<br> Result := CtrlsItems.Item(I).Ctrl;<br>end;<br><br>function TTabOrderSearchRecord.FindLast(Container: TWinControl): TWinControl;<br>var<br> I : Integer;<br>begin<br> //CtrlsItems := TInterfacedList<ttaborderitem>.Create;<br> RecurseControls(Container);<br> I := CtrlsItems.ItemCount;<br> repeat<br> Dec(I);<br> until (I < 0) or<br> (CtrlsItems.Item(I).Ctrl.CanFocus and<br> CtrlsItems.Item(I).Ctrl.TabStop);<br> if I < 0 then<br> Result := nil<br> else<br> Result := CtrlsItems.Item(I).Ctrl;<br>end;<br><br>function TTabOrderSearchRecord.FindNext(FromCtrl: TWinControl): TWinControl;<br>var<br> I : Integer;<br>begin<br> Result := nil;<br> if CtrlsItems = nil then<br> Exit;<br> I := 0;<br> while I < CtrlsItems.ItemCount do begin<br> if CtrlsItems.Item(I).Ctrl = FromCtrl then begin<br> repeat<br> Inc(I);<br> until (I >= CtrlsItems.ItemCount) or<br> (CtrlsItems.Item(I).Ctrl.CanFocus and<br> CtrlsItems.Item(I).Ctrl.TabStop);<br> if I >= CtrlsItems.ItemCount then<br> Result := nil<br> else<br> Result := CtrlsItems.Item(I).Ctrl;<br> Exit;<br> end;<br> Inc(I);<br> end;<br>end;<br><br>function TTabOrderSearchRecord.FindPrevious(FromCtrl: TWinControl): TWinControl;<br>var<br> I : Integer;<br>begin<br> Result := nil;<br> if CtrlsItems = nil then<br> Exit;<br> I := 0;<br> while I < CtrlsItems.ItemCount do begin<br> if CtrlsItems.Item(I).Ctrl = FromCtrl then begin<br> repeat<br> Dec(I);<br> until (I < 0) or<br> (CtrlsItems.Item(I).Ctrl.CanFocus and<br> CtrlsItems.Item(I).Ctrl.TabStop);<br> if I < 0 then<br> Result := nil<br> else<br> Result := CtrlsItems.Item(I).Ctrl;<br> Exit;<br> end;<br> Inc(I);<br> end;<br>end;<br><br>function TTabOrderSearchRecord.IndexOf(<br> Container : TWinControl;<br> FromCtrl : TWinControl): Integer;<br>var<br> Ctrl : TWinControl;<br>begin<br> //CtrlsItems := TInterfacedList<ttaborderitem>.Create;<br> Result := 0;<br> Ctrl := FindFirst(Container);<br> while Assigned(Ctrl) do begin<br> if Ctrl = FromCtrl then<br> Exit;<br> Ctrl := FindNext(Ctrl);<br> Inc(Result);<br> end;<br> Result := -1;<br>end;<br><br>{ TInterfacedList }<br><br>function TInterfacedList<t>.AddItem(Ctrl: T): Integer;<br>begin<br> if not Assigned(FList) then<br> raise Exception.Create('TInterfacedList.AddItem failed: ' +<br> 'list not assigned');<br> Result := FList.Add(Pointer(Ctrl));<br>end;<br><br>constructor TInterfacedList<t>.Create;<br>begin<br> inherited Create;<br> FList := TList.Create;<br>end;<br><br>destructor TInterfacedList<t>.Destroy;<br>begin<br> FreeAndNil(FList);<br> inherited;<br>end;<br><br>function TInterfacedList<t>.IndexOf(Ctrl: T): Integer;<br>begin<br> if not Assigned(FList) then<br> Result := -1<br> else<br> Result := FList.IndexOf(Pointer(Ctrl));<br>end;<br><br>function TInterfacedList<t>.Item(Index: Integer): T;<br>begin<br> if (not Assigned(FList)) or (FList.Count <= 0) then<br> Result := nil<br> else<br> Result := T(FList[Index]);<br>end;<br><br>function TInterfacedList<t>.ItemCount: Integer;<br>begin<br> if not Assigned(FList) then<br> Result := 0<br> else<br> Result := FList.Count;<br>end;<br><br>procedure TInterfacedList<t>.Sort(Compare: TCompareFunction<t>);<br>var<br> I, J : Integer;<br> Temp : TWinControl;<br>begin<br> // TList has a quicksort method, but it is bugged in some versions<br> // FList.Sort(Compare);<br> // So we use the good old bubble sort, anyway the list is small<br> for J := 0 to FList.Count - 2 do begin<br> for I := J to FList.Count - 1 do begin<br> if Compare(FList.Items[J], FList.Items[I]) > 0 then begin<br> Temp := FList[J];<br> FList[J] := FList[I];<br> FList[I] := Temp;<br> end;<br> end;<br> end;<br>end;<br></t></t></t></t></t></t></t></t></ttaborderitem></ttaborderitem></ttaborderitem></ttaborderitem> |
Demo program and source code
I made a zip file available with the full source code, including a simple demo application showing how to use it. You can download it from http://www.overbyte.be/frame_index.html?redirTo=/blog_source_code.html
Follow me on Twitter
Follow me on LinkedIn
Follow me on Google+
Visit my website: http://www.overbyte.be
This article is available from http://francois-piette.blogspot.be/2013/04/taborder blues.html
3 comments:
Salut Francois,
sorry, but I can't find at the mentioned Website the Source Code File.
Best regards
Thomas
Fixed the missing file.
Thanks.
I puzzled over this for a bit, not sure why you would want such a collection. Then it occurred to me that having this collection would be a starting point to enabling the automated repositioning of controls on any container, when a form is resized. Nicely done, François.
Post a Comment