The WebSnap framework is a big step forward in developing Web applications using Delphi. Of course it has some limitations, some of them by design, some of them by implementation. The first ones need Borland's attention, the last ones can be avoided or removed because Delphi is a very easy to extend development environment.

My goal is combine the power of TAdapterGrid (mostly the paging options) with the custom layout that can be achieved with TAdapterFieldGroup and TLayoutGroup. Of course in WebSnap we can edit the HTML script with another editor, but it's a lot easier to use the WebEditor included with the IDE to generate the layout we want.

Here is a picture of the layout I quickly build using these components:

To do this, there are a few things to investigate. Generally, the best documentation is the source itself, so let's start there.

One common key to all classes used with the WebEditor is the next interface:

  IWebComponentEditor = interface
  ['{13F59F61-EF85-11D2-AFB1-00C04FB16EC3}']
    function CanAddClass(AParent: TComponent; AClass: TClass): Boolean;
  end;

This interface's only function determines if another class can be added as a child of this one. Because the original grid accepts only limited set of children, we will define a new grid with the only purpose to accept our class and implement it:

type
  TAdapterGridEx = class(TAdapterGrid)
  protected
    { IWebComponentEditor }
    function ImplCanAddClass(AParent: TComponent; AClass: TClass): Boolean; override;
  end;
...

function TAdapterGridEx.ImplCanAddClass(AParent: TComponent; AClass: TClass): Boolean;
begin
  Result := inherited ImplCanAddClass(AParent,AClass);
  if not Result then
    Result:=AClass.InheritsFrom(TAdapterColumnFieldGroup)
      or AClass.InheritsFrom(TLayoutColumnGroup);
end;

The classes you see in the body are the ones to implement.

TAdapterColumnFieldGroup

This class is the most important. It's a descendant of TAdapterCustomFieldGroup, but it has enhanced functionality to work as a column. The additions are the caption-related and HTML-align properties as well as the IFormatColumn interface. It also hides the adapter property inherited from its ancestor but forces it to the same value as the parent grid's.

  TAdapterColumnFieldGroup = class(TCustomAdapterFieldGroup,
    INotifyAdapterChange, IFormatColumn)
  private
    FCaptionAttributes: TCaptionAttributes;
    FCaption:string;
    FAlign: THTMLAlign;
    FVAlign: THTMLVAlign;
    FAdapterContainer:TComponent;
    function IsCaptionStored: Boolean;
    procedure SetCaptionAttributes(const Value: TCaptionAttributes);
  protected
    procedure ParentChanged; override;
    function GetAdapter:TComponent;
    { INotifyAdapterChange }
    procedure NotifyAdapterChange(Sender: TComponent);
    { IFormatColumn }
    function FormatColumnHeading(Options: TWebContentOptions): string;
    function FormatColumnData(const Content: string; Options: TWebContentOptions): string;
    { IWebContent }
    function ImplContent(Options: TWebContentOptions; ParentLayout: TLayout): string; override;
    procedure Loaded;override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property AddDefaultFields;
    property Custom;
    property Style;
    property StyleRule;

    property Caption: string read FCaption write FCaption
      stored IsCaptionStored;
    property CaptionAttributes: TCaptionAttributes
      read FCaptionAttributes write SetCaptionAttributes;
    property Align: THTMLAlign read FAlign write FAlign default haDefault;
    property VAlign: THTMLVAlign read FVAlign write FVAlign default haVDefault;
  end;

The next bit of source keeps the adapter in sync with the parent grid's. The solution is to respond to the ParentChanged notification and register for notifications of adapter changes with the parent grid. This way we avoid creating another component to deal with adapter fields.

procedure TAdapterColumnFieldGroup.NotifyAdapterChange(Sender: TComponent);
begin
  //update the adapter
  GetAdapter;
  inherited;
end;

procedure TAdapterColumnFieldGroup.ParentChanged;
var AComponent:TComponent;
  Intf: IGetVariablesContainerOfDisplay;
  nl: INotifyList;
begin
  inherited;
  if csLoading in ComponentState then
    //on loading the parent might be null
    exit;
  AComponent:=Self.GetParentComponent;
  while Assigned(AComponent) do
  begin
    if Supports(IInterface(AComponent), IGetVariablesContainerOfDisplay, Intf) then
      break;
    AComponent := AComponent.GetParentComponent;
  end;
  if (FAdapterContainer<>AComponent) then
  begin
    if Assigned(FAdapterContainer)and
      Supports(IInterface(FAdapterContainer),INotifyList,nl) then
      //unregister for adapter notification
      nl.RemoveNotify(self);
    //private variable to hold the parent with the adapter
    //it's not the same as the parent component when using TLayoutColumnGroup
    FAdapterContainer:=AComponent;
    if Assigned(FAdapterContainer)and
      Supports(IInterface(FAdapterContainer),INotifyList,nl) then
      //register for adapter notification
      nl.AddNotify(self);
  end;
  //update the adapter
  GetAdapter;
end;

procedure TAdapterColumnFieldGroup.Loaded;
begin
  inherited;
  //synchronize the adapter
  ParentChanged;
end;

procedure TAdapterColumnFieldGroup.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited;
  if (Operation=opRemove) and (AComponent=FAdapterContainer) then
  begin
    FAdapterContainer:=nil;
    ParentChanged;
  end;
end;

function TAdapterColumnFieldGroup.GetAdapter:TComponent;
var  Intf: IGetVariablesContainerOfDisplay;
begin
  if Assigned(FAdapterContainer) and
    Supports(IInterface(FAdapterContainer), IGetVariablesContainerOfDisplay, Intf) then
    Adapter := Intf.GetVariablesContainer
  else Adapter:=nil;
  Result:=Adapter;
end;

The next function generates the HTML script. It's a copy of the original implementation, with a few changes: It does not create the hidden field for the adapter mode (I assume the same mode as the parent grid), and it does not generate the hidden fields because the grid generates them.

function TAdapterColumnFieldGroup.ImplContent(Options: TWebContentOptions; ParentLayout: TLayout): string;
var   FFormLayout: TAdapterFormLayout;
  function FormatField(Field: TComponent): string;
  var
    Intf: IWebContent;
  begin
    if Supports(IInterface(Field), IWebContent, Intf) then
      Result := Intf.Content(Options, FFormLayout)
    else
      Result := '';
  end;
var
  I: Integer;
  Intf: ILayoutWebContent;
  A: TLayoutAttributes;
begin
  FFormLayout := TAdapterFormLayout.Create(ParentLayout);
  try
    FFormLayout.TableHeader := Format('<table%s>', [GetLayoutAttributes.ControlAttributes]);
    Result := '';
    for I := 0 to VisibleFields.Count - 1 do
      Result := Result + FormatField(VisibleFields[I]);
    Result := Result + FFormLayout.EndLayout;
    if Supports(ParentLayout, ILayoutWebContent, Intf) then
      if ParentLayout is TAdapterFormLayout then
        Result := Intf.LayoutTable(Result, nil)
      else
      begin
        A := TLayoutAttributes.Create;
        try
          with A do
          begin
            AddQuotedAttrib(ControlAttributes, sAlignAttr, HTMLAlignValues[haCenter]);
            AddQuotedAttrib(ControlAttributes, sVAlignAttr, HTMLVAlignValues[haTop]);
            Result := Intf.LayoutTable(#13#10 + Result, A);
          end
        finally
          A.Free;
        end;
      end;
  finally
    FreeAndNil(FFormLayout);
  end;
end;

The next methods implement the IFormatColumn interface, making possible to use our group as a column:

function TAdapterColumnFieldGroup.FormatColumnData(const Content: string; Options: TWebContentOptions): string;
var
  Attribs: string;
begin
  AddQuotedAttrib(Attribs, sAlignAttr, HTMLAlignValues[Align]);
  AddQuotedAttrib(Attribs, sVAlignAttr, HTMLVAlignValues[VAlign]);
  AddQuotedAttrib(Attribs, sStyleAttr, Style);
  AddQuotedAttrib(Attribs, sClassAttr, StyleRule);
  AddCustomAttrib(Attribs, Custom);
  Result := Format('<td%s>%s</td>'#13#10, [Attribs, Content]);
end;

function TAdapterColumnFieldGroup.FormatColumnHeading(Options: TWebContentOptions): string;
var
  Attribs: string;
  S: string;
begin
  AddQuotedAttrib(Attribs, sAlignAttr, HTMLAlignValues[FCaptionAttributes.Align]);
  AddQuotedAttrib(Attribs, sVAlignAttr, HTMLVAlignValues[FCaptionAttributes.VAlign]);
  AddQuotedAttrib(Attribs, sStyleAttr, FCaptionAttributes.Style);
  AddCustomAttrib(Attribs, FCaptionAttributes.Custom);
  AddQuotedAttrib(Attribs, sClassAttr, FCaptionAttributes.StyleRule);
  S := FCaption;
  if S='' then S:='&nbsp;';
  Result := Format('<th%s>%s</th>'#13#10, [Attribs, S]);
end;

With this Web component you can have a group of fields in one column of a grid. But that's not enough. How can you define custom layout as TLayoutGroup allows you to do? The response is obvious: We need an improved component, TLayoutColumnGroup. Its definition is:

  TLayoutColumnGroup = class(TCustomLayoutGroup, IFormatColumn)
  private
    FCaptionAttributes: TCaptionAttributes;
    FCaption:string;
    FAlign: THTMLAlign;
    FVAlign: THTMLVAlign;
    function IsCaptionStored: Boolean;
    procedure SetCaptionAttributes(const Value: TCaptionAttributes);
  protected
    { IFormatColumn }
    function FormatColumnHeading(Options: TWebContentOptions): string;
    function FormatColumnData(const Content: string; Options: TWebContentOptions): string;
    { IWebComponentEditor }
    function ImplCanAddClass(AParent: TComponent; AClass: TClass): Boolean; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published

    property Caption: string read FCaption write FCaption
      stored IsCaptionStored;
    property CaptionAttributes: TCaptionAttributes
      read FCaptionAttributes write SetCaptionAttributes;
    property Align: THTMLAlign read FAlign write FAlign default haDefault;
    property VAlign: THTMLVAlign read FVAlign write FVAlign default haVDefault;

    property DisplayColumns;
    property Style;
    property Custom;
    property StyleRule;
  end;

As you can see, this component needs to implement the IFormatColumn interface too -- otherwise it can't be used directly in a grid. I won't insist too much because it's the same idea, but only the following method; we want to be able to have TLayoutGroup as child but no more TLayoutColumnGroup:

function TLayoutColumnGroup.ImplCanAddClass(AParent: TComponent;
  AClass: TClass): Boolean;
begin
  Result:=Inherited ImplCanAddClass(AParent,AClass);
  Result:=(Result or AClass.InheritsFrom(TLayoutGroup))
    and not AClass.InheritsFrom(TLayoutColumnGroup);
end;

The only things we (I mean you) have to do is copy the sources to a file, add to a new or existing package, and register the Web components. Of course the listing is not complete (~80%, only the definitions are fully copied), so you have to fill the remaining code (constructors, private variables, and so on). It's just an exercise, isn't it?

If you don't want to mess with it, you can download the package from Code Central. For any further questions, please contact me at gabrielcorneanu@yahoo.com.