Is there a data-aware tab control available?

Question

Data-aware controls can be linked to datasets to display data contained in fields in the current row, or in some cases, data from one or more columns along multiple rows. And the TTabControl lets you apply the same set of controls to different sets of data values in an easy-to-understand way.

Seems to me that they would go well together. TTabControl would make a good data-aware control (link it to an identity column in the dataset and it could be a much more intuitive navigator than TDBNavigator), but there isn't one in the VCL.

Has anyone out there created a data-aware tab control? The only one I've found is DBTABCONTROL98 by Jean-Luc Mattei, which dates back to 1998 (Delphi 3 era) and, even after modifying it to get it to compile under XE, does not actually work. Are there any others that work as expected? (ie. adding/deleting tabs when new records are added/removed from the dataset, and switching the dataset's active row when the user changes tabs and vice versa.)

And yes, I'm aware that that could get a bit unwieldy if there are a lot of rows in the dataset. I'm looking for something to build a UI for a use case where the number of rows is in single- or very low double digits.

Scene

I would call it a tabset instead of a tabcontrol since you would want to share a single "client area" (the controls inside). – Heptateuch

data from multiple rows. But that's not what I care about here I think you áre speaking about data from multiple rows! You want a DBGrid where the row index is attached to the tabs, and where the columns are attached to controls underneath these tabs. – Intimidate

@NGLN: Good point. What I was thinking when I wrote that didn't quite match what I ended up writing. Edited. – Scene

@Warren: I call it a tab control because that's what the VCL calls it. – Scene

NO, a tab control contains X pages and each page contains different controls. That's what the Vcl calls a tab control. It also contains a tabset, and that's what the VCL calls it when you have tabs that don't contain pages. – Heptateuch

@WarrenP: I think you're thinking of TPageControl. TTabControl is exactly what I described. And TTabSet is something different entirely; it's basically just the tabs, with no page container. – Scene

Answer 1

I wrote a TDBTabControl for you. If you do not set the DataField property, then the captions of tabs will be the record index. The starred tab indicates a new record, which visibility can be toggled with the ShowInsertTab property.

I inherited from TCustomTabControl because the properties Tabs, TabIndex and MultiSelect may not be published for this component.

unit DBTabControl;

interface

uses
  Classes, Windows, SysUtils, Messages, Controls, ComCtrls, DB, DBCtrls;

type
  TCustomDBTabControl = class(TCustomTabControl)
  private
    FDataLink: TFieldDataLink;
    FPrevTabIndex: Integer;
    FShowInsertTab: Boolean;
    procedure ActiveChanged(Sender: TObject);
    procedure DataChanged(Sender: TObject);
    function GetDataField: String;
    function GetDataSource: TDataSource;
    function GetField: TField;
    procedure RebuildTabs;
    procedure SetDataField(const Value: String);
    procedure SetDataSource(Value: TDataSource);
    procedure SetShowInsertTab(Value: Boolean);
    procedure CMExit(var Message: TCMExit); message CM_EXIT;
    procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
  protected
    function CanChange: Boolean; override;
    procedure Change; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure Notification(AComponent: TComponent; Operation: TOperation);
      override;
    procedure Loaded; override;
    property DataField: String read GetDataField write SetDataField;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property Field: TField read GetField;
    property ShowInsertTab: Boolean read FShowInsertTab write SetShowInsertTab
      default False;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function ExecuteAction(Action: TBasicAction): Boolean; override;
    function UpdateAction(Action: TBasicAction): Boolean; override;
  end;

  TDBTabControl = class(TCustomDBTabControl)
  public
    property DisplayRect;
    property Field;
  published
    property Align;
    property Anchors;
    property BiDiMode;
    property Constraints;
    property DockSite;
    property DataField;
    property DataSource;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property HotTrack;
    property Images;
    property MultiLine;
    property OwnerDraw;
    property ParentBiDiMode;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property RaggedRight;
    property ScrollOpposite;
    property ShowHint;
    property ShowInsertTab;
    property Style;
    property TabHeight;
    property TabOrder;
    property TabPosition;
    property TabStop;
    property TabWidth;
    property Visible;
    property OnChange;
    property OnChanging;
    property OnContextPopup;
    property OnDockDrop;
    property OnDockOver;
    property OnDragDrop;
    property OnDragOver;
    property OnDrawTab;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnGetImageIndex;
    property OnGetSiteInfo;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
    property OnStartDock;
    property OnStartDrag;
    property OnUnDock;
  end;

implementation

{ TCustomDBTabControl }

procedure TCustomDBTabControl.ActiveChanged(Sender: TObject);
begin
  RebuildTabs;
end;

function TCustomDBTabControl.CanChange: Boolean;
begin
  FPrevTabIndex := TabIndex;
  Result := (inherited CanChange) and (DataSource <> nil) and
    (DataSource.State in [dsBrowse, dsEdit, dsInsert]);
end;

procedure TCustomDBTabControl.Change;
var
  NewTabIndex: Integer;
begin
  try
    if FDataLink.Active and (DataSource <> nil) then
    begin
      if FShowInsertTab and (TabIndex = Tabs.Count - 1) then
        DataSource.DataSet.Append
      else if DataSource.State = dsInsert then
      begin
        NewTabIndex := TabIndex;
        DataSource.DataSet.CheckBrowseMode;
        DataSource.DataSet.MoveBy(NewTabIndex - TabIndex);
      end
      else
        DataSource.DataSet.MoveBy(TabIndex - FPrevTabIndex);
    end;
    inherited Change;
  except
    TabIndex := FPrevTabIndex;
    raise;
  end;
end;

procedure TCustomDBTabControl.CMExit(var Message: TCMExit);
begin
  try
    FDataLink.UpdateRecord;
  except
    SetFocus;
    raise;
  end;
  inherited;
end;

procedure TCustomDBTabControl.CMGetDataLink(var Message: TMessage);
begin
  Message.Result := Integer(FDataLink);
end;

constructor TCustomDBTabControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDataLink := TFieldDataLink.Create;
  FDataLink.Control := Self;
  FDataLink.OnActiveChange := ActiveChanged;
  FDataLink.OnDataChange := DataChanged;
end;

procedure TCustomDBTabControl.DataChanged(Sender: TObject);
const
  StarCount: array[Boolean] of Integer = (0, 1);
var
  NewTabIndex: Integer;
begin
  if FDataLink.Active and (DataSource <> nil) then
    with DataSource do
    begin
      if DataSet.RecordCount <> Tabs.Count - StarCount[FShowInsertTab] then
        RebuildTabs
      else if (State = dsInsert) and FShowInsertTab then
        TabIndex := Tabs.Count - 1
      else if Tabs.Count > 0 then
      begin
        NewTabIndex := Tabs.IndexOfObject(TObject(DataSet.RecNo));
        if (TabIndex = NewTabIndex) and (State <> dsInsert) and
            (Field <> nil) and (Field.AsString <> Tabs[TabIndex]) then
          Tabs[TabIndex] := Field.AsString;
        TabIndex := NewTabIndex;
      end;
    end;
end;

destructor TCustomDBTabControl.Destroy;
begin
  FDataLink.Free;
  FDataLink := nil;
  inherited Destroy;
end;

function TCustomDBTabControl.ExecuteAction(Action: TBasicAction): Boolean;
begin
  Result := inherited ExecuteAction(Action) or FDataLink.ExecuteAction(Action);
end;

function TCustomDBTabControl.GetDataField: String;
begin
  Result := FDataLink.FieldName;
end;

function TCustomDBTabControl.GetDataSource: TDataSource;
begin
  Result := FDataLink.DataSource;
end;

function TCustomDBTabControl.GetField: TField;
begin
  Result := FDataLink.Field;
end;

procedure TCustomDBTabControl.KeyDown(var Key: Word; Shift: TShiftState);
begin
  if (DataSource <> nil) and (DataSource.State = dsInsert) and
    (Key = VK_ESCAPE) then
  begin
    DataSource.DataSet.Cancel;
    Change;
  end;
  inherited keyDown(Key, Shift);
end;

procedure TCustomDBTabControl.Loaded;
begin
  inherited Loaded;
  if (csDesigning in ComponentState) then
    RebuildTabs;
end;

procedure TCustomDBTabControl.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (FDataLink <> nil) and
      (AComponent = DataSource) then
    DataSource := nil;
end;

procedure TCustomDBTabControl.RebuildTabs;
var
  Bookmark: TBookmark;
begin
  if (DataSource <> nil) and (DataSource.State = dsBrowse) then
    with DataSource do
    begin
      if HandleAllocated then
        LockWindowUpdate(Handle);
      Tabs.BeginUpdate;
      DataSet.DisableControls;
      BookMark := DataSet.GetBookmark;
      try
        Tabs.Clear;
        DataSet.First;
        while not DataSet.Eof do
        begin
          if Field = nil then
            Tabs.AddObject(IntToStr(Tabs.Count + 1), TObject(DataSet.RecNo))
          else
            Tabs.AddObject(Field.AsString, TObject(DataSet.RecNo));
          DataSet.Next;
        end;
        if FShowInsertTab then
          Tabs.AddObject('*', TObject(-1));
      finally
        DataSet.GotoBookmark(Bookmark);
        DataSet.FreeBookmark(Bookmark);
        DataSet.EnableControls;
        Tabs.EndUpdate;
        if HandleAllocated then
          LockWindowUpdate(0);
      end;
    end
  else
    Tabs.Clear;
end;

procedure TCustomDBTabControl.SetDataField(const Value: String);
begin
  FDataLink.FieldName := Value;
  RebuildTabs;
end;

procedure TCustomDBTabControl.SetDataSource(Value: TDataSource);
begin
  FDataLink.DataSource := Value;
  if DataSource <> nil then
    DataSource.FreeNotification(Self);
  if not (csLoading in ComponentState) then
    RebuildTabs;
end;

procedure TCustomDBTabControl.SetShowInsertTab(Value: Boolean);
begin
  if FShowInsertTab <> Value then
  begin
    FShowInsertTab := Value;
    RebuildTabs;
  end;
end;

function TCustomDBTabControl.UpdateAction(Action: TBasicAction): Boolean;
begin
  Result := inherited UpdateAction(Action) or FDataLink.UpdateAction(Action);
end;

end.

unit DBTabControlReg;

interface

uses
  Classes, DBTabControl;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TDBTabControl]);
end;

end.

package DBTabControl70;

{$R *.res}
{$ALIGN 8}
{$ASSERTIONS ON}
{$BOOLEVAL OFF}
{$DEBUGINFO ON}
{$EXTENDEDSYNTAX ON}
{$IMPORTEDDATA ON}
{$IOCHECKS ON}
{$LOCALSYMBOLS ON}
{$LONGSTRINGS ON}
{$OPENSTRINGS ON}
{$OPTIMIZATION OFF}
{$OVERFLOWCHECKS ON}
{$RANGECHECKS ON}
{$REFERENCEINFO ON}
{$SAFEDIVIDE OFF}
{$STACKFRAMES ON}
{$TYPEDADDRESS OFF}
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST OFF}
{$MINENUMSIZE 1}
{$IMAGEBASE $400000}
{$DESCRIPTION '#DBTabControl'}
{$IMPLICITBUILD OFF}

requires
  rtl,
  vcl,
  dbrtl,
  vcldb;

contains
  DBTabControl in 'DBTabControl.pas',
  DBTabControlReg in 'DBTabControlReg.pas';

end.

Intimidate

Looks great, except for a couple things: No Align or TabOrder properties, (did those exist back in D7? They do in XE,) and being able to correctly track row insertions and deletions is very important to my use case. But this looks like a good starting point. I'll hack at it a little and see if I can build something further from it... – Scene

+1 and bookmarked. Thanks for writing those good components for the public. – Numerate

@Mason You missed the TODO in the code... ;) I will add record count change handling. Tomorrow. ;) – Intimidate

@Mason It now also tracks insertions and deletions. Have fun. (Oh that nasty addiction, couldn't sleep!) – Intimidate

@NGLN: That's better, but a UI built with it is unusable: if I edit any of the controls linked to the same dataset or use the * tab, I'm suddenly unable to switch tabs! In the CanChange and Change methods, it needs to be able to accept DataSource.State in [dsBrowse, dsEdit, dsInsert], not just = dsBrowse. Not sure if the other places in the code that make the same check have to be changed as well or not. If I change those two, it seems to work, though. – Scene

@Mason Yeah, that was a temporary decision because I couldn't figure out how to undo tab change in case of a data validation error. I now use a try-except block in the Change method, but I am not completely sure if that ensures resetting the tab index in case of exception handling elsewhere in the application. Also, the component is properly debugged and refactored by now... ;) – Intimidate

@NGLN: Great work. Just a couple minor issues. The tab naming isn't always consistent (create a button that, when clicked, adds a new row to the dataset, and on the Tab Control's linked field, have it keep count: 1, 2, 3, etc. Click it a few times and you'll see duplicate numbers showing up in the tab labels, which doesn't match what's actually in the dataset.) Also, the behavior of the * tab is kind of strange. Click it, change some data in the linked controls, switch to another tab and back to the * tab, and your changes are gone. – Scene

And it would be very nice to be able to either disable the * tab or put an event handler on it, since it's quite possible that the application will have internal rules that new rows need to conform to. Just blindly calling Dataset.Append can violate that. – Scene

@Mason I added a ShowInsertTab property. No event though, I would prefer DataSource.OnStateChange for that. Changes on the * tab are now preserved. I cannot replicate the tab naming issue you described. What did you mean by have it keep count? – Intimidate

+1. I also started writing that component yesterday (the skeleton was in fact TDBListBox) but after you posted the code I have dumped it. just a few comments: Wouldn't it be better to store TObject(bookmark) instead of RecNo? what will happen if the dataset is filtered or sorted? Did you take account of that? – Anarchist

@NGLN: As in, the first tab gets named 1, the second gets named 2, etc. I did it with a CDS aggregate because it's one part of bigger design requirements, but for testing purposes you could probably just insert the value dataset.RecordCount + 1. – Scene

Also, the new version gives an error as soon as I open the form: Exception class EListError with message 'Failed to retrieve tab at index -1', coming from the IndexOfObject call on line 178. It seems there are a few things still to work out. Would you be able to meet me in a SO Chat room to facilitate discussion? That would be easier than using all these comments back and forth... – Scene

@mason join me here – Intimidate

@Anarchist Filtered datasets go well: as soon as the dataset reopens, the tabs will be rebuilded. Bookmarks take a little more administrative tasks as freeing afterwards. Also, I didn't succeed in get a valid comparison between bookmarks, but that well may be my mistake or inexperience. I think I have to check for sorting. – Intimidate