source: trunk/Application/WebObjects.pas

unit WebObjects;

interface

uses
  Classes, SysUtils, HtmlClasses, XmlClasses, Generics.Collections;

type
  TQueryFormItemType = (fitText, fitComboBox, fitRadioButton, fitSelect, fitPassword,
    fitSubmit, fitReset, fitHidden, fitFileSelect, fitButton, fitCheckBox, fitTextArea);

  { TQueryFormItem }

  TQueryFormItem = class
  private
    FInputType: TQueryFormItemType;
    FItemType: TQueryFormItemType;
    function GetName: string;
    procedure SetItemType(const AValue: TQueryFormItemType);
    procedure SetName(AValue: string);
  public
    Caption: string;
    Required: Boolean;
    Hint: string;
    Value: THTMLInput;
    property Name: string read GetName write SetName;
    property ItemType: TQueryFormItemType read FItemType write SetItemType;
    constructor Create;
    destructor Destroy; override;
  end;

  { TQueryFormItemList }

  TQueryFormItemList = class(TObjectList<TQueryFormItem>)
    function FindByName(AValue: string): TQueryFormItem;
  end;

  { TQueryFormGroup }

  TQueryFormGroup = class
    Title: string;
    Rows: TQueryFormItemList;
    procedure Load(Items: TDictionary<string, string>);
    function AddNewItem: TQueryFormItem;
    constructor Create;
    destructor Destroy; override;
  end;

  TQueryFormGroups = class(TObjectList<TQueryFormGroup>)
  end;

  TQueryAction = class
    Caption: string;
    Action: string;
  end;

  TQueryActions = class(TObjectList<TQueryAction>)
  end;

  TQueryForm = class(THtmlForm)
  protected
    function GetAsXmlElement: TXmlElement; override;
  public
    Title: string;
    Groups: TQueryFormGroups;
    Actions: TQueryActions;
    ClassId: string;
    function AddNewGroup: TQueryFormGroup;
    function AddNewAction(Caption, Action: string): TQueryAction;
    procedure Load(Items: TDictionary<string, string>);
    constructor Create;
    destructor Destroy; override;
  end;


implementation

{ TQueryFormItemList }

function TQueryFormItemList.FindByName(AValue: string): TQueryFormItem;
var
  I: Integer;
begin
  I := 0;
  while (I < Count) and (Items[I].Value.ItemName <> AValue) do Inc(I);
  if I < Count then Result := Items[I]
    else Result := nil;
end;

{ TQueryFormItem }

procedure TQueryFormItem.SetItemType(const AValue: TQueryFormItemType);
begin
  if FItemType = AValue then Exit;
  FItemType := AValue;
  case AValue of
    fitButton: Value.InputType := itButton;
    fitSubmit: Value.InputType := itSubmit;
    fitReset: Value.InputType := itReset;
    fitHidden: Value.InputType := itHidden;
    fitCheckBox: Value.InputType := itCheckBox;
    fitPassword: Value.InputType := itPassword;
    fitText: Value.InputType := itText;
    fitFileSelect: Value.InputType := itFileSelect;
  end;
end;

function TQueryFormItem.GetName: string;
begin
  Result := Value.ItemName;
end;

procedure TQueryFormItem.SetName(AValue: string);
begin
  Value.ItemName := AValue;
end;

constructor TQueryFormItem.Create;
begin
  Value := THtmlInput.Create;
end;

destructor TQueryFormItem.Destroy;
begin
  FreeAndNil(Value);
  inherited;
end;

{ TQueryForm }

function TQueryForm.GetAsXmlElement: TXmlElement;
var
  I: Integer;
  G: Integer;
  Table: THtmlTable;
  Row: THtmlRow;
begin
  Result := inherited GetAsXmlElement;
  with TXmlTag(Result).SubElements do begin
    Table := THtmlTable.Create;
    Table.ClassId := ClassId;
    Row := Table.Rows.AddRow;
    with Row.Cells.AddCell do begin
      ColSpan := 2;
      Value := THtmlString.Create;
      THtmlString(Value).Text := Title;
    end;
    with Table do
    for G := 0 to Groups.Count - 1 do
    with Groups[G] do begin
      if Title <> '' then begin
        Row := Table.Rows.AddRow;
        with Row.Cells.AddCell do begin
          ColSpan := 2;
          Value := THtmlString.Create;
          THtmlString(Value).Text := Title;
        end;
      end;
      for I := 0 to Rows.Count - 1 do
      with Rows[I] do begin
        Row := Table.Rows.AddRow;
        with Row.Cells.AddCell do begin
          Value := THtmlString.Create;
          THtmlString(Value).Text := Caption;
          if Required then THtmlString(Value).Text := THtmlString(Value).Text + '*';
          THtmlString(Value).Text := THtmlString(Value).Text + ': ';
        end;
        with Row.Cells.AddCell do begin
          Value := THtmlInput.Create;
          THtmlInput(Value).Assign(Rows[I].Value);
        end;
      end;
    end;
    Row := Table.Rows.AddRow;
    with Row.Cells.AddCell do begin
      ColSpan := 2;
      Value := THtmlBlock.Create;
      for I := 0 to Actions.Count - 1 do
      with THtmlBlock(Value).SubItems.AddInput do begin
        Value := Actions[I].Caption;
        InputType := itSubmit;
        ItemName := Actions[I].Action;
      end;
    end;
    Add(Table.AsXmlElement);
    Table.Free;
  end;
end;

function TQueryForm.AddNewGroup: TQueryFormGroup;
begin
  Result := TQueryFormGroup.Create;
  Groups.Add(Result);
end;

function TQueryForm.AddNewAction(Caption, Action: string): TQueryAction;
begin
  Result := TQueryAction.Create;
  Result.Caption := Caption;
  Result.Action := Action;
  Actions.Add(Result);
end;

procedure TQueryForm.Load(Items: TDictionary<string, string>);
var
  I: Integer;
begin
  for I := 0 to Groups.Count - 1 do
    Groups[I].Load(Items);
end;

constructor TQueryForm.Create;
begin
  inherited;
  Actions := TQueryActions.Create;
  Groups := TQueryFormGroups.Create;
  Method := 'post';
  Action.AsString := '';
end;

destructor TQueryForm.Destroy;
begin
  FreeAndNil(Actions);
  FreeAndNil(Groups);
  inherited;
end;

{ TQueryFormGroup }

procedure TQueryFormGroup.Load(Items: TDictionary<string, string>);
var
  I: Integer;
  Item: string;
begin
  for I := 0 to Rows.Count - 1 do
  with Rows[I] do begin
    if Items.TryGetValue(Value.ItemName, Item) then
      Value.Value := Item;
  end;
end;

function TQueryFormGroup.AddNewItem: TQueryFormItem;
begin
  Result := TQueryFormItem.Create;
  Rows.Add(Result);
end;

constructor TQueryFormGroup.Create;
begin
  Rows := TQueryFormItemList.Create;
end;

destructor TQueryFormGroup.Destroy;
begin
  FreeAndNil(Rows);
  inherited;
end;

end.