pas2js/packages/webwidget/dbhtmlwidgets.pp

{
    This file is part of the Free Pascal run time library.
    Copyright (c) 2019-Now by Michael Van Canneyt, member of the
    Free Pascal development team

    WEB Widget Set : DB-AWare bare HTML Widgets

    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

 **********************************************************************}
unit dbhtmlwidgets;

{$mode objfpc}
{$h+}
{$define NESTEDCLASSBUG}
interface

uses
  Classes, SysUtils, db, web, htmlwidgets;

Type

  { TCustomDBTableWidget }

  { TDBTableColumn }

  TDBTableColumn = class(TCustomTableColumn)
  private
    FFieldName: String;
    FTemplate: String;
    procedure SetFieldName(AValue: String);
  protected
    Function GetCaption : String; Override;
  Public
    Procedure Assign(Source : TPersistent); override;
  Published
    Property FieldName : String Read FFieldName Write SetFieldName;
    Property Template : String Read FTemplate Write FTemplate;
  end;

  { TDBTableColumns }

  TDBTableColumns = Class(TCustomTableColumns)
  private
    function GetCol(Index : Integer): TDBTableColumn;
    procedure SetCol(Index : Integer; AValue: TDBTableColumn);
  Public
    Function AddField(F : TField) : TDBTableColumn;
    Function AddField(const AFieldName,aCaption : String) : TDBTableColumn;
    Property DBColumns[Index : Integer] : TDBTableColumn Read GetCol Write SetCol; default;
  end;

   { TDBTableRowEnumerator }
   TDBTableRowEnumerator = class(TTableRowEnumerator)
     FBOf: boolean;
     FDataset : TDataset;
     FColFields : Array of TField;
     FRowKeyField : TField;
   private
     function ReplaceTemplate(aTemplate: string; aField: TField): String;
   Protected
     Procedure SetDataset(aDataset : TDataset); virtual;
   Public
     Procedure GetCellData(aCell: TTableWidgetCellData); override;
     Function MoveNext: Boolean; override;
     Property Dataset : TDataset Read FDataset;
   end;

  TCustomDBTableWidget = Class(TCustomTableWidget)
  private
    FDatasource: TDatasource;
    FRowKeyField: String;
    function GetColumns: TDBTableColumns;
    procedure SetColumns(AValue: TDBTableColumns);
    procedure SetDatasource(AValue: TDatasource);
    procedure SetRowKeyField(AValue: String);
  Protected
    Procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure RenderRow(aEnum : TTableRowEnumerator; aParent: TJSHTMLElement; aKind: TRowKind; aCell: TTableWidgetCellData);override;
    Procedure CreateDefaultColumns; override;
    Function CreateColumns: TCustomTableColumns; override;
    function GetDataset: TDataset;
    Function GetBodyRowEnumerator: TTableRowEnumerator; override;
    Property Datasource : TDatasource Read FDatasource write SetDatasource;
    Property RowKeyField : String Read FRowKeyField Write SetRowKeyField;
  Public
    Property Dataset : TDataset Read GetDataset;
    Property Columns : TDBTableColumns Read GetColumns Write SetColumns;
  end;

  TDBTableWidget = class(TCustomDBTableWidget)
  Public
    property Element;
  Published
    Property Classes;
    Property TableOptions;
    Property ParentID ;
    Property Datasource;
    Property Columns;
    Property OnGetCellData;
    Property OnCellClick;
    Property OnHeaderCellClick;
    Property OnFooterCellClick;
    Property OnRowClick;
    Property OnHeaderRowClick;
    Property OnFooterRowClick;
    Property RowKeyField;
  end;

  // Select that gets the values from a dataset.

  TCustomDBSelectWidget = class;
  
  { TCustomDBSelectWidget }

  { TSelectLink }

  TSelectLink = class(TDatalink)
  Private
    FWidget : TCustomDBSelectWidget;
  Protected
    Procedure ActiveChanged; override;
  Public
    Constructor Create(aWidget : TCustomDBSelectWidget);
    Property Widget: TCustomDBSelectWidget Read FWidget;
  end;
  
  TCustomDBSelectWidget = class(TCustomSelectWidget)
  Private
    FLink : TSelectLink;
    FItemField: String;
    FNullIsNotValue: Boolean;
    FValueField: String;
    FValue : string;
    function GetDataset: TDataset;
    function GetValue: String;
    procedure SetDatasource(AValue: TDatasource);
    function GetDatasource: TDatasource;
    procedure SetItemField(AValue: String);
    procedure SetNullIsNotValue(AValue: Boolean);
    procedure SetValue(AValue: String);
    procedure SetValueField(AValue: String);
  Protected
    Type
    { TStringsSelectOptionEnumerator }
    TDBSelectOptionEnumerator = Class(TSelectOptionEnumerator)
      FBof : Boolean;
      FDS :  TDataset;
      FTextField : TField;
      FValueField : TField;
      FCheckValue : Boolean;
      constructor Create(ASelect : TCustomSelectWidget); override;
      Function OptionText : String; override;
      Function HasValue : boolean; override;
      Function Value : string; override;
      function MoveNext: Boolean; override;
      Property Dataset : TDataset Read FDS;
    end;
    Function CreateOptionEnumerator: TSelectOptionEnumerator; override;
    procedure ActiveChanged; virtual;
    Procedure DoUnRender(aParent : TJSHTMLElement) ; override;
  Protected
    // properties that can be published in descendents
    Property Datasource : TDatasource Read GetDatasource write SetDatasource;
    Property ItemField : String Read FItemField Write SetItemField;
    Property ValueField : String Read FValueField Write SetValueField;
    Property NullIsNotValue : Boolean Read FNullIsNotValue Write SetNullIsNotValue;
    Property Value : String Read GetValue Write SetValue;
  Public
    constructor Create(aOwner : TComponent); override;
    destructor destroy; override;
    Property Dataset : TDataset Read GetDataset;
  end;

  { TDBSelectWidget }

  TDBSelectWidget = Class(TCustomDBSelectWidget)
  Public
    Property SelectionCount;
    Property SelectionValue;
    Property SelectionItem;
    Property Selected;
    Property Value;
    Property Options;
    Property SelectElement;
    Property ItemCount;
  Published
    Property Datasource;
    Property ItemField;
    Property ValueField;
    Property NullIsNotValue;
    property SelectedIndex;
    Property Multiple;
  end;


implementation

{ TSelectLink }

procedure TSelectLink.ActiveChanged;
begin
  Widget.ActiveChanged;
end;

constructor TSelectLink.Create(aWidget: TCustomDBSelectWidget);

begin
  FWidget:=aWidget;
  Inherited create;
end;


{ TCustomDBSelectWidget.TDBSelectOptionEnumerator }

constructor TCustomDBSelectWidget.TDBSelectOptionEnumerator.Create(ASelect: TCustomSelectWidget);

Var
  S : TCustomDBSelectWidget;

begin
{$IFDEF NESTEDCLASSBUG}
  asm
  pas.htmlwidgets.TCustomSelectWidget.TSelectOptionEnumerator.Create.call(this,ASelect);
  end;
{$ELSE}
  inherited Create(ASelect);
{$ENDIF}
  FBOF:=True;
  S:=aSelect as TCustomDBSelectWidget;
  FDS:=S.Dataset;
  if FDS=Nil then
    exit;
  FTextField:=FDS.Fields.FindField(S.ItemField);
  if S.ValueField<>'' then
    FValueField:=FDS.Fields.FindField(S.ValueField);
  FCheckValue:=S.NullIsNotValue;
end;

function TCustomDBSelectWidget.TDBSelectOptionEnumerator.OptionText: String;
begin
  Result:=FTextField.DisplayText;
end;

function TCustomDBSelectWidget.TDBSelectOptionEnumerator.HasValue: boolean;
begin
  Result:=Assigned(FValueField);
  if Result and FCheckValue then
    Result:=Not FValueField.IsNull;
end;

function TCustomDBSelectWidget.TDBSelectOptionEnumerator.Value: string;
begin
  Result:=FValueField.DisplayText;
end;

function TCustomDBSelectWidget.TDBSelectOptionEnumerator.MoveNext: Boolean;

begin
  If not Assigned(Dataset) then
    exit(False);
  if FBOF then
    FBof:=False
  else
    Dataset.Next;
  Result:=Not Dataset.EOF;
end;

{ TCustomDBSelectWidget }

function TCustomDBSelectWidget.GetDataset: TDataset;
begin
  Result:=FLink.Dataset;
end;

function TCustomDBSelectWidget.GetDatasource: TDatasource;
begin
  Result:=FLink.Datasource;
end;

procedure TCustomDBSelectWidget.SetDatasource(AValue: TDatasource);
begin
  FLink.Datasource:=aValue;
end;

function TCustomDBSelectWidget.GetValue: String;
begin
  if IsRendered then
    Result:=TJSHTMLSelectElement(Element).Value
  else
    Result:=FValue;
end;

procedure TCustomDBSelectWidget.SetItemField(AValue: String);
begin
  if FItemField=AValue then Exit;
  FItemField:=AValue;
end;

procedure TCustomDBSelectWidget.SetNullIsNotValue(AValue: Boolean);
begin
  if FNullIsNotValue=AValue then Exit;
  FNullIsNotValue:=AValue;
end;

procedure TCustomDBSelectWidget.SetValue(AValue: String);
begin
  if IsRendered then
    TJSHTMLSelectElement(Element).Value:=aValue
  else
    FValue:=aValue;
end;

procedure TCustomDBSelectWidget.SetValueField(AValue: String);
begin
  if FValueField=AValue then Exit;
  FValueField:=AValue;
end;

function TCustomDBSelectWidget.CreateOptionEnumerator: TSelectOptionEnumerator;
begin
  Result:=TDBSelectOptionEnumerator.Create(Self);
end;

procedure TCustomDBSelectWidget.ActiveChanged;
begin
  if FLink.Active then
    Refresh
  else
    UnRender;
end;

procedure TCustomDBSelectWidget.DoUnRender(aParent: TJSHTMLElement);
begin
  if ExternalElement then
    Element.innerHTML:='';
  inherited DoUnRender(aParent);
end;

constructor TCustomDBSelectWidget.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  FLink:=TSelectLink.Create(Self);
end;

destructor TCustomDBSelectWidget.destroy;
begin
  FreeAndNil(FLink);
  inherited destroy;
end;

{ TDBTableColumn }

procedure TDBTableColumn.SetFieldName(AValue: String);
begin
  if FFieldName=AValue then Exit;
  FFieldName:=AValue;
end;


function TDBTableColumn.GetCaption: String;
begin
  Result:=inherited GetCaption;
  if Result='' then
    Result:=FieldName;
end;

procedure TDBTableColumn.Assign(Source: TPersistent);
begin
  if Source is TDBTableColumn then
    FieldName:=TDBTableColumn(Source).FieldName;
  inherited Assign(Source);
end;

{ TDBTableColumns }

function TDBTableColumns.GetCol(Index : Integer): TDBTableColumn;
begin
  Result:=TDBTableColumn(Items[Index])
end;

procedure TDBTableColumns.SetCol(Index : Integer; AValue: TDBTableColumn);
begin
  Items[Index]:=AValue;
end;

function TDBTableColumns.AddField(F: TField): TDBTableColumn;
begin
  Result:=AddField(F.FieldName,F.DisplayLabel);
end;

function TDBTableColumns.AddField(const AFieldName, aCaption : String): TDBTableColumn;
begin
  Result:=(Add as TDBtableColumn);
  Result.FieldName:=aFieldName;
  Result.Caption:=aCaption;
end;

{ TDBTableRowEnumerator }

procedure TDBTableRowEnumerator.SetDataset(aDataset : TDataset);

Var
  T : TCustomDBTableWidget;
  I : Integer;

begin
  FBof:=True;
  FDataset:=aDataset;
  if Table is TCustomDBTableWidget then
    begin
    T:=Table as TCustomDBTableWidget;
    SetLength(FColFields,T.Columns.Count-1);
    For I:=0 to T.Columns.Count-1 do
      FColFields[I]:=Dataset.Fields.FindField(T.Columns[i].FieldName);
    if (T.RowKeyField<>'') then
      FRowKeyField:=Dataset.Fields.FindField(T.RowKeyField);
   end;
end;

Function TDBTableRowEnumerator.ReplaceTemplate(aTemplate : string; aField : TField) : String;

Var
  I : Integer;

begin
  Result:=aTemplate;
  if (aField<>Nil) then
    Result:=StringReplace(Result,'{{value}}',aField.AsString,[rfReplaceAll,rfIgnoreCase]);
  for I:=0 to Dataset.Fields.Count-1 do
    With Dataset.Fields[i] do
      Result:=StringReplace(Result,'{{'+FieldName+'}}',AsString,[rfReplaceAll,rfIgnoreCase]);
end;

procedure TDBTableRowEnumerator.GetCellData(aCell: TTableWidgetCellData);

Var
  F : TField;
  CC : TDBTableColumn;
begin
  if (aCell.Kind=rkBody) then
    begin
    F:=FColFields[ACell.Col];
    if aCell.Column is TDBTableColumn then
      CC:=TDBTableColumn(aCell.Column)
    else
      CC:=Nil;
    if Assigned(CC) and (CC.Template<>'') then
      begin
      aCell.Text:=replaceTemplate(CC.Template,F);
      aCell.asHTML:=True;
      end
    else if Assigned(F) then
      ACell.Text:=F.AsString;
    end
  else
    inherited GetCellData(aCell);
end;

function TDBTableRowEnumerator.MoveNext: Boolean;

begin
  if FBOF then
    FBof:=False
  else
    Dataset.Next;
  Result:=Not Dataset.EOF;
  if Result then
    Result:=inherited MoveNext; // Update row number
end;

{ TCustomDBTableWidget }

procedure TCustomDBTableWidget.SetDatasource(AValue: TDatasource);
begin
  if FDatasource=AValue then Exit;
  if Assigned(FDatasource) then
    FDatasource.RemoveFreeNotification(Self);
  FDatasource:=AValue;
  if Assigned(FDatasource) then
    FDatasource.FreeNotification(Self);
end;

procedure TCustomDBTableWidget.SetRowKeyField(AValue: String);
begin
  if FRowKeyField=AValue then Exit;
  FRowKeyField:=AValue;
  if IsRendered then
    Refresh;
end;

procedure TCustomDBTableWidget.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation=opRemove) and (AComponent=FDatasource) then
    FDataSource:=Nil;
end;

procedure TCustomDBTableWidget.RenderRow(aEnum: TTableRowEnumerator; aParent: TJSHTMLElement; aKind: TRowKind;
  aCell: TTableWidgetCellData);
begin
  With TDBTableRowEnumerator(aEnum) do
    begin
    if Assigned(FRowKeyField) then
      aParent.dataset['key']:=FRowKeyField.AsString;
    end;
  inherited RenderRow(aEnum, aParent, aKind, aCell);
end;

function TCustomDBTableWidget.GetColumns: TDBTableColumns;
begin
  Result:=CustomColumns as TDBTableColumns;
end;

procedure TCustomDBTableWidget.SetColumns(AValue: TDBTableColumns);
begin
  Customcolumns.Assign(AValue);
end;

procedure TCustomDBTableWidget.CreateDefaultColumns;

Var
  I : Integer;

begin
  With Dataset.Fields do
    For I:=0 to Count-1 do
      if Fields[i].Visible then
        Columns.AddField(Fields[i]);
end;

function TCustomDBTableWidget.CreateColumns: TCustomTableColumns;
begin
  Result:=TDBTableColumns.Create(TDBTableColumn);
end;

function TCustomDBTableWidget.GetDataset: TDataset;
begin
  Result:=Datasource.Dataset;
end;

function TCustomDBTableWidget.GetBodyRowEnumerator: TTableRowEnumerator;

begin
  Result:=TDBTableRowEnumerator.Create(Self);
  TDBTableRowEnumerator(Result).SetDataset(Dataset);

end;

end.