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