April 20, 2013

TabOrder blues


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:

procedure TTabOrderSearchRecord.RecurseControls(
Ctrl : TWinControl);
var
I : Integer;
begin
if not Assigned(Ctrl) then
Exit;
FList.Add(Ctrl);
for I := 0 to Ctrl.ControlCount - 1 do begin
if Ctrl.Controls[I] is TWinControl then
RecurseControls(TWinControl(Ctrl.Controls[I]));
end;
end;

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.

procedure TTabOrderSearchRecord.RecurseControls(
Ctrl : TWinControl;
const Level : String = '');
var
I : Integer;
CI : TTabOrderItem;
begin
if not Assigned(CtrlsItems) then
CtrlsItems := TInterfacedList.Create;
if not Assigned(Ctrl) then
Exit;

CI := TTabOrderItem.Create;
CI.Ctrl := Ctrl;
CI.Level := Level;
CtrlsItems.AddItem(CI);

for I := 0 to Ctrl.ControlCount - 1 do begin
if Ctrl.Controls[I] is TWinControl then
RecurseControls(TWinControl(Ctrl.Controls[I]),
Level +
Format('%03.3d',
[TWinControl(Ctrl.Controls[I]).TabOrder + 2]));
end;
if Level = '' then
CtrlsItems.Sort(CompareTabOrderItem);
end;

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:

procedure TForm1.Button1Click(Sender: TObject);
var
Ctrl : TWinControl;
SR : TTabOrderSearchRecord;
begin
Ctrl := SR.FindFirst(Self);
while Assigned(Ctrl) do begin
Display(Ctrl.Name);
Ctrl := SR.FindNext(Ctrl);
end;
SR.FindClose;
end;

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.

    TTabOrderItem = class
Ctrl : TWinControl;
Level : String;
end;

TTabOrderSearchRecord = record
public
function FindFirst(Container: TWinControl): TWinControl;
function FindNext(FromCtrl: TWinControl): TWinControl;
function FindLast(Container: TWinControl): TWinControl;
function FindPrevious(FromCtrl: TWinControl): TWinControl;
function IndexOf(Container : TWinControl;
FromCtrl : TWinControl): Integer;
procedure FindClose;
strict private
CtrlsItems : IInterfaceList;
procedure RecurseControls(Ctrl : TWinControl;
const Level : String = '');
end;

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.

    IInterfaceList= interface(IInterface)
function Item(Index : Integer) : T;
function AddItem(Ctrl : T) : Integer;
function IndexOf(Ctrl : T) : Integer;
function ItemCount : Integer;
procedure Sort(Compare: TCompareFunction);
end;

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.

    TInterfacedList = class(TInterfacedObject, IInterfaceList)
strict private
FList : TList;
public
constructor Create;
destructor Destroy; override;
function Item(Index : Integer) : T;
function AddItem(Ctrl : T) : Integer;
function IndexOf(Ctrl : T) : Integer;
function ItemCount : Integer;
procedure Sort(Compare: TCompareFunction);
end;

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.

    TCompareFunction = function (Item1, Item2 : T) : Integer;


Complete implementation


function CompareTabOrderItem(Item1, Item2: TTabOrderItem): Integer;
begin
if Item1.Level = Item2.Level then
Result := 0
else if Item1.Level < Item2.Level then
Result := -1
else
Result := 1;
end;

procedure TTabOrderSearchRecord.RecurseControls(
Ctrl : TWinControl;
const Level : String = '');
var
I : Integer;
CI : TTabOrderItem;
begin
if not Assigned(CtrlsItems) then
CtrlsItems := TInterfacedList.Create;
if not Assigned(Ctrl) then
Exit;

CI := TTabOrderItem.Create;
CI.Ctrl := Ctrl;
CI.Level := Level;
CtrlsItems.AddItem(CI);

for I := 0 to Ctrl.ControlCount - 1 do begin
if Ctrl.Controls[I] is TWinControl then
RecurseControls(TWinControl(Ctrl.Controls[I]),
Level +
Format('%03.3d',
[TWinControl(Ctrl.Controls[I]).TabOrder + 2]));
end;
if Level = '' then
CtrlsItems.Sort(CompareTabOrderItem);
end;

procedure TTabOrderSearchRecord.FindClose;
begin
CtrlsItems := nil;
end;

function TTabOrderSearchRecord.FindFirst(Container: TWinControl): TWinControl;
var
I : Integer;
begin
//CtrlsItems := TInterfacedList.Create;
RecurseControls(Container);
I := -1;
repeat
Inc(I);
until (I >= CtrlsItems.ItemCount) or
(CtrlsItems.Item(I).Ctrl.CanFocus and
CtrlsItems.Item(I).Ctrl.TabStop);
if I >= CtrlsItems.ItemCount then
Result := nil
else
Result := CtrlsItems.Item(I).Ctrl;
end;

function TTabOrderSearchRecord.FindLast(Container: TWinControl): TWinControl;
var
I : Integer;
begin
//CtrlsItems := TInterfacedList.Create;
RecurseControls(Container);
I := CtrlsItems.ItemCount;
repeat
Dec(I);
until (I < 0) or
(CtrlsItems.Item(I).Ctrl.CanFocus and
CtrlsItems.Item(I).Ctrl.TabStop);
if I < 0 then
Result := nil
else
Result := CtrlsItems.Item(I).Ctrl;
end;

function TTabOrderSearchRecord.FindNext(FromCtrl: TWinControl): TWinControl;
var
I : Integer;
begin
Result := nil;
if CtrlsItems = nil then
Exit;
I := 0;
while I < CtrlsItems.ItemCount do begin
if CtrlsItems.Item(I).Ctrl = FromCtrl then begin
repeat
Inc(I);
until (I >= CtrlsItems.ItemCount) or
(CtrlsItems.Item(I).Ctrl.CanFocus and
CtrlsItems.Item(I).Ctrl.TabStop);
if I >= CtrlsItems.ItemCount then
Result := nil
else
Result := CtrlsItems.Item(I).Ctrl;
Exit;
end;
Inc(I);
end;
end;

function TTabOrderSearchRecord.FindPrevious(FromCtrl: TWinControl): TWinControl;
var
I : Integer;
begin
Result := nil;
if CtrlsItems = nil then
Exit;
I := 0;
while I < CtrlsItems.ItemCount do begin
if CtrlsItems.Item(I).Ctrl = FromCtrl then begin
repeat
Dec(I);
until (I < 0) or
(CtrlsItems.Item(I).Ctrl.CanFocus and
CtrlsItems.Item(I).Ctrl.TabStop);
if I < 0 then
Result := nil
else
Result := CtrlsItems.Item(I).Ctrl;
Exit;
end;
Inc(I);
end;
end;

function TTabOrderSearchRecord.IndexOf(
Container : TWinControl;
FromCtrl : TWinControl): Integer;
var
Ctrl : TWinControl;
begin
//CtrlsItems := TInterfacedList.Create;
Result := 0;
Ctrl := FindFirst(Container);
while Assigned(Ctrl) do begin
if Ctrl = FromCtrl then
Exit;
Ctrl := FindNext(Ctrl);
Inc(Result);
end;
Result := -1;
end;

{ TInterfacedList }

function TInterfacedList.AddItem(Ctrl: T): Integer;
begin
if not Assigned(FList) then
raise Exception.Create('TInterfacedList.AddItem failed: ' +
'list not assigned');
Result := FList.Add(Pointer(Ctrl));
end;

constructor TInterfacedList.Create;
begin
inherited Create;
FList := TList.Create;
end;

destructor TInterfacedList.Destroy;
begin
FreeAndNil(FList);
inherited;
end;

function TInterfacedList.IndexOf(Ctrl: T): Integer;
begin
if not Assigned(FList) then
Result := -1
else
Result := FList.IndexOf(Pointer(Ctrl));
end;

function TInterfacedList.Item(Index: Integer): T;
begin
if (not Assigned(FList)) or (FList.Count <= 0) then
Result := nil
else
Result := T(FList[Index]);
end;

function TInterfacedList.ItemCount: Integer;
begin
if not Assigned(FList) then
Result := 0
else
Result := FList.Count;
end;

procedure TInterfacedList.Sort(Compare: TCompareFunction);
var
I, J : Integer;
Temp : TWinControl;
begin
// TList has a quicksort method, but it is bugged in some versions
// FList.Sort(Compare);
// So we use the good old bubble sort, anyway the list is small
for J := 0 to FList.Count - 2 do begin
for I := J to FList.Count - 1 do begin
if Compare(FList.Items[J], FList.Items[I]) > 0 then begin
Temp := FList[J];
FList[J] := FList[I];
FList[I] := Temp;
end;
end;
end;
end;


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:

Thomas (Hamburg) said...

Salut Francois,

sorry, but I can't find at the mentioned Website the Source Code File.

Best regards

Thomas

François Piette said...

Fixed the missing file.
Thanks.

William Meyer said...

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.