home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Runimage / Delphi50 / Source / Internet / MIDITEMS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-08-11  |  162.0 KB  |  5,792 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Borland Delphi Visual Component Library         }
  5. {                                                       }
  6. {       Copyright (c) 1999 Inprise Corporation          }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit MidItems;
  11.  
  12. interface
  13.  
  14. uses Classes, HTTPApp, Db, DbClient, Midas,
  15.   XMLBrokr, WebComp, PagItems, MidProd;
  16.  
  17. type
  18.  
  19.   IMidasWebDataSet = interface
  20.   ['{1E494CD4-D598-11D2-AF8C-00C04FB16EC3}']
  21.     function FieldCount: Integer;
  22.     function Fields: TFields;
  23.     procedure FetchParams;
  24.     function Params: TParams;
  25.     function ParamCount: Integer;
  26.     procedure AddOnDataChange(const Value: TNotifyEvent);
  27.     procedure RemoveOnDataChange(const Value: TNotifyEvent);
  28.   end;
  29.  
  30.   TXMLDataSet = class;
  31.  
  32.   IDataSetComponent = interface
  33.   ['{D1AE355D-F1C3-11D2-AFB3-00C04FB16EC3}']
  34.     function GetXMLBroker: TXMLBroker;
  35.     function GetDataSet: IMidasWebDataSet;
  36.     function GetXMLDataSet: TXMLDataSet;
  37.     property DataSet: IMidasWebDataSet read GetDataSet;
  38.     property XMLBroker: TXMLBroker read GetXMLBroker;
  39.     property XMLDataSet: TXMLDataSet read GetXMLDataSet;
  40.   end;
  41.  
  42.   IQueryFields = interface
  43.   ['{DADD9F42-FD2B-11D2-AA78-00A024C11562}']
  44.     procedure ValidateDataSet;
  45.     function IsParamInUse(AName: string): Boolean;
  46.     procedure GetParamsList(AList: TStrings);
  47.   end;
  48.   
  49.   IValidateFields = interface
  50.   ['{10A1C310-2E47-11D3-B00E-00C04FB16EC3}']
  51.     function GetEnableValidateFields: Boolean;
  52.     procedure SetEnableValidateFields(Value: Boolean);
  53.     function ValidateFields(AddIntf: IAddScriptElements): Boolean;
  54.     property EnableValidateFields: Boolean read GetEnableValidateFields
  55.       write SetEnableValidateFields;
  56.   end;
  57.  
  58.   IValidateField = interface
  59.   ['{10A1C310-2E47-11D3-B00E-00C04FB16EC3}']
  60.     function ValidateField(DataSet: IMidasWebDataSet; AddIntf: IAddScriptElements): Boolean;
  61.   end;
  62.  
  63.   IDataSetFields = interface
  64.   ['{394C5DD4-F252-11D2-AA55-00A024C11562}']
  65.     procedure ValidateDataSet;
  66.     procedure GetFieldsList(AList: TStrings);
  67.     function IsFieldInUse(AName: string): Boolean;
  68.     function HasStatusField: Boolean;
  69.     function GetVisibleFields: TWebComponentList;
  70.     property VisibleFields: TWebComponentList read GetVisibleFields;
  71.   end;
  72.  
  73.   IRestoreDefaults = interface
  74.   ['{394C5DD3-F252-11D2-AA55-00A024C11562}']
  75.     procedure RestoreDefaults;
  76.   end;
  77.  
  78.   IHTMLField = interface
  79.   ['{C72355D9-FE5C-11D2-AFC5-00C04FB16EC3}']
  80.     function GetHTMLControlName: string;
  81.     property HTMLControlName: string read GetHTMLControlName;
  82.   end;
  83.  
  84.   IQueryField = interface(IHTMLField)
  85.   ['{7C321115-FCFB-11D2-AFC3-00C04FB16EC3}']
  86.     function GetParamName: string;
  87.     procedure SetParamName(AParamName: string);
  88.     function GetText: string;
  89.     procedure SetText(const Value: string);
  90.     property ParamName: string read GetParamName write SetParamName;
  91.     property Text: string read GetText write SetText;
  92.   end;
  93.  
  94.   IDataSetField = interface(IHTMLField)
  95.   ['{394C5DD5-F252-11D2-AA55-00A024C11562}']
  96.     procedure SetFieldName(AFieldName: string);
  97.     function GetFieldName: string;
  98.     function GetRowSetFieldAttributes(const FieldVarName: string): string;
  99.     property FieldName: string read GetFieldName write SetFieldName;
  100.   end;
  101.  
  102.   IStatusField = interface(IHTMLField)
  103.   ['{DA9A7341-FE79-11D2-AFC5-00C04FB16EC3}']
  104.   end;
  105.  
  106.   IXMLDisplay = interface
  107.   ['{394C5DD6-F252-11D2-AA55-00A024C11562}']
  108.     function GetXMLDisplayName: string;
  109.     function GetXMLRowSetName: string;
  110.     function GetIsMultipleRecordView: Boolean;
  111.     property XMLRowSetName: string read GetXMLRowSetName;
  112.     property XMLDisplayName: string read GetXMLDisplayName;
  113.     property IsMultipleRecordView: Boolean read GetIsMultipleRecordView;
  114.   end;
  115.  
  116.   IXMLDisplayReference = interface
  117.   ['{675ABA92-F660-11D2-AA59-00A024C11562}']
  118.     function GetXMLDisplayComponent: TComponent;
  119.     property XMLDisplayComponent: TComponent read GetXMLDisplayComponent;
  120.   end;
  121.  
  122.   IHTMLForm = interface
  123.   ['{394C5DD7-F252-11D2-AA55-00A024C11562}']
  124.     function GetHTMLFormName: string;
  125.     function GetHTMLFormVarName: string;
  126.     property HTMLFormName: string read GetHTMLFormName;
  127.     property HTMLFormVarName: string read GetHTMLFormVarName;
  128.   end;
  129.  
  130.   IFormatColumn = interface
  131.   ['{3417E2F0-22A0-11D3-B003-00C04FB16EC3}']
  132.     function FormatColumnHeading: string;
  133.     function FormatColumnData(Content: string): string;
  134.   end;
  135.  
  136.   IQueryForm = interface
  137.   ['{95097A4B-3A12-11D3-B01B-00C04FB16EC3}']
  138.   end;
  139.  
  140.   TWebDataInput = class;
  141.   TWebDataInputClass = class of TWebDataInput;
  142.  
  143.   TXMLData = class(TObject)
  144.   private
  145.     FParent: TComponent;
  146.     FXMLBroker: TXMLBroker;
  147.     FOnChange: TNotifyEvent;
  148.   protected
  149.     procedure Changed;
  150.     procedure ChangedXMLBroker; virtual;
  151.     procedure SetXMLBroker(const Value: TXMLBroker); virtual;
  152.     function GetXMLBroker: TXMLBroker; virtual;
  153.   public
  154.     procedure Notification(AComponent: TComponent;
  155.       Operation: TOperation); virtual;
  156.     constructor Create(AParent: TComponent);
  157.     property OnChange: TNotifyEvent read FOnChange write FOnChange;
  158.     property Parent: TComponent read FParent;
  159.     property XMLBroker: TXMLBroker read GetXMLBroker write SetXMLBroker;
  160.   end;
  161.  
  162.   TXMLDataSet = class(TXMLData, INotifyConnectionChange)
  163.   private
  164.     FDataSetField: string;
  165.     FDataSet: IMidasWebDataSet;
  166.     FDataSetPath: TStrings;
  167.     FDiscardDataSetList: IInterfaceList;
  168.   protected
  169.     { IUnknown }
  170.     function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
  171.     function _AddRef: Integer; stdcall;
  172.     function _Release: Integer; stdcall;
  173.     { INotifyConnectionChange }
  174.     procedure ConnectionChange(Sender: TComponent; Connecting: Boolean);
  175.  
  176.     procedure SetXMLBroker(const Value: TXMLBroker); override;
  177.     function FindDataSet: IMidasWebDataSet;
  178.     function CompareXMLData(XMLDataSet: TXMLDataSet): Boolean;
  179.     procedure ChangedXMLBroker; override;
  180.     procedure ChangedDataSetField; virtual;
  181.     procedure WrapperDataChange(Sender: TObject);
  182.     //procedure AssignTo(Dest: TPersistent); override;
  183.     procedure SetDataSetField(const Value: string);
  184.     function GetDataSet: IMidasWebDataSet;
  185.     function CreateDataSet: IMidasWebDataSet;
  186.     function GetDataSetPath: TStrings;
  187.     function GetDataSetField: string; virtual;
  188.     property Parent: TComponent read FParent;
  189.   public
  190.     constructor Create(AParent: TComponent);
  191.     destructor Destroy; override;
  192.     property DataSet: IMidasWebDataSet read GetDataSet;
  193.     property DataSetPath: TStrings read GetDataSetPath;
  194.     property DataSetField: string read GetDataSetField write SetDataSetField;
  195.   end;
  196.  
  197.   TXMLDataSetParent = class(TXMLDataSet)
  198.   private
  199.     FUseParent: Boolean;
  200.   protected
  201.     function GetDataSetField: string; override;
  202.     function GetXMLBroker: TXMLBroker; override;
  203.     procedure SetUseParent(const Value: Boolean);
  204.     procedure ChangedDataSetField; override;
  205.     procedure ChangedXMLBroker; override;
  206.     procedure ChangedUseParent; virtual;
  207.     function ParentDataSetField: string;
  208.     function ParentXMLDataSet: TXMLDataSet;
  209.     function ParentXMLBroker: TXMLBroker;
  210.     property UseParent: Boolean read FUseParent write SetUseParent;
  211.   end;
  212.  
  213.   TXMLDataParent = class(TXMLData)
  214.   private
  215.     FUseParent: Boolean;
  216.   protected
  217.     procedure ChangedUseParent; virtual;
  218.     function GetXMLBroker: TXMLBroker; override;
  219.     procedure SetUseParent(const Value: Boolean);
  220.     procedure ChangedXMLBroker; override;
  221.     function ParentXMLBroker: TXMLBroker;
  222.   published
  223.     property UseParent: Boolean read FUseParent write SetUseParent;
  224.   end;
  225.  
  226.   TXMLDisplay = class(TObject)
  227.   private
  228.     FParent: TComponent;
  229.     FDisplayComponent: TComponent;
  230.     FOnChange: TNotifyEvent;
  231.   protected
  232.     procedure Changed;
  233.     procedure SetDisplayComponent(const Value: TComponent);
  234.     function GetDisplayComponent: TComponent; virtual;
  235.     procedure ChangedDisplayComponent; virtual;
  236.   public
  237.     procedure Notification(AComponent: TComponent;
  238.       Operation: TOperation); virtual;
  239.     constructor Create(AParent: TComponent);
  240.     property OnChange: TNotifyEvent read FOnChange write FOnChange;
  241.     property Parent: TComponent read FParent;
  242.     property DisplayComponent: TComponent read GetDisplayComponent write SetDisplayComponent;
  243.   end;
  244.  
  245.   TXMLDisplayParent = class(TXMLDisplay)
  246.   private
  247.     FUseParent: Boolean;
  248.   protected
  249.     function GetDisplayComponent: TComponent; override;
  250.     procedure SetUseParent(const Value: Boolean);
  251.     procedure ChangedDisplayComponent; override;
  252.     procedure ChangedUseParent; virtual;
  253.   public
  254.     constructor Create(AParent: TComponent);
  255.   published
  256.     property UseParent: Boolean read FUseParent write SetUseParent default True;
  257.   end;
  258.  
  259.   TWebForm = class(TComponent, IWebComponent, IWebContent, IWebComponentEditor,
  260.     IScriptComponent, IGetWebComponentList, IHTMLForm)
  261.   private
  262.     FContainer: TWebComponentList;
  263.     FWebComponents: TWebComponentList;
  264.     FCustom: string;
  265.     FStyle: string;
  266.     FStyleRule: string;
  267.     FWebParent: TComponent;
  268.     FLayoutAttributes: TLayoutAttributes;
  269.   protected
  270.     procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
  271.     procedure SetChildOrder(Component: TComponent; Order: Integer); override;
  272.     { IWebComponentEditor }
  273.     function CanAddClass(AParent: TComponent; AClass: TClass): Boolean;
  274.     function ImplCanAddClass(AParent: TComponent; AClass: TClass): Boolean; virtual; abstract;
  275.     { IWebComponent }
  276.     function GetIndex: Integer;
  277.     procedure SetIndex(Value: Integer);
  278.     procedure SetContainer(Container: TWebComponentContainer);
  279.     function GetContainer: TWebComponentContainer;
  280.     procedure SetComponentList(List: TObject);
  281.  
  282.     { IWebContent }
  283.     function Content(Options: TWebContentOptions; Layout: TLayout): string;
  284.     function ImplContent(Options: TWebContentOptions; Layout: TLayout): string; virtual; abstract;
  285.  
  286.     procedure ReadState(Reader: TReader); override;
  287.     procedure SetParentComponent(AParent: TComponent); override;
  288.     { IGetWebComponentList }
  289.     function GetComponentList: TObject;
  290.     function GetDefaultComponentList: TObject;
  291.  
  292.     { IScriptComponent }
  293.     procedure AddElements(AddIntf: IAddScriptElements);
  294.     procedure ImplAddElements(AddIntf: IAddScriptElements); virtual;
  295.     function GetSubComponents: TObject;
  296.  
  297.     { IHTMLForm }
  298.     function GetHTMLFormName: string;
  299.     function GetHTMLFormVarName: string;
  300.  
  301.     function GetVisibleFields: TWebComponentList;
  302.     function GetLayoutAttributes: TLayoutAttributes; virtual;
  303.     procedure SetWebParent(const Value: TComponent);
  304.     property VisibleFields: TWebComponentList read GetVisibleFields;
  305.   public
  306.     constructor Create(AComponent: TComponent); override;
  307.     destructor Destroy; override;
  308.     function GetParentComponent: TComponent; override;
  309.     function HasParent: Boolean; override;
  310.     property WebComponents: TWebComponentList read FWebComponents;
  311.     property Style: string read FStyle write FStyle;
  312.     property Custom: string read FCustom write FCustom;
  313.     property StyleRule: string read FStyleRule write FStyleRule;
  314.   end;
  315.  
  316.   TFormMethod = (fmPost, fmGet);
  317.   TCustomQueryForm = class(TWebForm, IQueryForm)
  318.   private
  319.     FAction: string;
  320.     FMethod: TFormMethod;
  321.     FAssignStrings: TStrings;
  322.   protected
  323.     { IWebComponentEditor implementation }
  324.     function ImplCanAddClass(AParent: TComponent; AClass: TClass): Boolean; override;
  325.     { IScriptComponent implementation }
  326.     procedure ImplAddElements(AddIntf: IAddScriptElements); override;
  327.     { IWebContent implementation }
  328.     function ImplContent(Options: TWebContentOptions; ParentLayout: TLayout): string; override;
  329.  
  330.     function GetHTMLFormTag(Options: TWebContentOptions): string; virtual;
  331.     function MethodString: string;
  332.     procedure AssignStringsCallback(AComponent: TComponent);
  333.   public
  334.     constructor Create(AOwner: TComponent); override;
  335.     procedure AssignStrings(Value: TStrings);
  336.     property Action: string read FAction write FAction;
  337.     property Method: TFormMethod read FMethod write FMethod;
  338.   end;
  339.  
  340.   TQueryForm = class(TCustomQueryForm)
  341.   published
  342.     property Action;
  343.     property Method;
  344.     property Style;
  345.     property Custom;
  346.     property StyleRule;
  347.   end;
  348.  
  349.   TDataForm = class(TWebForm)
  350.   protected
  351.     { IWebComponentEditor implementation }
  352.     function ImplCanAddClass(AParent: TComponent; AClass: TClass): Boolean; override;
  353.     { IWebContent implementatation }
  354.     function ImplContent(Options: TWebContentOptions; ParentLayout: TLayout): string; override;
  355.  
  356.     function GetHTMLFormTag(Options: TWebContentOptions): string; virtual;
  357.   published
  358.     property Style;
  359.     property Custom;
  360.     property StyleRule;
  361.   end;
  362.  
  363.   TWebControlGroup = class(TComponent, IWebComponent, IGetWebComponentList, IWebComponentEditor,
  364.     IScriptComponent, IWebContent)
  365.   private
  366.     FContainer: TWebComponentList;
  367.     FWebComponents: TWebComponentList;
  368.     FDefaultField: Boolean;
  369.     FDefaultWebComponents: TWebComponentList;
  370.     FWebParent: TComponent;
  371.   protected
  372.     procedure SetWebParent(const Value: TComponent);
  373.     procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
  374.     procedure SetChildOrder(Component: TComponent;
  375.      Order: Integer); override;
  376.     { IScriptComponent }
  377.     procedure AddElements(AddIntf: IAddScriptElements);
  378.     function GetSubComponents: TObject; // Object implementing IWebComponentContainer
  379.     function ImplGetSubComponents: TObject; virtual;
  380.     procedure ImplAddElements(AddIntf: IAddScriptElements); virtual;
  381.     { IWebContent }
  382.     function Content(Options: TWebContentOptions; ParentLayout: TLayout): string;
  383.     function ImplContent(Options: TWebContentOptions; ParentLayout: TLayout): string; virtual;
  384.     { IWebComponent }
  385.     function GetIndex: Integer;
  386.     procedure SetIndex(Value: Integer);
  387.     procedure SetContainer(Container: TWebComponentContainer);
  388.     function GetContainer: TWebComponentContainer;
  389.     procedure SetComponentList(List: TObject);
  390.     { IGetWebComponentList }
  391.     function GetComponentList: TObject;
  392.     function GetDefaultComponentList: TObject;
  393.     { IWebComponentEditor }
  394.     function CanAddClass(AParent: TComponent; AClass: TClass): Boolean;
  395.     function ImplCanAddClass(AParent: TComponent; AClass: TClass): Boolean; virtual;
  396.  
  397.     procedure ReadState(Reader: TReader); override;
  398.     procedure SetParentComponent(AParent: TComponent); override;
  399.     function GetLayoutAttributes: TLayoutAttributes; virtual;
  400.     property DefaultWebComponents: TWebComponentList read FDefaultWebComponents write FDefaultWebComponents;
  401.   public
  402.     constructor Create(AOwner: TComponent); override;
  403.     destructor Destroy; override;
  404.     function GetParentComponent: TComponent; override;
  405.     function HasParent: Boolean; override;
  406.     property WebFieldControls: TWebComponentList read FWebComponents;
  407.   end;
  408.  
  409.   TCustomLayoutGroup = class(TWebControlGroup)
  410.   private
  411.     FDisplayColumns: Integer;
  412.     FStyle: string;
  413.     FCustom: string;
  414.     FStyleRule: string;
  415.     FLayoutAttributes: TLayoutAttributes;
  416.   protected
  417.     { IWebComponentEditor implementation }
  418.     function ImplCanAddClass(AParent: TComponent; AClass: TClass): Boolean; override;
  419.     { IWebContent implementation }
  420.     function ImplContent(Options: TWebContentOptions; ParentLayout: TLayout): string; override;
  421.  
  422.     function GetLayoutAttributes: TLayoutAttributes; override;
  423.   public
  424.     constructor Create(AComponent: TComponent); override;
  425.     destructor Destroy; override;
  426.     property DisplayColumns: Integer read FDisplayColumns write FDisplayColumns;
  427.     property Style: string read FStyle write FStyle;
  428.     property Custom: string read FCustom write FCustom;
  429.     property StyleRule: string read FStyleRule write FStyleRule;
  430.   end;
  431.  
  432.   TLayoutGroup = class(TCustomLayoutGroup)
  433.   published
  434.     property DisplayColumns;
  435.     property Style;
  436.     property Custom;
  437.     property StyleRule;
  438.   end;
  439.  
  440.   TXMLDisplayGroup = class(TWebControlGroup,
  441.     IDataSetComponent, IDataSetFields, IXMLDisplay, IValidateFields)
  442.   private
  443.     FXMLDataSet: TXMLDataSet;
  444.     FEnableValidateFields: Boolean;
  445.   protected
  446.     function GetDataSetField: string;
  447.     procedure SetDataSetField(const Value: string);
  448.     procedure SetXMLBroker(const Value: TXMLBroker);
  449.     procedure XMLDataChange(Sender: TObject); virtual;
  450.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  451.     { IScriptComponent implementation }
  452.     function ImplGetSubComponents: TObject; override;
  453.     procedure ImplAddElements(AddIntf: IAddScriptElements); override;
  454.     { IXMLDisplay }
  455.     function GetXMLDisplayName: string;
  456.     function GetXMLRowSetName: string;
  457.     function GetIsMultipleRecordView: Boolean;
  458.     function ImplIsMultipleRecordView: Boolean; virtual;
  459.     { IDataSetComponent }
  460.     function GetDataSet: IMidasWebDataSet;
  461.     function GetXMLBroker: TXMLBroker;
  462.     function GetXMLDataSet: TXMLDataSet;
  463.  
  464.     { IDataSetFields }
  465.     procedure GetFieldsList(List: TStrings); virtual;
  466.     function IsFieldInUse(AName: string): Boolean;
  467.     function GetVisibleFields: TWebComponentList;
  468.     function HasStatusField: Boolean;
  469.     procedure ValidateDataSet;
  470.  
  471.     { IValidateFields }
  472.     function ValidateFields(AddIntf: IAddScriptElements): Boolean;
  473.     function GetEnableValidateFields: Boolean;
  474.     procedure SetEnableValidateFields(Value: Boolean);
  475.  
  476.     procedure CreateDefaultFields; virtual;
  477.     function FindField(const AName: string): TComponent;
  478.     property XMLDataSet: TXMLDataSet read FXMLDataSet;
  479.     property EnableValidateFields: Boolean read GetEnableValidateFields write SetEnableValidateFields;
  480.   public
  481.     constructor Create(AComponent: TComponent); override;
  482.     destructor Destroy; override;
  483.     property VisibleFields: TWebComponentList read GetVisibleFields;
  484.   published
  485.     property XMLBroker: TXMLBroker read GetXMLBroker write SetXMLBroker;
  486.     property XMLDataSetField: string read GetDataSetField write SetDataSetField;
  487.   end;
  488.  
  489.   TGridRowAttributes = class(TPersistent)
  490.   private
  491.     FAlign: THTMLAlign;
  492.     FBgColor: THTMLBgColor;
  493.     FVAlign: THTMLVAlign;
  494.     FStyle: string;
  495.     FStyleRule: string;
  496.     FCustom: string;
  497.     FParent: TComponent;
  498.   protected
  499.     procedure AssignTo(Dest: TPersistent); override;
  500.   public
  501.     constructor Create(AParent: TComponent);
  502.     property Parent: TComponent read FParent;
  503.   published
  504.     property Align: THTMLAlign read FAlign write FAlign default haDefault;
  505.     property BgColor: THTMLBgColor read FBgColor write FBgColor;
  506.     property VAlign: THTMLVAlign read FVAlign write FVAlign default haVDefault;
  507.     property Style: string read FStyle write FStyle;
  508.     property StyleRule: string read FStyleRule write FStyleRule;
  509.     property Custom: string read FCustom write FCustom;
  510.   end;
  511.  
  512.   TGridAttributes = class(TPersistent)
  513.   private
  514.     FAlign: THTMLAlign;
  515.     FBorder: Integer;
  516.     FBgColor: THTMLBgColor;
  517.     FCellSpacing: Integer;
  518.     FCellPadding: Integer;
  519.     FStyle: string;
  520.     FStyleRule: string;
  521.     FCustom: string;
  522.     FParent: TComponent;
  523.   protected
  524.     procedure AssignTo(Dest: TPersistent); override;
  525.   public
  526.     constructor Create(AParent: TComponent);
  527.     property Parent: TComponent read FParent;
  528.   published
  529.     property Align: THTMLAlign read FAlign write FAlign default haDefault;
  530.     property BgColor: THTMLBgColor read FBgColor write FBgColor;
  531.     property Border: Integer read FBorder write FBorder default 1;
  532.     property CellSpacing: Integer read FCellSpacing write FCellSpacing default -1;
  533.     property CellPadding: Integer read FCellPadding write FCellPadding default -1;
  534.     property Style: string read FStyle write FStyle;
  535.     property StyleRule: string read FStyleRule write FStyleRule;
  536.     property Custom: string read FCustom write FCustom;
  537.   end;
  538.  
  539.   TCustomDataGrid = class(TXMLDisplayGroup, IDataSetComponent)
  540.   private
  541.     FDisplayRows: Integer;
  542.     FTableAttributes: TGridAttributes;
  543.     FHeadingAttributes: TGridRowAttributes;
  544.     FRowAttributes: TGridRowAttributes;
  545.   protected
  546.     { IWebComponentEditor implementation }
  547.     function ImplCanAddClass(AParent: TComponent; AClass: TClass): Boolean; override;
  548.     { IWebContent implementation }
  549.     function ImplContent(Options: TWebContentOptions; ParentLayout: TLayout): string; override;
  550.     { IScriptContent implementation }
  551.     procedure ImplAddElements(AddIntf: IAddScriptElements); override;
  552.     { IXMLDisplay implementation }
  553.     function ImplIsMultipleRecordView: Boolean; override;
  554.  
  555.     function FormatTable(Layout: TLayoutWebContent;
  556.       Options: TWebContentOptions): string;
  557.     procedure SetTableAttributes(const Value: TGridAttributes);
  558.     procedure SetHeadingAttributes(
  559.       const Value: TGridRowAttributes);
  560.     procedure SetRowAttributes(
  561.       const Value: TGridRowAttributes);
  562.   public
  563.     constructor Create(AOwner: TComponent); override;
  564.     destructor Destroy; override;
  565.     property DisplayRows: Integer read FDisplayRows write FDisplayRows default 4;
  566.     property TableAttributes: TGridAttributes read FTableAttributes
  567.       write SetTableAttributes;
  568.     property HeadingAttributes: TGridRowAttributes read FHeadingAttributes
  569.       write SetHeadingAttributes;
  570.     property RowAttributes: TGridRowAttributes read FRowAttributes
  571.       write SetRowAttributes;
  572.   end;
  573.  
  574.   TDataGrid = class(TCustomDataGrid)
  575.   published
  576.     property DisplayRows;
  577.     property TableAttributes;
  578.     property HeadingAttributes;
  579.     property RowAttributes;
  580.   end;
  581.  
  582.   TCustomFieldGroup = class(TXMLDisplayGroup)
  583.   private
  584.     FStyle: string;
  585.     FCustom: string;
  586.     FStyleRule: string;
  587.     FLayoutAttributes: TLayoutAttributes;
  588.   protected
  589.     { IWebContent implementation }
  590.     function ImplContent(Options: TWebContentOptions; ParentLayout: TLayout): string; override;
  591.     function GetLayoutAttributes: TLayoutAttributes; override;
  592.   public
  593.     constructor Create(AOwner: TComponent); override;
  594.     destructor Destroy; override;
  595.     property Custom: string read FCustom write FCustom;
  596.     property Style: string read FStyle write FStyle;
  597.     property StyleRule: string read FStyleRule write FStyleRule;
  598.   end;
  599.  
  600.   TQueryFieldGroup = class(TCustomFieldGroup, IQueryFields)
  601.   protected
  602.     { IWebComponentEditor implementation }
  603.     function ImplCanAddClass(AParent: TComponent; AClass: TClass): Boolean;override;
  604.     { IQueryFields }
  605.     function IsParamInUse(AName: string): Boolean;
  606.     procedure GetParamsList(List: TStrings);
  607.  
  608.     function FindParam(const AName: string): TComponent;
  609.   published
  610.     property Custom;
  611.     property Style;
  612.     property StyleRule;
  613.   end;
  614.  
  615.   TFieldGroup = class(TCustomFieldGroup)
  616.   protected
  617.     { IScriptContent implementation }
  618.     procedure ImplAddElements(AddIntf: IAddScriptElements); override;
  619.     { IWebComponentEditor implementation }
  620.     function ImplCanAddClass(AParent: TComponent; AClass: TClass): Boolean;override;
  621.   published
  622.     property Custom;
  623.     property Style;
  624.     property StyleRule;
  625.   end;
  626.  
  627.   TCaptionPosition = (capLeft, capRight, capAbove, capBelow);
  628.  
  629.   TCaptionAttributes = class(TPersistent)
  630.   private
  631.     FParent: TComponent;
  632.     FStyle: string;
  633.     FCustom: string;
  634.     FStyleRule: string;
  635.   public
  636.     constructor Create(AParent: TComponent);
  637.     property Parent: TComponent read FParent;
  638.   published
  639.     property Style: string read FStyle write FStyle;
  640.     property Custom: string read FCustom write FCustom;
  641.     property StyleRule: string read FStyleRule write FStyleRule;
  642.   end;
  643.  
  644.   TWebDataDisplay = class(TComponent, IWebComponent, IWebContent, IHTMLField)
  645.   private
  646.     FWebComponents: TWebComponentList;
  647.     FWebParent: TComponent;
  648.     FDefaultField: Boolean;
  649.     FCaption: string;
  650.     FCaptionPosition: TCaptionPosition;
  651.     FCaptionAttributes: TCaptionAttributes;
  652.     FTabIndex: Integer;
  653.     FCustom: string;
  654.     FStyle: string;
  655.     FLayoutAttributes: TLayoutAttributes;
  656.     FStyleRule: string;
  657.   protected
  658.     { IWebComponent }
  659.     function GetIndex: Integer;
  660.     procedure SetIndex(Value: Integer);
  661.     procedure SetContainer(Container: TWebComponentContainer);
  662.     function GetContainer: TWebComponentContainer;
  663.     procedure SetComponentList(List: TObject);
  664.     { IWebContent }
  665.     function Content(Options: TWebContentOptions; ParentLayout: TLayout): string;
  666.     function ImplContent(Options: TWebContentOptions; ParentLayout: TLayout): string; virtual;
  667.     { IHTMLField }
  668.     function GetHTMLControlName: string;
  669.     function ImplGetHTMLControlName: string; virtual;
  670.  
  671.     function ControlContent(Options: TWebContentOptions): string; virtual; abstract;
  672.     function LabelContent: string; virtual;
  673.     function GetCaption: string; virtual;
  674.     procedure SetCaption(Value: string); virtual;
  675.  
  676.     function EventContent(Options: TWebContentOptions): string; virtual;
  677.  
  678.     procedure SetWebParent(Value: TComponent);
  679.     procedure ReadState(Reader: TReader); override;
  680.     procedure SetParentComponent(AParent: TComponent); override;
  681.     function GetHTMLForm: IHTMLForm;
  682.     function GetXmlDisplayName: string;
  683.     function GetXmlRowSetName: string;
  684.     procedure SetCaptionAttributes(const Value: TCaptionAttributes);
  685.     function FormatCaption: string; virtual;
  686.     function GetLayoutAttributes: TLayoutAttributes; virtual;
  687.     property LayoutAttributes: TLayoutAttributes read FLayoutAttributes;
  688.     property CaptionPosition: TCaptionPosition
  689.       read FCaptionPosition write FCaptionPosition default capLeft;
  690.   public
  691.     constructor Create(AOwner: TComponent); override;
  692.     destructor Destroy; override;
  693.     class function IsColumn: Boolean; virtual;
  694.     class function IsQueryField: Boolean; virtual;
  695.     function GetParentComponent: TComponent; override;
  696.     function HasParent: Boolean; override;
  697.     property Caption: string read GetCaption write FCaption;
  698.     property TabIndex: Integer read FTabIndex write FTabIndex default -1;
  699.     property Custom: string read FCustom write FCustom;
  700.     property Style: string read FStyle write FStyle;
  701.     property StyleRule: string read FStyleRule write FStyleRule;
  702.     property CaptionAttributes: TCaptionAttributes
  703.       read FCaptionAttributes write SetCaptionAttributes;
  704.   end;
  705.  
  706.   TWebDataDisplayClass = class of TWebDataDisplay;
  707.  
  708.   TWebDataInput = class(TWebDataDisplay, IRestoreDefaults, IDataSetField,
  709.     IValidateField)
  710.   private
  711.     FFieldName: string;
  712.     FParamName: string;
  713.   protected
  714.     { IRestoreDefaults }
  715.     procedure RestoreDefaults;
  716.     procedure ImplRestoreDefaults; virtual;
  717.     { IValidateField }
  718.     function ValidateField(DataSet: IMidasWebDataSet; AddIntf: IAddScriptElements): Boolean;
  719.     { IDataSetField }
  720.     procedure SetFieldName(Value: string);
  721.     function GetFieldName: string;
  722.     function ImplGetFieldName: string; virtual;
  723.     function GetRowSetFieldAttributes(const FieldVarName: string): string;
  724.     function ImplGetRowSetFieldAttributes(const FieldVarName: string): string; virtual;
  725.  
  726.     function ImplGetHTMLControlName: string; override;
  727.     procedure RestoreFieldDefaults(AField: TField); virtual;
  728.     function FindAssociatedField(DataSet: IMidasWebDataSet): TField; virtual;
  729.     function GetParamName: string; virtual;
  730.     procedure SetParamName(Value: string);
  731.     function GetCaption: string; override;
  732.     function EventContent(Options: TWebContentOptions): string; override;
  733.     procedure SetCaption(Value: string); override;
  734.     property ParamName: string read GetParamName write SetParamName;
  735.   public
  736.     property FieldName: string read GetFieldName write SetFieldName;
  737.   end;
  738.  
  739.   TWebStatus = class(TWebDataDisplay, IStatusField)
  740.   private
  741.     FDisplayWidth: Integer;
  742.   protected
  743.     { IStatusField implementation }
  744.     function ImplGetHTMLControlName: string; override;
  745.  
  746.     function GetCaption: string; override;
  747.     function ControlContent(Options: TWebContentOptions): string; override;
  748.   public
  749.     class function Identifier: string;
  750.     constructor Create(AOwner: TComponent); override;
  751.     property DisplayWidth: Integer read FDisplayWidth write FDisplayWidth default 1;
  752.     property Caption;
  753.     property CaptionAttributes;
  754.     property CaptionPosition;
  755.   end;
  756.  
  757.   TWebStatusClass = class of TWebStatus;
  758.  
  759.   TFieldStatus = class(TWebStatus)
  760.   published
  761.     property Caption;
  762.     property CaptionAttributes;
  763.     property CaptionPosition;
  764.     property Style;
  765.     property Custom;
  766.     property StyleRule;
  767.   end;
  768.  
  769.   TStatusColumn = class(TWebStatus)
  770.   public
  771.     class function IsColumn: Boolean; override;
  772.   published
  773.     property Caption;
  774.     property CaptionAttributes;
  775.     property Style;
  776.     property Custom;
  777.     property StyleRule;
  778.   end;
  779.  
  780.   TWebTextInput = class(TWebDataInput)
  781.   private
  782.     FDisplayWidth: Integer;
  783.     FReadOnly: Boolean;
  784.   protected
  785.     procedure AddAttributes(var Attrs: string); virtual;
  786.     function ControlContent(Options: TWebContentOptions): string; override;
  787.     procedure RestoreFieldDefaults(AField: TField); override;
  788.     function ImplGetRowSetFieldAttributes(const FieldVarName: string): string; override;
  789.   public
  790.     constructor Create(AOwner: TComponent); override;
  791.     property DisplayWidth: Integer read FDisplayWidth write FDisplayWidth;
  792.     property ReadOnly: Boolean read FReadOnly write FReadOnly default False;
  793.     property Style;
  794.     property Custom;
  795.     property StyleRule;
  796.   end;
  797.  
  798.   TFieldText = class(TWebTextInput)
  799.   published
  800.     property DisplayWidth;
  801.     property ReadOnly;
  802.     property Caption;
  803.     property CaptionAttributes;
  804.     property CaptionPosition;
  805.     property FieldName;
  806.     property TabIndex;
  807.     property Style;
  808.     property Custom;
  809.     property StyleRule;
  810.   end;
  811.  
  812.   TTextColumn = class(TWebTextInput)
  813.   public
  814.     class function IsColumn: Boolean; override;
  815.   published
  816.     property DisplayWidth;
  817.     property ReadOnly;
  818.     property Caption;
  819.     property CaptionAttributes;
  820.     property FieldName;
  821.     property TabIndex;
  822.     property Style;
  823.     property Custom;
  824.     property StyleRule;
  825.   end;
  826.  
  827.   TQueryText = class(TWebTextInput, IQueryField)
  828.   private
  829.     FText: string;
  830.     FMaxWidth: integer;
  831.   protected
  832.     function GetText: string;
  833.     procedure AddAttributes(var Attrs: string); override;
  834.     procedure SetText(const Value: string);
  835.   public
  836.     class function IsQueryField: Boolean; override;
  837.     constructor Create(AOwner: TComponent); override;
  838.   published
  839.     property ParamName;
  840.     property DisplayWidth;
  841.     property ReadOnly;
  842.     property Caption;
  843.     property CaptionAttributes;
  844.     property CaptionPosition;
  845.     property FieldName;
  846.     property TabIndex;
  847.     property Style;
  848.     property Custom;
  849.     property StyleRule;
  850.     property Text: string read GetText write SetText;
  851.     property MaxWidth: Integer read FMaxWidth write FMaxWidth default -1;
  852.   end;
  853.  
  854.   TTextAreaWrap = (wrOff, wrPhysical, wrVirtual);
  855.  
  856.   TWebTextAreaInput = class(TWebDataInput)
  857.   private
  858.     FReadOnly: Boolean;
  859.     FWrap: TTextAreaWrap;
  860.     FDisplayWidth: Integer;
  861.     FDisplayRows: Integer;
  862.   protected
  863.     procedure AddAttributes(var Attrs: string); virtual;
  864.     function ControlContent(Options: TWebContentOptions): string; override;
  865.     procedure RestoreFieldDefaults(AField: TField); override;
  866.     function ImplGetRowSetFieldAttributes(const FieldVarName: string): string; override;
  867.     function EventContent(Options: TWebContentOptions): string; override;
  868.   public
  869.     constructor Create(AOwner: TComponent); override;
  870.     property ReadOnly: Boolean read FReadOnly write FReadOnly default False;
  871.     property Wrap: TTextAreaWrap read FWrap write FWrap;
  872.     property DisplayWidth: Integer read FDisplayWidth write FDisplayWidth;
  873.     property DisplayRows: Integer read FDisplayRows write FDisplayRows;
  874.   end;
  875.  
  876.   TFieldTextArea = class(TWebTextAreaInput)
  877.   published
  878.     property ReadOnly;
  879.     property Caption;
  880.     property CaptionAttributes;
  881.     property CaptionPosition;
  882.     property FieldName;
  883.     property Wrap;
  884.     property DisplayWidth;
  885.     property DisplayRows;
  886.     property TabIndex;
  887.     property Style;
  888.     property Custom;
  889.     property StyleRule;
  890.   end;
  891.  
  892.   TQueryTextArea = class(TWebTextAreaInput, IQueryField)
  893.   private
  894.     FLines: TStrings;
  895.   protected
  896.     procedure AddAttributes(var Attrs: string); override;
  897.     procedure SetLines(const Value: TStrings);
  898.     function ControlContent(Options: TWebContentOptions): string; override;
  899.     { IQueryField }
  900.     procedure SetText(const Value: string);
  901.     function GetText: string;
  902.   public
  903.     class function IsQueryField: Boolean; override;
  904.     constructor Create(AOwner: TComponent); override;
  905.     destructor Destroy; override;
  906.   published
  907.     property ParamName;
  908.     property ReadOnly;
  909.     property Caption;
  910.     property CaptionAttributes;
  911.     property CaptionPosition;
  912.     property FieldName;
  913.     property Wrap;
  914.     property DisplayWidth;
  915.     property DisplayRows;
  916.     property TabIndex;
  917.     property Style;
  918.     property Custom;
  919.     property StyleRule;
  920.     property Lines: TStrings read FLines write SetLines;
  921.   end;
  922.  
  923.   TTextAreaColumn = class(TWebTextAreaInput)
  924.   public
  925.     class function IsColumn: Boolean; override;
  926.   published
  927.     property ReadOnly;
  928.     property Caption;
  929.     property CaptionAttributes;
  930.     property FieldName;
  931.     property Wrap;
  932.     property DisplayWidth;
  933.     property DisplayRows;
  934.     property TabIndex;
  935.     property Style;
  936.     property Custom;
  937.     property StyleRule;
  938.   end;
  939.  
  940.   TWebListInput = class(TWebDataInput, IScriptComponent)
  941.   private
  942.     FValues: TStrings;
  943.     FItems: TStrings;
  944.     FDataSet: TDataSet;
  945.     FValuesField: string;
  946.     FItemsField: string;
  947.   protected
  948.     { IScriptComponent }
  949.     procedure AddElements(AddIntf: IAddScriptElements);
  950.     procedure ImplAddElements(AddIntf: IAddScriptElements); virtual;
  951.     function GetSubComponents: TObject;
  952.  
  953.     procedure SetItems(const Value: TStrings);
  954.     procedure SetValues(const Value: TStrings);
  955.     procedure SetDataSet(const Value: TDataSet);
  956.     function FormatInputs(ItemsStrings, ValuesStrings: TStrings; Options: TWebContentOptions): string; virtual; abstract;
  957.     function ControlContent(Options: TWebContentOptions): string; override;
  958.     procedure Notification(AComponent: TComponent;
  959.       Operation: TOperation); override;
  960.   public
  961.     constructor Create(AOwner: TComponent); override;
  962.     destructor Destroy; override;
  963.     property Values: TStrings read FValues write SetValues;
  964.     property Items: TStrings read FItems write SetItems;
  965.     property DataSet: TDataSet read FDataSet write SetDataSet;
  966.     property ValuesField: string Read FValuesField write FValuesField;
  967.     property ItemsField: string read FItemsField write FItemsField;
  968.   end;
  969.  
  970.   TWebRadioGroupInput = class(TWebListInput)
  971.   private
  972.     FReadOnly: Boolean;
  973.     FDisplayWidth: Integer;
  974.     FDisplayColumns: Integer;
  975.   protected
  976.     procedure AddAttributes(var Attrs: string); virtual;
  977.     function FormatInputs(ItemsStrings, ValuesStrings: TStrings; Options: TWebContentOptions): string; override;
  978.     procedure RestoreFieldDefaults(AField: TField); override;
  979.     function GetCheckIndex(ItemsStrings, ValuesStrings: TStrings): Integer; virtual;
  980.     function EventContent(Options: TWebContentOptions): string; override;
  981.     function ImplGetRowSetFieldAttributes(const FieldVarName: string): string; override;
  982.   public
  983.     constructor Create(AOwner: TComponent); override;
  984.     property ReadOnly: Boolean read FReadOnly write FReadOnly;
  985.     property DisplayWidth: Integer read FDisplayWidth write FDisplayWidth;
  986.     property DisplayColumns: Integer read FDisplayColumns write FDisplayColumns;
  987.   end;
  988.  
  989.   TFieldRadioGroup = class(TWebRadioGroupInput)
  990.   published
  991.     property ReadOnly;
  992.     property Caption;
  993.     property CaptionAttributes;
  994.     property CaptionPosition;
  995.     property FieldName;
  996.     property DisplayWidth;
  997.     property DisplayColumns;
  998.     property TabIndex;
  999.     property Values;
  1000.     property Items;
  1001.     property DataSet;
  1002.     property ValuesField;
  1003.     property ItemsField;
  1004.     property Style;
  1005.     property Custom;
  1006.     property StyleRule;
  1007.   end;
  1008.  
  1009.   TQueryRadioGroup = class(TWebRadioGroupInput, IQueryField)
  1010.   private
  1011.     FText: string;
  1012.   protected
  1013.     function GetText: string;
  1014.     procedure SetText(const Value: string);
  1015.     function GetCheckIndex(ItemsStrings, ValuesStrings: TStrings): Integer; override;
  1016.     procedure AddAttributes(var Attrs: string); override;
  1017.   public
  1018.     class function IsQueryField: Boolean; override;
  1019.   published
  1020.     property ParamName;
  1021.     property ReadOnly;
  1022.     property Caption;
  1023.     property CaptionAttributes;
  1024.     property CaptionPosition;
  1025.     property FieldName;
  1026.     property DisplayWidth;
  1027.     property DisplayColumns;
  1028.     property TabIndex;
  1029.     property Values;
  1030.     property Items;
  1031.     property DataSet;
  1032.     property ValuesField;
  1033.     property ItemsField;
  1034.     property Style;
  1035.     property Custom;
  1036.     property StyleRule;
  1037.     property Text: string read GetText write SetText;
  1038.   end;
  1039.  
  1040.   TWebSelectOptionsInput = class(TWebListInput)
  1041.   private
  1042.     FDisplayRows: Integer;
  1043.   protected
  1044.     procedure AddAttributes(var Attrs: string); virtual;
  1045.     function GetSelectIndex(ItemsStrings, ValuesStrings: TStrings): Integer; virtual;
  1046.     function FormatInputs(ItemsStrings, ValuesStrings: TStrings; Options: TWebContentOptions): string; override;
  1047.     function EventContent(Options: TWebContentOptions): string; override;
  1048.   public
  1049.     constructor Create(AOwner: TComponent); override;
  1050.     property DisplayRows: Integer read FDisplayRows write FDisplayRows;
  1051.   end;
  1052.  
  1053.   TFieldSelectOptions = class(TWebSelectOptionsInput)
  1054.   published
  1055.     property DisplayRows;
  1056.     property Caption;
  1057.     property CaptionAttributes;
  1058.     property CaptionPosition;
  1059.     property FieldName;
  1060.     property TabIndex;
  1061.     property Values;
  1062.     property Items;
  1063.     property DataSet;
  1064.     property ValuesField;
  1065.     property ItemsField;
  1066.     property Style;
  1067.     property Custom;
  1068.     property StyleRule;
  1069.   end;
  1070.  
  1071.   TQuerySelectOptions = class(TWebSelectOptionsInput, IQueryField)
  1072.   private
  1073.     FText: string;
  1074.   protected
  1075.     function GetText: string;
  1076.     procedure SetText(const Value: string);
  1077.     function GetSelectIndex(ItemsStrings, ValuesStrings: TStrings): Integer; override;
  1078.   public
  1079.     class function IsQueryField: Boolean; override;
  1080.   published
  1081.     property ParamName;
  1082.     property DisplayRows;
  1083.     property Caption;
  1084.     property CaptionAttributes;
  1085.     property CaptionPosition;
  1086.     property FieldName;
  1087.     property TabIndex;
  1088.     property Values;
  1089.     property Items;
  1090.     property DataSet;
  1091.     property ValuesField;
  1092.     property ItemsField;
  1093.     property Style;
  1094.     property Custom;
  1095.     property StyleRule;
  1096.     property Text: string read GetText write SetText;
  1097.   end;
  1098.  
  1099.   TSelectOptionsColumn = class(TWebSelectOptionsInput)
  1100.   public
  1101.     class function IsColumn: Boolean; override;
  1102.   published
  1103.     property DisplayRows;
  1104.     property Caption;
  1105.     property CaptionAttributes;
  1106.     property FieldName;
  1107.     property TabIndex;
  1108.     property Values;
  1109.     property Items;
  1110.     property DataSet;
  1111.     property ValuesField;
  1112.     property ItemsField;
  1113.     property Style;
  1114.     property Custom;
  1115.     property StyleRule;
  1116.   end;
  1117.  
  1118.   TWebButton = class(TComponent, IWebComponent, IWebContent)
  1119.   private
  1120.     FWebParent: TComponent;
  1121.     FWebButtonsList: TWebComponentList;
  1122.     FDefaultButton: Boolean;
  1123.     FStyle: string;
  1124.     FCustom: string;
  1125.     FCaption: string;
  1126.     FStyleRule: string;
  1127.     procedure SetWebParent(const Value: TComponent);
  1128.   protected
  1129.     { IWebComponent }
  1130.     function GetIndex: Integer;
  1131.     procedure SetIndex(Value: Integer);
  1132.     procedure SetContainer(Container: TWebComponentContainer);
  1133.     function GetContainer: TWebComponentContainer;
  1134.     procedure SetComponentList(List: TObject);
  1135.     { IWebContent }
  1136.     function Content(Options: TWebContentOptions; Layout: TLayout): string;
  1137.     function ImplContent(Options: TWebContentOptions; Layout: TLayout): string; virtual; abstract;
  1138.  
  1139.     function GetCaption: string; virtual;
  1140.     function GetLayoutAttributes: TLayoutAttributes; virtual;
  1141.     procedure ReadState(Reader: TReader); override;
  1142.     procedure SetParentComponent(AParent: TComponent); override;
  1143.   public
  1144.     constructor Create(AOwner: TComponent); override;
  1145.     destructor Destroy; override;
  1146.     function GetParentComponent: TComponent; override;
  1147.     function HasParent: Boolean; override;
  1148.     property Caption: string read GetCaption write FCaption;
  1149.     property Style: string read FStyle write FStyle;
  1150.     property Custom: string read FCustom write FCustom;
  1151.     property StyleRule: string read FStyleRule write FStyleRule;
  1152.   end;
  1153.  
  1154.   TWebButtonClass = class of TWebButton;
  1155.  
  1156.   TXMLDisplayReferenceButton = class(TWebButton)
  1157.   private
  1158.     FXMLDisplay: TXMLDisplayParent;
  1159.   protected
  1160.     function GetDisplayComponentParent: Boolean;
  1161.     function GetDisplayComponent: TComponent;
  1162.     procedure SetDisplayComponent(const Value: TComponent);
  1163.     procedure SetDisplayComponentParent(const Value: Boolean);
  1164.     function GetXmlDisplayName: string;
  1165.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  1166.     property XMLDisplay: TXMLDisplayParent read FXMLDisplay;
  1167.   public
  1168.     constructor Create(AOwner: TComponent); override;
  1169.     destructor Destroy; override;
  1170.     property XMLComponent: TComponent read GetDisplayComponent write SetDisplayComponent;
  1171.     property XMLUseParent: Boolean read GetDisplayComponentParent write SetDisplayComponentParent default True;
  1172.   end;
  1173.  
  1174.   TDataSetButton = class(TXMLDisplayReferenceButton, IScriptComponent)
  1175.   protected
  1176.     DefaultCaption: string;
  1177.     XMLMethodName: string;
  1178.     { IScriptComponent }
  1179.     procedure AddElements(AddIntf: IAddScriptElements);
  1180.     function GetSubComponents: TObject;
  1181.     procedure ImplAddElements(AddIntf: IAddScriptElements); virtual;
  1182.     { IWebContent implementation }
  1183.     function ImplContent(Options: TWebContentOptions; ParentLayout: TLayout): string; override;
  1184.     function GetCaption: string; override;
  1185.     function GetMethodName: string; virtual;
  1186.   published
  1187.     property XMLComponent;
  1188.     property XMLUseParent;
  1189.     property Style;
  1190.     property Custom;
  1191.     property Caption;
  1192.     property StyleRule;
  1193.   end;
  1194.  
  1195.   TFirstButton = class(TDataSetButton)
  1196.   public
  1197.     constructor Create(AOwner: TComponent); override;
  1198.   end;
  1199.  
  1200.   TLastButton = class(TDataSetButton)
  1201.   public
  1202.     constructor Create(AOwner: TComponent); override;
  1203.   end;
  1204.  
  1205.   TPriorButton = class(TDataSetButton)
  1206.   public
  1207.     constructor Create(AOwner: TComponent); override;
  1208.   end;
  1209.  
  1210.   TNextButton = class(TDataSetButton)
  1211.   public
  1212.     constructor Create(AOwner: TComponent); override;
  1213.   end;
  1214.  
  1215.   TPriorPageButton = class(TDataSetButton)
  1216.   public
  1217.     constructor Create(AOwner: TComponent); override;
  1218.   end;
  1219.  
  1220.   TNextPageButton = class(TDataSetButton)
  1221.   public
  1222.     constructor Create(AOwner: TComponent); override;
  1223.   end;
  1224.  
  1225.   TUndoButton = class(TDataSetButton)
  1226.   public
  1227.     constructor Create(AOwner: TComponent); override;
  1228.   end;
  1229.  
  1230.   TDeleteButton = class(TDataSetButton)
  1231.   public
  1232.     constructor Create(AOwner: TComponent); override;
  1233.   end;
  1234.  
  1235.   TInsertButton = class(TDataSetButton)
  1236.   public
  1237.     constructor Create(AOwner: TComponent); override;
  1238.   end;
  1239.  
  1240.   TPostButton = class(TDataSetButton)
  1241.   public
  1242.     constructor Create(AOwner: TComponent); override;
  1243.   end;
  1244.  
  1245.   TXMLButton = class(TWebButton)
  1246.   private
  1247.     FDefaultCaption: string;
  1248.     FXMLData: TXMLDataParent;
  1249.   protected
  1250.     function GetXMLBroker: TXMLBroker;
  1251.     procedure SetXMLBroker(const Value: TXMLBroker);
  1252.     function GetXMLUseParent: Boolean;
  1253.     procedure SetXMLUseParent(const Value: Boolean);
  1254.     function GetCaption: string; override;
  1255.     procedure Notification(AComponent: TComponent;
  1256.       Operation: TOperation); override;
  1257.     property XMLData: TXMLDataParent read FXMLData;
  1258.     property DefaultCaption: string read FDefaultCaption write FDefaultCaption;
  1259.   public
  1260.     constructor Create(AOwner: TComponent); override;
  1261.     destructor Destroy; override;
  1262.     property XMLBroker: TXMLBroker read GetXMLBroker write SetXMLBroker;
  1263.     property XMLUseParent: Boolean read GetXMLUseParent write SetXMLUseParent;
  1264.   end;
  1265.  
  1266.   TApplyUpdatesButton = class(TXMLButton, IScriptComponent)
  1267.   protected
  1268.     { IWebContent implementation }
  1269.     function ImplContent(Options: TWebContentOptions; ParentLayout: TLayout): string; override;
  1270.     { IScriptComponent }
  1271.     procedure AddElements(AddIntf: IAddScriptElements);
  1272.     procedure ImplAddElements(AddIntf: IAddScriptElements); virtual;
  1273.     function GetSubComponents: TObject;
  1274.   public
  1275.     constructor Create(AOwner: TComponent); override;
  1276.   published
  1277.     property Custom;
  1278.     property Style;
  1279.     property StyleRule;
  1280.     property Caption;
  1281.     property XMLBroker;
  1282.     property XMLUseParent;
  1283.   end;
  1284.  
  1285.   TXMLDisplayReferenceGroup = class(TWebControlGroup, IXMLDisplayReference)
  1286.   private
  1287.     FXMLDisplay: TXMLDisplay;
  1288.   protected
  1289.     { IXMLDisplayReference }
  1290.     function GetXMLDisplayComponent: TComponent;
  1291.     { IScriptComponent implementation }
  1292.     procedure ImplAddElements(AddIntf: IAddScriptElements); override;
  1293.  
  1294.     procedure SetXMLDisplayComponent(const Value: TComponent);
  1295.     property XMLDisplay: TXMLDisplay read FXMLDisplay;
  1296.     procedure Notification(AComponent: TComponent;
  1297.       Operation: TOperation); override;
  1298.   public
  1299.     constructor Create(AOwner: TComponent); override;
  1300.     destructor Destroy; override;
  1301.     property XMLComponent: TComponent read GetXMLDisplayComponent write SetXMLDisplayComponent;
  1302.   end;
  1303.  
  1304.   TCustomDataNavigator = class(TXMLDisplayReferenceGroup)
  1305.   private
  1306.     FStyle: string;
  1307.     FCustom: string;
  1308.     FStyleRule: string;
  1309.   protected
  1310.     { IScriptComponent implementation  }
  1311.     function ImplGetSubComponents: TObject; override;
  1312.     { IWebComponentEditor implementation }
  1313.     function ImplCanAddClass(AParent: TComponent; AClass: TClass): Boolean; override;
  1314.     { IWebContent implementation }
  1315.     function ImplContent(Options: TWebContentOptions; ParentLayout: TLayout): string; override;
  1316.  
  1317.     function VisibleButtons: TWebComponentList;
  1318.     procedure GetDefaultButtons; virtual;
  1319.   public
  1320.     property Custom: string read FCustom write FCustom;
  1321.     property Style: string read FStyle write FStyle;
  1322.     property StyleRule: string read FStyleRule write FStyleRule;
  1323.   end;
  1324.  
  1325.   TDataNavigator = class(TCustomDataNavigator)
  1326.   published
  1327.     property XMLComponent;
  1328.     property Style;
  1329.     property Custom;
  1330.     property StyleRule;
  1331.   end;
  1332.  
  1333.   TQueryButton = class(TWebButton)
  1334.   private
  1335.     FCaption: string;
  1336.     FXMLComponent: TComponent;
  1337.     FXMLUseParent: Boolean;
  1338.   protected
  1339.     DefaultCaption: string;
  1340.     InputType: string;
  1341.     function ParentXMLComponent: TComponent;
  1342.     function GetXMLComponent: TComponent;
  1343.     procedure SetXMLComponent(const Value: TComponent);
  1344.     procedure SetXMLUseParent(const Value: Boolean);
  1345.     function GetCaption: string; override;
  1346.     function GetInputType: string; virtual;
  1347.     function GetHTMLControlName: string; virtual;
  1348.     function GetHTMLForm: IHTMLForm;
  1349.     { IWebContent impl }
  1350.     function ImplContent(Options: TWebContentOptions; ParentLayout: TLayout): string; override;
  1351.     function EventContent(Options: TWebContentOptions): string; virtual;
  1352.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  1353.   public
  1354.     constructor Create(AOwner: TComponent); override;
  1355.   published
  1356.     property Caption: string read GetCaption write FCaption;
  1357.     property Custom;
  1358.     property Style;
  1359.     property StyleRule;
  1360.     property XMLComponent: TComponent read GetXMLComponent write SetXMLComponent;
  1361.     property XMLUseParent: Boolean read FXMLUseParent write SetXMLUseParent default True;
  1362.   end;
  1363.  
  1364.   TSubmitQueryButton = class(TQueryButton)
  1365.   protected
  1366.     function EventContent(Options: TWebContentOptions): string; override;
  1367.   public
  1368.     constructor Create(AOwner: TComponent); override;
  1369.   end;
  1370.  
  1371.   TResetQueryButton = class(TQueryButton)
  1372.   protected
  1373.     function EventContent(Options: TWebContentOptions): string; override;
  1374.   public
  1375.     constructor Create(AOwner: TComponent); override;
  1376.   end;
  1377.  
  1378.   TCustomQueryButtons = class(TWebControlGroup)
  1379.   private
  1380.     FStyle: string;
  1381.     FCustom: string;
  1382.     FStyleRule: string;
  1383.   protected
  1384.     { IWebComponentEditor implementation }
  1385.     function ImplCanAddClass(AParent: TComponent; AClass: TClass): Boolean; override;
  1386.     { IScriptComponent implementation }
  1387.     procedure ImplAddElements(AddIntf: IAddScriptElements); override;
  1388.     { IWebContent }
  1389.     function ImplContent(Options: TWebContentOptions; ParentLayout: TLayout): string; override;
  1390.  
  1391.     function VisibleButtons: TWebComponentList;
  1392.     procedure GetDefaultButtons; virtual;
  1393.   public
  1394.     property Style: string read FStyle write FStyle;
  1395.     property Custom: string read FCustom write FCustom;
  1396.     property StyleRule: string read FStyleRule write FStyleRule;
  1397.   end;
  1398.  
  1399.   TQueryButtons = class(TCustomQueryButtons)
  1400.   published
  1401.     property Style;
  1402.     property Custom;
  1403.     property StyleRule;
  1404.   end;
  1405.  
  1406.   TLayoutState = (lsUnknown, lsFields, lsButtons);
  1407.   TFormLayout = class(TLayoutWebContent)
  1408.   private
  1409.     FLayoutState: TLayoutState;
  1410.     FInTable: Boolean;
  1411.     FInRow: Boolean;
  1412.     FTableHeader: string;
  1413.     FColumnCount: Integer;
  1414.     FColumnIndex: Integer;
  1415.     FBreakButtons: Boolean;
  1416.     FButtonIndex: Integer;
  1417.   protected
  1418.     function ImplLayoutButton(const HTMLButton: string; Attributes: TLayoutAttributes): string; override;
  1419.     function ImplLayoutField(const HTMLField: string; Attributes: TLayoutAttributes): string; override;
  1420.     function ImplLayoutLabelAndField(const HTMLLabel, HTMLField: string; Attributes: TLayoutAttributes): string; override;
  1421.     function ImplLayoutTable(const HTMLTable: string; Attributes: TLayoutAttributes): string; override;
  1422.     function StartFields(ColCount: Integer): string;
  1423.     function EndButtons: string;
  1424.     function StartButtons: string;
  1425.     function EndFields: string;
  1426.     function StartTable: string;
  1427.     function EndTable: string;
  1428.     function StartRow: string;
  1429.     function EndRow: string;
  1430.     function NextColumn(SubItemCount: Integer): string;
  1431.   public
  1432.     constructor Create(AParentLayout: TLayout);
  1433.     function EndLayout: string;
  1434.     property ColumnCount: Integer read FColumnCount write FColumnCount;
  1435.     property BreakButtons: Boolean read FBreakButtons write FBreakButtons;
  1436.     property TableHeader: string read FTableHeader write FTableHeader;
  1437.   end;
  1438.  
  1439. const
  1440.   TextAreaWrap: array[TTextAreaWrap] of string =
  1441.     ('OFF',
  1442.      'PHYSICAL',
  1443.      'VIRTUAL');            // Always declare explicitly.  IE
  1444.                             // and Navigator have different defaults.
  1445.  
  1446.   FormMethodNames: array[TFormMethod] of string =
  1447.     ('POST',
  1448.      'GET');
  1449.  
  1450.   // Utility functions
  1451.   function GetItemValuesFromDataSet(DataSet: TDataSet;
  1452.     const ItemsField, ValuesField: string;
  1453.     var ItemsStrings, ValuesStrings: TStrings): Boolean;
  1454.  
  1455.   procedure AddIntAttrib(var Attribs: string; const Attrib: string;
  1456.     Value: Integer);
  1457.   procedure AddStringAttrib(var Attribs: string; const Attrib,
  1458.     Value: string);
  1459.   procedure AddCustomAttrib(var Attribs: string;
  1460.     Value: string);
  1461.   procedure AddBoolAttrib(var Attribs: string;
  1462.   const Attrib: string; Value: Boolean);
  1463.   procedure AddQuotedAttrib(var Attribs: string;
  1464.   const Attrib, Value: string);
  1465.   function FormatColumnHeading(Field: TWebDataDisplay): string;
  1466.   function FormatColumnData(Field: TWebDataDisplay; Content: string): string;
  1467.   procedure CreateDefaultButtonClasses(
  1468.     Classes: array of TWebButtonClass; Container: TWebComponentList);
  1469.   function CanAddClassHelper(AEditor: TComponent; AParent: TComponent; AClass: TClass): Boolean;
  1470.   procedure DeclareSubmitForm(Component: TComponent; XMLBroker: TXMLBroker; AddIntf: IAddScriptElements);
  1471.   function FindDispatcher(Component: TComponent): TCustomWebDispatcher;
  1472.   function FindProducer(Component: TComponent): TCustomContentProducer;
  1473.  
  1474. implementation
  1475.  
  1476. uses Provider, Windows, Messages, DbConsts, MidConst, ActiveX, ComObj, WebConst, sysutils, DbWeb, Forms,
  1477.   WbmConst;
  1478.  
  1479. function CanAddClassHelper(AEditor: TComponent; AParent: TComponent; AClass: TClass): Boolean;
  1480. var
  1481.   Helper: TObject;
  1482.   Intf: IWebComponentEditorHelper;
  1483. begin
  1484.   Helper := FindWebComponentEditorHelper(AClass);
  1485.   if (Assigned(Helper) and Helper.GetInterface(IWebComponentEditorHelper, Intf)) then
  1486.     Result := Intf.CanAddClassHelper(AEditor, AParent, AClass)
  1487.   else
  1488.     Result := False;
  1489. end;
  1490.  
  1491. procedure AddIntAttrib(var Attribs: string; const Attrib: string;
  1492.   Value: Integer);
  1493. begin
  1494.   if Value <> -1 then
  1495.     Attribs := Format('%s %s=%d', [Attribs, Attrib, Value]);
  1496. end;
  1497.  
  1498. procedure AddStringAttrib(var Attribs: string; const Attrib,
  1499.   Value: string);
  1500. begin
  1501.   if Value <> '' then
  1502.     Attribs := Format('%s %s=%s', [Attribs, Attrib, Value]);
  1503. end;
  1504.  
  1505. procedure AddCustomAttrib(var Attribs: string;
  1506.   Value: string);
  1507. begin
  1508.   if Value <> '' then
  1509.     Attribs := Format('%s %s', [Attribs, Value]);
  1510. end;
  1511.  
  1512. procedure AddBoolAttrib(var Attribs: string;
  1513.   const Attrib: string; Value: Boolean);
  1514. begin
  1515.   if Value then
  1516.     Attribs := Format('%s %s', [Attribs, Attrib]);
  1517. end;
  1518.  
  1519. procedure AddQuotedAttrib(var Attribs: string;
  1520.   const Attrib, Value: string);
  1521. begin
  1522.   if Value <> '' then
  1523.     Attribs := Format('%s %s="%s"', [Attribs, Attrib, Value]);
  1524. end;
  1525.  
  1526. function FormatColumnHeading(Field: TWebDataDisplay): string;
  1527. var
  1528.   Attribs: string;
  1529. begin
  1530.   AddQuotedAttrib(Attribs, 'STYLE', Field.CaptionAttributes.Style);
  1531.   AddCustomAttrib(Attribs, Field.CaptionAttributes.Custom);
  1532.   AddQuotedAttrib(Attribs, 'CLASS', Field.CaptionAttributes.StyleRule);
  1533.   Result := Format('<TH%s>%s</TH>'#13#10, [Attribs, Field.Caption]);
  1534. end;
  1535.  
  1536. function FormatColumnData(Field: TWebDataDisplay; Content: string): string;
  1537. var
  1538.   Attribs: string;
  1539. begin
  1540.   AddQuotedAttrib(Attribs, 'STYLE', Field.Style);
  1541.   AddCustomAttrib(Attribs, Field.Custom);
  1542.   AddQuotedAttrib(Attribs, 'CLASS', Field.StyleRule);
  1543.   Result := Format('<TD%s><DIV>%s</DIV></TD>'#13#10, [Attribs,
  1544.     Content]);
  1545. end;
  1546.  
  1547. var
  1548.   XMLDataSetList: TList;
  1549.  
  1550. type
  1551.  
  1552.   TClientDataSetEvent = class(TClientDataSet)
  1553.   private
  1554.     FOnDataChange: TNotifyEvent;
  1555.   protected
  1556.     procedure DataEvent(Event: TDataEvent; Info: Longint); override;
  1557.   public
  1558.     property DataChange: TNotifyEvent read FOnDataChange write FOnDataChange;
  1559.   end;
  1560.  
  1561.   TDataSetWrapper = class(TInterfacedObject, IMidasWebDataSet)
  1562.   private
  1563.     FDataSet: TClientDataSetEvent;
  1564.     FDetailDataSet: TDataSet;
  1565.     FOnDataChange: array of TNotifyEvent;
  1566.   protected
  1567.     procedure OnDataChange(Sender: TObject);
  1568.     { IMidasWebDataSet }
  1569.     function FieldCount: Integer;
  1570.     function Fields: TFields;
  1571.     procedure FetchParams;
  1572.     function ParamCount: Integer;
  1573.     function Params: TParams;
  1574.     procedure AddOnDataChange(const Value: TNotifyEvent);
  1575.     procedure RemoveOnDataChange(const Value: TNotifyEvent);
  1576.   public
  1577.     constructor Create;
  1578.     destructor Destroy; override;
  1579.   end;
  1580.  
  1581. type
  1582.   TGridLayout = class(TLayoutWebContent)
  1583.   protected
  1584.     function ImplLayoutButton(const HTMLButton: string; Attributes: TLayoutAttributes): string; override;
  1585.     function ImplLayoutField(const HTMLField: string; Attributes: TLayoutAttributes): string; override;
  1586.     function ImplLayoutLabelAndField(const HTMLLabel, HTMLField: string; Attributes: TLayoutAttributes): string; override;
  1587.     function ImplLayoutTable(const HTMLTable: string; Attributes: TLayoutAttributes): string; override;
  1588.   end;
  1589.  
  1590. function TGridLayout.ImplLayoutButton(const HTMLButton: string; Attributes: TLayoutAttributes): string;
  1591. begin
  1592.   Result := ImplLayoutField(HTMLButton, Attributes);
  1593. end;
  1594.  
  1595. function TGridLayout.ImplLayoutField(const HTMLField: string; Attributes: TLayoutAttributes): string;
  1596. begin
  1597.   Result := HTMLField;
  1598. end;
  1599.  
  1600. function TGridLayout.ImplLayoutLabelAndField(const HTMLLabel, HTMLField: string; Attributes: TLayoutAttributes): string;
  1601. begin
  1602.   // Label ignored
  1603.   Result := ImplLayoutField(HTMLField, Attributes);
  1604. end;
  1605.  
  1606. { TWebForm }
  1607.  
  1608. constructor TWebForm.Create(AComponent: TComponent);
  1609. begin
  1610.   inherited;
  1611.   FWebComponents := TWebComponentList.Create(Self);
  1612.   FLayoutAttributes := TLayoutAttributes.Create;
  1613. end;
  1614.  
  1615. destructor TWebForm.Destroy;
  1616. begin
  1617.   inherited;
  1618.   if Assigned(FContainer) then
  1619.     FContainer.Remove(Self);
  1620.   FWebComponents.Free;
  1621.   FLayoutAttributes.Free;
  1622. end;
  1623.  
  1624. procedure TWebForm.SetComponentList(List: TObject);
  1625. begin
  1626.   FContainer := List as TWebComponentList;
  1627. end;
  1628.  
  1629. function TWebForm.GetContainer: TWebComponentContainer;
  1630. begin
  1631.   Result := FContainer;
  1632. end;
  1633.  
  1634. function TWebForm.GetIndex: Integer;
  1635. begin
  1636.   Result := FContainer.IndexOf(Self);
  1637. end;
  1638.  
  1639. procedure TWebForm.SetContainer(Container: TWebComponentContainer);
  1640. begin
  1641.   SetWebParent((Container as TWebComponentList).ParentComponent);
  1642. end;
  1643.  
  1644. procedure TWebForm.SetIndex(Value: Integer);
  1645. begin
  1646.   FContainer.SetComponentIndex(Self, Value);
  1647. end;
  1648.  
  1649. function TWebForm.GetParentComponent: TComponent;
  1650. begin
  1651.   if Assigned(FWebParent) then
  1652.     Result := FWebParent else
  1653.     Result := inherited GetParentComponent;
  1654. end;
  1655.  
  1656. function TWebForm.HasParent: Boolean;
  1657. begin
  1658.   if Assigned(FWebParent) then
  1659.     Result := True else
  1660.     Result := inherited HasParent;
  1661. end;
  1662.  
  1663. procedure TWebForm.ReadState(Reader: TReader);
  1664. begin
  1665.   inherited ReadState(Reader);
  1666.   SetWebParent(Reader.Parent);
  1667. end;
  1668.  
  1669. procedure TWebForm.SetParentComponent(AParent: TComponent);
  1670. begin
  1671.   if not (csLoading in ComponentState) then
  1672.     SetWebParent(AParent);
  1673. end;
  1674.  
  1675. function TWebForm.Content(Options: TWebContentOptions; Layout: TLayout): string;
  1676. begin
  1677.   Result := ImplContent(Options, Layout);
  1678. end;
  1679.  
  1680. procedure ValidateWebParent(AComponent: TComponent; AParent: TComponent);
  1681. var
  1682.   P: TComponent;
  1683.   Editor: IWebComponentEditor;
  1684. begin
  1685.   // Don't allow self to be parented by a child of self
  1686.   P := AParent;
  1687.   while Assigned(P) do
  1688.   begin
  1689.     if P = AComponent then
  1690.       raise EComponentError.CreateRes(@sInvalidParent);
  1691.     P := P.GetParentComponent;
  1692.   end;
  1693.   if AParent.GetInterface(IWebComponentEditor, Editor) then
  1694.     if not Editor.CanAddClass(AParent, AComponent.ClassType) then
  1695.       raise EComponentError.CreateRes(@sInvalidParent);
  1696. end;
  1697.  
  1698. procedure TWebForm.SetWebParent(const Value: TComponent);
  1699. var
  1700.   List: IGetWebComponentList;
  1701. begin
  1702.   if Value <> FWebParent then
  1703.   begin
  1704.     if Assigned(Value) and (csDesigning in ComponentState) then
  1705.       ValidateWebParent(Self, Value);
  1706.     if FWebParent <> nil then
  1707.     begin
  1708.       FWebParent.GetInterface(IGetWebComponentList, List);
  1709.       (List.GetComponentList as TWebComponentList).Remove(Self);
  1710.     end;
  1711.     if Value <> nil then
  1712.     begin
  1713.       Value.GetInterface(IGetWebComponentList, List);
  1714.       (List.GetComponentList as TWebComponentList).Add(Self);
  1715.     end;
  1716.     FWebParent := Value;
  1717.   end;
  1718. end;
  1719.  
  1720. function TWebForm.CanAddClass(AParent: TComponent; AClass: TClass): Boolean;
  1721. begin
  1722.   Result := ImplCanAddClass(AParent, AClass);
  1723. end;
  1724.  
  1725.   { Inserts line breaks and an indent of Indent characters into the given text in
  1726.   place of '|' characters when the line length exceeds 75 characters.  If a line
  1727.   break is not necessary the '|' is removed. }
  1728. function FormatText(Text: PChar; Col, Indent: Integer): PChar;
  1729. const
  1730.   MaxLineLen = 75;
  1731. var
  1732.   Mark, P: PChar;
  1733. begin
  1734.   Result := Text;
  1735.   Mark := nil;
  1736.   while Text^ <> #0 do
  1737.   begin
  1738.     while not (Text^ in [#0, #13, '|']) do
  1739.     begin
  1740.       if (Text^ in LeadBytes) and ((Text+1)^ <> #0) then
  1741.       begin
  1742.         Inc(Text);
  1743.         Inc(Col);
  1744.       end;
  1745.       Inc(Text);
  1746.       Inc(Col);
  1747.     end;
  1748.     if (Mark <> nil) and (Col > MaxLineLen) then
  1749.     begin
  1750.       P := Mark;
  1751.       while P^ = ' ' do Inc(P);
  1752.       StrMove(Mark + Indent + 2, P, StrLen(P) + 1);
  1753.       StrMove(Mark, #13#10'          ', Indent + 2);
  1754.       Inc(Text, Indent + 2 - (P - Mark));
  1755.       Col := Text - Mark - 2;
  1756.     end;
  1757.     case Text^ of
  1758.       #13:
  1759.       begin
  1760.         Inc(Text, 2);
  1761.         Mark := nil;
  1762.         Col := 0;
  1763.       end;
  1764.       '|':
  1765.       begin
  1766.         StrCopy(Text, Text + 1);
  1767.         Mark := Text;
  1768.       end;
  1769.     end;
  1770.   end;
  1771. end;
  1772.  
  1773. procedure DefineXMLDisplayBlock(AddIntf: IAddScriptElements; AComponent: TComponent;
  1774.   RowSetVarName: string);
  1775. var
  1776.   HTMLForm: IHTMLForm;
  1777.   FieldStatus: string;
  1778.   Names, Identifiers: string;
  1779.   Attributes: TStrings;
  1780.  
  1781.   function WrapParameters(const Decl: string; Indent: Integer): string;
  1782.   var
  1783.     Buffer: array[0..4096] of Char;
  1784.   begin
  1785.     if Length(Decl) < sizeof(Buffer)-100 then
  1786.     begin
  1787.       StrCopy(Buffer, PChar(Decl));
  1788.       Result := FormatText(Buffer, 0, Indent);
  1789.     end
  1790.     else
  1791.       Result := Decl;
  1792.   end;
  1793.  
  1794.   function FormatIdentifier(Field: IHTMLField): string;
  1795.   begin
  1796.     Result := Format('%0:s.%1:s', [HTMLForm.HTMLFormName, Field.HTMLControlName]);
  1797.   end;
  1798.  
  1799.   procedure TraverseSubComponents(AContainer: TComponent);
  1800.   var
  1801.     WebComponentContainer: IWebComponentContainer;
  1802.     ValidateFields: IValidateFields;
  1803.     I: Integer;
  1804.     DataSetField: IDataSetField;
  1805.     StatusField: IStatusField;
  1806.     Component: TComponent;
  1807.     S: string;
  1808.     ScriptComponent: IScriptComponent;
  1809.     SubComponents: TObject;
  1810.   begin
  1811.     if AContainer.GetInterface(IScriptComponent, ScriptComponent) then
  1812.     begin
  1813.       SubComponents := ScriptComponent.SubComponents;
  1814.       if Assigned(SubComponents) and SubComponents.GetInterface(IWebComponentContainer, WebComponentContainer) then
  1815.       begin
  1816.         if AContainer.GetInterface(IValidateFields, ValidateFields) then
  1817.           ValidateFields.ValidateFields(AddIntf);
  1818.         for I := 0 to WebComponentContainer.ComponentCount - 1 do
  1819.         begin
  1820.           Component := WebComponentContainer.Components[I];
  1821.           if Component.GetInterface(IStatusField, StatusField) then
  1822.           begin
  1823.             if FieldStatus <> '' then
  1824.               AddIntf.AddError(Format(sDuplicateStatusField, [Component.Name]))
  1825.             else
  1826.               FieldStatus := FormatIdentifier(StatusField);
  1827.           end
  1828.           else if Component.GetInterface(IDataSetField, DataSetField) then
  1829.           begin
  1830.             if DataSetField.FieldName <> '' then
  1831.             begin
  1832.               if Names <> '' then
  1833.                 Names := Names + ', |';
  1834.               Names := Names + Format('"%s"', [DataSetField.FieldName]);
  1835.               if Identifiers <> '' then
  1836.                 Identifiers := Identifiers + ', |';
  1837.               Identifiers := Identifiers + FormatIdentifier(DataSetField);
  1838.               S := DataSetField.GetRowSetFieldAttributes(
  1839.                 Format('%s.Fields.Field["%s"]', [RowSetVarName, DataSetField.FieldName]));
  1840.               if S <> '' then
  1841.                 Attributes.Add(S);
  1842.             end
  1843.           end
  1844.           else if Component.GetInterface(IScriptComponent, ScriptComponent) then
  1845.             TraverseSubComponents(Component);
  1846.         end;
  1847.       end;
  1848.     end;
  1849.   end;
  1850.  
  1851. var
  1852.   IdsVar, NamesVar: string;
  1853.   Component: TComponent;
  1854.   XMLDisplay: IXMLDisplay;
  1855.   XMLDisplayName: string;
  1856. begin
  1857.   AComponent.GetInterface(IXMLDisplay, XMLDisplay);
  1858.   Assert(Assigned(XMLDisplay), 'Component is not an XMLDisplay');
  1859.   XMLDisplayName := XMLDisplay.XMLDisplayName;
  1860.   FieldStatus := '';
  1861.   Attributes := TStringList.Create;
  1862.   try
  1863.     Component := AComponent;
  1864.     while Assigned(Component) do
  1865.     begin
  1866.       if not Assigned(HTMLForm) then
  1867.         Component.GetInterface(IHTMLForm, HTMLForm);
  1868.       Component := Component.GetParentComponent;
  1869.     end;
  1870.     Assert(Assigned(HTMLForm), 'HTMLForm not found');
  1871.     TraverseSubComponents(AComponent);
  1872.     if Identifiers <> '' then
  1873.     begin
  1874.       AddIntf.AddVar(HTMLForm.HTMLFormVarName,
  1875.         Format('var %0:s = document.forms[''%1:s''];'#13#10, [HTMLForm.HTMLFormVarName, HTMLForm.HTMLFormName]));
  1876.       NamesVar := Format(ScriptNamesVar, [AComponent.Name]);
  1877.       AddIntf.AddVar(NamesVar, WrapParameters(Format('var %0:s = new Array(%1:s);'#13#10, [NamesVar, Names]), 4));
  1878.       IDsVar := Format(ScriptIDsVar, [AComponent.Name]);
  1879.       AddIntf.AddVar(IdsVar, WrapParameters(Format('var %0:s = new Array(%1:s);'#13#10, [IDsVar, Identifiers]), 4));
  1880.       Attributes.Text := TrimRight(Attributes.Text);
  1881.       if Attributes.Count > 0 then
  1882.         AddIntf.AddScriptBlock('', Attributes.Text);
  1883.       if FieldStatus = '' then FieldStatus := 'null';
  1884.       AddIntf.AddVar(XMLDisplayName,
  1885.         Format('var %0:s = new xmlDisplay(%1:s, %2:s, %3:s, %4:s);'#13#10,
  1886.           [XMLDisplayName, RowSetVarName,
  1887.             Format(ScriptIDsVar, [AComponent.Name]),
  1888.             Format(ScriptNamesVar, [AComponent.Name]),
  1889.             FieldStatus]));
  1890.     end;
  1891.   finally
  1892.     Attributes.Free;
  1893.   end;
  1894. end;
  1895.  
  1896. procedure TWebForm.ImplAddElements(AddIntf: IAddScriptElements);
  1897. begin
  1898.   inherited;
  1899. end;
  1900.  
  1901. function TWebForm.GetVisibleFields: TWebComponentList;
  1902. begin
  1903.   Result := FWebComponents
  1904. end;
  1905.  
  1906. procedure TWebForm.GetChildren(Proc: TGetChildProc; Root: TComponent);
  1907. var
  1908.   I: Integer;
  1909.   WebComponent: TComponent;
  1910. begin
  1911.   for I := 0 to FWebComponents.Count - 1 do
  1912.   begin
  1913.     WebComponent := FWebComponents.WebComponents[I];
  1914.     if WebComponent.Owner = Root then Proc(WebComponent);
  1915.   end;
  1916. end;
  1917.  
  1918. procedure TWebForm.SetChildOrder(Component: TComponent;
  1919.   Order: Integer);
  1920. var
  1921.   Intf: IWebComponent;
  1922. begin
  1923.   if FWebComponents.IndexOf(Component) >= 0 then
  1924.     if Component.GetInterface(IWebComponent, Intf) then
  1925.       Intf.Index := Order
  1926.     else
  1927.       Assert(False, 'Interface not supported');
  1928. end;
  1929.  
  1930. function TWebForm.GetSubComponents: TObject;
  1931. begin
  1932.   Result := WebComponents;
  1933. end;
  1934.  
  1935. function TWebForm.GetComponentList: TObject;
  1936. begin
  1937.   Result := FWebComponents;
  1938. end;
  1939.  
  1940. function TWebForm.GetDefaultComponentList: TObject;
  1941. begin
  1942.   Assert(False, 'Form does not support DefaultComponents');
  1943.   Result := nil;
  1944. end;
  1945.  
  1946. procedure TWebForm.AddElements(AddIntf: IAddScriptElements);
  1947. begin
  1948.   inherited;
  1949.   ImplAddElements(AddIntf);
  1950. end;
  1951.  
  1952. function TWebForm.GetHTMLFormName: string;
  1953. begin
  1954.   Result := Self.Name;
  1955. end;
  1956.  
  1957. function TWebForm.GetLayoutAttributes: TLayoutAttributes;
  1958. begin
  1959.   with FLayoutAttributes do
  1960.   begin
  1961.     ControlAttributes := '';
  1962.     AddQuotedAttrib(ControlAttributes, 'STYLE', Style);
  1963.     AddQuotedAttrib(ControlAttributes, 'CLASS', StyleRule);
  1964.     AddCustomAttrib(ControlAttributes, Custom);
  1965.   end;
  1966.   Result := FLayoutAttributes;
  1967. end;
  1968.  
  1969. function TWebForm.GetHTMLFormVarName: string;
  1970. begin
  1971.   Result := Self.Name;
  1972. end;
  1973.  
  1974. { TDataForm }
  1975. function TDataForm.GetHTMLFormTag(Options: TWebContentOptions): string;
  1976. var
  1977.   Attribs: string;
  1978. begin
  1979.   AddStringAttrib(Attribs, 'NAME', GetHTMLFormName);
  1980.   AddQuotedAttrib(Attribs, 'STYLE', Style);
  1981.   AddQuotedAttrib(Attribs, 'CLASS', StyleRule);
  1982.   AddCustomAttrib(Attribs, Custom);
  1983.   Result :=
  1984.     Format(#13#10'<FORM%s>', [Attribs]);
  1985. end;
  1986.  
  1987. function TDataForm.ImplCanAddClass(AParent: TComponent; AClass: TClass): Boolean;
  1988. begin
  1989.   Result :=
  1990.     AClass.InheritsFrom(TCustomDataGrid) or
  1991.     AClass.InheritsFrom(TCustomDataNavigator) or
  1992.     AClass.InheritsFrom(TFieldGroup) or
  1993.     AClass.InheritsFrom(TCustomLayoutGroup) or
  1994.     CanAddClassHelper(Self, AParent, AClass);
  1995. end;
  1996.  
  1997. { TFormLayout}
  1998.  
  1999. constructor TFormLayout.Create(AParentLayout: TLayout);
  2000. begin
  2001.   inherited;
  2002.   FInTable := False;
  2003.   FInRow := False;
  2004.   FColumnCount := 1;
  2005.   FColumnIndex := 0;
  2006.   FTableHeader := #13#10'<TABLE>';
  2007.   FLayoutState := lsUnknown;
  2008.   FBreakButtons := False;
  2009. end;
  2010.  
  2011. function TFormLayout.ImplLayoutButton(const HTMLButton: string; Attributes: TLayoutAttributes): string;
  2012. begin
  2013.   Result := StartButtons;
  2014.   if FBreakButtons then
  2015.     Result := Format('%s>%s</TD>', [Result, HTMLButton])
  2016.   else if FButtonIndex = 1 then
  2017.     Result := Format('%s>%s', [Result, HTMLButton])
  2018.   else
  2019.     Result := Result + HTMLButton;
  2020. end;
  2021.  
  2022. function TFormLayout.ImplLayoutField(const HTMLField: string; Attributes: TLayoutAttributes): string;
  2023. begin
  2024.   if Assigned(Attributes) then
  2025.     Result := StartFields(1) + Format('%0:s>%1:s</TD>'#13#10, [Attributes.ControlAttributes, HTMLField])
  2026.   else
  2027.     Result := StartFields(1) + Format('>%0:s</TD>'#13#10, [HTMLField]);
  2028. end;
  2029.  
  2030. function TFormLayout.ImplLayoutLabelAndField(const HTMLLabel, HTMLField: string; Attributes: TLayoutAttributes): string;
  2031. begin
  2032.   if Assigned(Attributes) then
  2033.     case Attributes.LabelPosition of
  2034.       lposLeft:
  2035.         Result :=
  2036.           StartFields(2) + Format('%0:s>%1:s</TD><TD %2:s>%3:s</TD>'#13#10,
  2037.             [Attributes.LabelAttributes, HTMLLabel, Attributes.ControlAttributes, HTMLField]);
  2038.       lposRight:
  2039.         Result :=
  2040.           StartFields(2) + Format('%0:s>%1:s</TD><TD %2:s>%3:s</TD>'#13#10,
  2041.             [Attributes.ControlAttributes, HTMLField, Attributes.LabelAttributes, HTMLLabel]);
  2042.       lposAbove:
  2043.         Result :=
  2044.           StartFields(1) + Format('%0:s>%1:s</TD></TR><TR><TD COLSPAN = 2 %2:s>%3:s</TD>'#13#10,
  2045.             [Attributes.LabelAttributes, HTMLLabel, Attributes.ControlAttributes, HTMLField]);
  2046.       lposBelow:
  2047.         Result :=
  2048.           StartFields(1) + Format('%0:s>%1:s</TD></TR><TR><TD COLSPAN=2 %2:s>%3:s</TD>'#13#10,
  2049.             [Attributes.ControlAttributes, HTMLField, Attributes.LabelAttributes, HTMLLabel]);
  2050.     else
  2051.       Assert(False, 'Unknown position');
  2052.     end
  2053.   else
  2054.     Result :=
  2055.         StartFields(2) + Format('>%0:s</TD><TD>%1:s</TD>'#13#10,
  2056.           [HTMLLabel, HTMLField])
  2057. end;
  2058.  
  2059. function TFormLayout.ImplLayoutTable(const HTMLTable: string; Attributes: TLayoutAttributes): string;
  2060. begin
  2061.   Result := ImplLayoutField(HTMLTable, Attributes);
  2062. end;
  2063.  
  2064. function TFormLayout.StartFields(ColCount: Integer): string;
  2065. begin
  2066.   Result := EndButtons;
  2067.   FLayoutState := lsFields;
  2068.   Result := Result + StartTable + StartRow + NextColumn(ColCount);
  2069. end;
  2070.  
  2071. function TFormLayout.NextColumn(SubItemCount: Integer): string;
  2072.  
  2073.   function SpanAll: string;
  2074.   begin
  2075.     Result := Format('<TD COLSPAN=%d', [FColumnCount * 2]);
  2076.   end;
  2077.  
  2078.   function SpanCalc: string;
  2079.   var
  2080.     Span: Integer;
  2081.   begin
  2082.     Span := -1;
  2083.     if SubItemCount = 1 then
  2084.       Span := 2;
  2085.     if Span <> -1 then
  2086.       Result := Format('<TD COLSPAN=%d', [Span])
  2087.     else
  2088.       Result := '<TD';
  2089.   end;
  2090. begin
  2091.   Result := '';
  2092.   if (FLayoutState = lsButtons) and (not FBreakButtons) and (FButtonIndex = 0) then
  2093.     Result := Format('%s', [SpanAll])
  2094.   else if (FLayoutState <> lsButtons) or FBreakButtons then
  2095.   begin
  2096.     if FColumnIndex = FColumnCount then
  2097.       Result := Format('%s%s%s', [EndRow, StartRow, SpanCalc])
  2098.     else
  2099.       Result := SpanCalc;
  2100.     Inc(FColumnIndex);
  2101.   end;
  2102.   if FLayoutState = lsButtons then
  2103.     Inc(FButtonIndex);
  2104. end;
  2105.  
  2106. function TFormLayout.StartRow: string;
  2107. begin
  2108.   if not FInRow then
  2109.   begin
  2110.     Result := '<TR>';
  2111.     FInRow := True;
  2112.   end
  2113.   else
  2114.     Result := '';
  2115. end;
  2116.  
  2117.  
  2118. function TFormLayout.EndRow: string;
  2119. begin
  2120.   if FInRow then
  2121.   begin
  2122.     Result := '</TR>';
  2123.     FColumnIndex := 0;
  2124.     FInRow := False;
  2125.   end
  2126.   else
  2127.     Result := '';
  2128. end;
  2129.  
  2130. function TFormLayout.EndTable: string;
  2131. begin
  2132.   if FInTable then
  2133.   begin
  2134.     Result := EndRow + '</TABLE>';
  2135.     FInTable := False;
  2136.   end
  2137.   else
  2138.     Result := '';
  2139. end;
  2140.  
  2141. function TFormLayout.EndLayout: string;
  2142. begin
  2143.   Result := EndFields + EndButtons + EndTable;
  2144. end;
  2145.  
  2146. function TFormLayout.StartTable: string;
  2147. begin
  2148.   if not FInTable then
  2149.   begin
  2150.     Result := FTableHeader;
  2151.     FInTable := True;
  2152.   end
  2153.   else
  2154.     Result := '';
  2155. end;
  2156.  
  2157. function TFormLayout.StartButtons: string;
  2158. begin
  2159.   if FLayoutState <> lsButtons then
  2160.     FButtonIndex := 0;
  2161.   Result := EndFields;
  2162.   FLayoutState := lsButtons;
  2163.   Result := Result + StartTable + StartRow + NextColumn(1);
  2164. end;
  2165.  
  2166. function TFormLayout.EndButtons: string;
  2167. begin
  2168.   Result := '';
  2169.   if FLayoutState = lsButtons then
  2170.   begin
  2171.     if not FBreakButtons then
  2172.       Result := EndRow;
  2173.     FLayoutState := lsUnknown;
  2174.   end;
  2175. end;
  2176.  
  2177. function TFormLayout.EndFields: string;
  2178. begin
  2179.   Result := '';
  2180.   if FLayoutState = lsFields then
  2181.   begin
  2182.     if not FBreakButtons then
  2183.       Result := EndRow;
  2184.     FLayoutState := lsUnknown;
  2185.   end;
  2186. end;
  2187.  
  2188. { TDataForm }
  2189.  
  2190. function TDataForm.ImplContent(Options: TWebContentOptions; ParentLayout: TLayout): string;
  2191. var
  2192.   FormLayout: TFormLayout;
  2193.  
  2194.   function FormatField(Field: TComponent): string;
  2195.   var
  2196.     Intf: IWebContent;
  2197.   begin
  2198.     if Field.GetInterface(IWebContent, Intf) then
  2199.       Result := Intf.Content(Options, FormLayout)
  2200.     else
  2201.       Result := '';
  2202.   end;
  2203.  
  2204. var
  2205.   I: Integer;
  2206.   Intf: ILayoutWebContent;
  2207. begin
  2208.   FormLayout := TFormLayout.Create(ParentLayout);
  2209.   try
  2210.     Result := GetHTMLFormTag(Options);
  2211.     for I := 0 to VisibleFields.Count - 1 do
  2212.       Result := Result + FormatField(VisibleFields[I]);
  2213.     Result := Result + FormLayout.EndLayout;
  2214.     Result := Result + '</FORM>';
  2215.     if Assigned(ParentLayout) and ParentLayout.GetInterface(ILayoutWebContent, Intf) then
  2216.       Result := Intf.LayoutField(Result, GetLayoutAttributes)
  2217.   finally
  2218.     FormLayout.Free;
  2219.   end;
  2220. end;
  2221.  
  2222. { TDataSetWrapper }
  2223.  
  2224. procedure TDataSetWrapper.AddOnDataChange(const Value: TNotifyEvent);
  2225. var
  2226.   I: Integer;
  2227. begin
  2228.   for I := 0 to Length(FOnDataChange) - 1 do
  2229.     if not Assigned(FOnDataChange[I]) then
  2230.     begin
  2231.       FOnDataChange[I] := Value;
  2232.       Exit;
  2233.     end;
  2234.   I := Length(FOnDataChange);
  2235.   SetLength(FOnDataChange, I+1);
  2236.   FOnDataChange[I] := Value;
  2237. end;
  2238.  
  2239. constructor TDataSetWrapper.Create;
  2240. begin
  2241.   inherited;
  2242.   FDataSet := TClientDataSetEvent.Create(nil);
  2243.   FDataSet.FOnDataChange := OnDataChange;
  2244. end;
  2245.  
  2246. destructor TDataSetWrapper.Destroy;
  2247. begin
  2248.   inherited;
  2249.   FreeAndNil(FDataSet);
  2250. end;
  2251.  
  2252. procedure TDataSetWrapper.FetchParams;
  2253. begin
  2254.   FDataSet.FetchParams;
  2255. end;
  2256.  
  2257. function TDataSetWrapper.FieldCount: Integer;
  2258. begin
  2259.   Result := FDetailDataSet.FieldCount;
  2260. end;
  2261.  
  2262. function TDataSetWrapper.Fields: TFields;
  2263. begin
  2264.   Result := FDetailDataSet.Fields;
  2265. end;
  2266.  
  2267. function TDataSetWrapper.ParamCount: Integer;
  2268. begin
  2269.   Result := FDataSet.Params.Count;
  2270. end;
  2271.  
  2272. function TDataSetWrapper.Params: TParams;
  2273. begin
  2274.   Result := FDataSet.Params;
  2275. end;
  2276.  
  2277. procedure TDataSetWrapper.RemoveOnDataChange(const Value: TNotifyEvent);
  2278. var
  2279.   I: Integer;
  2280.   P: TNotifyEvent;
  2281. begin
  2282.   for I := 0 to Length(FOnDataChange) - 1 do
  2283.   begin
  2284.     P := FOnDataChange[I];
  2285.     if (TMethod(P).Code = TMethod(Value).Code) and
  2286.       (TMethod(P).Data = TMethod(Value).Data) then
  2287.       FOnDataChange[I] := nil;
  2288.   end;
  2289. end;
  2290.  
  2291. procedure TDataSetWrapper.OnDataChange(Sender: TObject);
  2292. var
  2293.   I: Integer;
  2294. begin
  2295.   Assert(Assigned(FDataSet));
  2296.   for I := 0 to Length(FOnDataChange) - 1 do
  2297.   begin
  2298.     if Assigned(FOnDataChange[I]) then
  2299.       FOnDataChange[I](Sender);
  2300.     if not Assigned(FDataSet) then Break;
  2301.   end;
  2302. end;
  2303.  
  2304. { TXMLDisplayReferenceGroup }
  2305.  
  2306. constructor TXMLDisplayReferenceGroup.Create(AOwner: TComponent);
  2307. begin
  2308.   inherited;
  2309.   FXMLDisplay := TXMLDisplay.Create(Self);
  2310. end;
  2311.  
  2312. destructor TXMLDisplayReferenceGroup.Destroy;
  2313. begin
  2314.   inherited;
  2315.   FXMLDisplay.Free;
  2316. end;
  2317.  
  2318. function TXMLDisplayReferenceGroup.GetXMLDisplayComponent: TComponent;
  2319. begin
  2320.   Result := XMLDisplay.DisplayComponent;
  2321. end;
  2322.  
  2323. procedure TXMLDisplayReferenceGroup.SetXMLDisplayComponent(
  2324.   const Value: TComponent);
  2325. begin
  2326.   FXMLDisplay.DisplayComponent := Value;
  2327. end;
  2328.  
  2329. procedure TXMLDisplayReferenceGroup.Notification(AComponent: TComponent;
  2330.   Operation: TOperation);
  2331. begin
  2332.   inherited Notification(AComponent, Operation);
  2333.   if Assigned(FXMLDisplay) then
  2334.     FXMLDisplay.Notification(AComponent, Operation);
  2335. end;
  2336.  
  2337. procedure TXMLDisplayReferenceGroup.ImplAddElements(
  2338.   AddIntf: IAddScriptElements);
  2339. begin
  2340.   inherited;
  2341.   if XMLComponent = nil then
  2342.     AddIntf.AddError(Format(sXMLComponentNotDefined, [Self.Name]));
  2343. end;
  2344.  
  2345. { TCustomDataNavigator }
  2346.  
  2347. function TCustomDataNavigator.ImplContent(Options: TWebContentOptions; ParentLayout: TLayout): string;
  2348. var
  2349.   ButtonsLayout: TFormLayout;
  2350.  
  2351.   function FormatButton(Button: TComponent): string;
  2352.   var
  2353.     Intf: IWebContent;
  2354.   begin
  2355.     Result := '';
  2356.     if Button.GetInterface(IWebContent, Intf) then
  2357.       Result := Intf.Content(Options, ButtonsLayout);
  2358.   end;
  2359. var
  2360.   Button: TComponent;
  2361.   I: Integer;
  2362.   Intf: ILayoutWebContent;
  2363.   Attribs: string;
  2364. begin
  2365.   Result := '';
  2366.   ButtonsLayout := TFormLayout.Create(ParentLayout);
  2367.   try
  2368.     // AddStringAttrib(Attribs, 'NAME', Name);
  2369.     AddQuotedAttrib(Attribs, 'STYLE', Style);
  2370.     AddQuotedAttrib(Attribs, 'CLASS', StyleRule);
  2371.     AddCustomAttrib(Attribs, Custom);
  2372.     ButtonsLayout.FTableHeader := Format(#13#10'<TABLE%s>', [Attribs]);
  2373.     for I := 0 to VisibleButtons.Count - 1 do
  2374.     begin
  2375.       Button := VisibleButtons.WebComponents[I];
  2376.       Result := Result + FormatButton(Button);
  2377.     end;
  2378.     Result := Result + ButtonsLayout.EndLayout;
  2379.   finally
  2380.     ButtonsLayout.Free;
  2381.   end;
  2382.   if Assigned(ParentLayout) and ParentLayout.GetInterface(ILayoutWebContent, Intf) then
  2383.     Result := Intf.LayoutTable(Result, nil)
  2384. end;
  2385.  
  2386.  
  2387. procedure CreateDefaultButtonClasses(
  2388.   Classes: array of TWebButtonClass; Container: TWebComponentList);
  2389. var
  2390.   Button: TWebButton;
  2391.   I: Integer;
  2392.   Intf: IWebComponent;
  2393. begin
  2394.   for I := 0 to High(Classes) do
  2395.   begin
  2396.     Button := Classes[I].Create(nil); // Not owned
  2397.     Button.GetInterface(IWebComponent, Intf);
  2398.     Intf.Container := Container;
  2399.   end;
  2400. end;
  2401.  
  2402. const
  2403.   DefaultFormButtons: array[0..8] of TWebButtonClass =
  2404.   (TFirstButton, TPriorButton, TNextButton,
  2405.   TLastButton, TInsertButton, TDeleteButton,
  2406.   TUndoButton, TPostButton, TApplyUpdatesButton);
  2407.  
  2408.   DefaultGridButtons: array[0..10] of TWebButtonClass =
  2409.   (TFirstButton, TPriorPageButton, TPriorButton, TNextButton,
  2410.   TNextPageButton, TLastButton, TInsertButton, TDeleteButton,
  2411.   TUndoButton, TPostButton, TApplyUpdatesButton);
  2412.  
  2413. procedure TCustomDataNavigator.GetDefaultButtons;
  2414. var
  2415.   XMLDisplay: TComponent;
  2416.   Intf: IXMLDisplay;
  2417.   Count: Integer;
  2418.   Grid: Boolean;
  2419. begin
  2420.   Grid := False;
  2421.   XMLDisplay := GetXMLDisplayComponent;
  2422.   if Assigned(XMLDisplay) then
  2423.     if XMLDisplay.GetInterface(IXMLDisplay, Intf) then
  2424.       Grid := Intf.IsMultipleRecordView;
  2425.   if Grid then
  2426.     Count := Length(DefaultGridButtons)
  2427.   else
  2428.     Count := Length(DefaultFormButtons);
  2429.   if Assigned(DefaultWebComponents) and
  2430.     (DefaultWebComponents.Count <> Count) then
  2431.   begin
  2432.     DefaultWebComponents.Free;
  2433.     DefaultWebComponents := nil;
  2434.   end;
  2435.   if not Assigned(DefaultWebComponents) then
  2436.   begin
  2437.     DefaultWebComponents := TWebComponentList.Create(Self);
  2438.     if Grid then
  2439.       CreateDefaultButtonClasses(DefaultGridButtons, WebFieldControls)
  2440.     else
  2441.       CreateDefaultButtonClasses(DefaultFormButtons, WebFieldControls)
  2442.   end;
  2443. end;
  2444.  
  2445. function TCustomDataNavigator.VisibleButtons: TWebComponentList;
  2446. begin
  2447.   if WebFieldControls.Count > 0 then
  2448.     Result := WebFieldControls
  2449.   else
  2450.   begin
  2451.     GetDefaultButtons;
  2452.     Result := DefaultWebComponents;
  2453.   end;
  2454. end;
  2455.  
  2456. function TCustomDataNavigator.ImplCanAddClass(AParent: TComponent; AClass: TClass): Boolean;
  2457. var
  2458.   I: Integer;
  2459. begin
  2460.   if AClass.InheritsFrom(TDataSetButton) or
  2461.     AClass.InheritsFrom(TXMLButton) then
  2462.   begin
  2463.     Result := True;
  2464.     // Don't allow duplicates
  2465.     for I := 0 to WebFieldControls.Count - 1 do
  2466.       if WebFieldControls.WebComponents[I].ClassType = AClass then
  2467.       begin
  2468.         Result := False;
  2469.         break;
  2470.       end
  2471.   end
  2472.   else
  2473.     Result := AClass.InheritsFrom(TCustomLayoutGroup) or
  2474.       CanAddClassHelper(Self, AParent, AClass);
  2475. end;
  2476.  
  2477. function TCustomDataNavigator.ImplGetSubComponents: TObject;
  2478. begin
  2479.   Result := VisibleButtons;
  2480. end;
  2481.  
  2482. { TWebDataDisplay }
  2483.  
  2484. function TWebDataDisplay.GetContainer: TWebComponentContainer;
  2485. begin
  2486.   Result := FWebComponents;
  2487. end;
  2488.  
  2489. function TWebDataDisplay.GetIndex: Integer;
  2490. begin
  2491.   Result := FWebComponents.IndexOf(Self);
  2492. end;
  2493.  
  2494. procedure TWebDataDisplay.SetContainer(Container: TWebComponentContainer);
  2495. begin
  2496.   SetWebParent((Container as TWebComponentList).ParentComponent);
  2497. end;
  2498.  
  2499. procedure TWebDataDisplay.SetIndex(Value: Integer);
  2500. begin
  2501.   FWebComponents.SetComponentIndex(Self, Value)
  2502. end;
  2503.  
  2504. function TWebDataDisplay.GetParentComponent: TComponent;
  2505. begin
  2506.   if FWebParent <> nil then
  2507.     Result := FWebParent else
  2508.     Result := inherited GetParentComponent;
  2509. end;
  2510.  
  2511. function TWebDataDisplay.HasParent: Boolean;
  2512. begin
  2513.   if FWebParent <> nil then
  2514.     Result := True else
  2515.     Result := inherited HasParent;
  2516. end;
  2517.  
  2518. procedure TWebDataDisplay.ReadState(Reader: TReader);
  2519. begin
  2520.   inherited ReadState(Reader);
  2521.   SetWebParent(Reader.Parent);
  2522. end;
  2523.  
  2524. procedure TWebDataDisplay.SetParentComponent(AParent: TComponent);
  2525. begin
  2526.   if not (csLoading in ComponentState) then
  2527.     SetWebParent(AParent);
  2528. end;
  2529.  
  2530. procedure TWebDataDisplay.SetWebParent(Value: TComponent);
  2531. var
  2532.   List: IGetWebComponentList;
  2533. begin
  2534.   if Value <> FWebParent then
  2535.   begin
  2536.     if Assigned(Value) and (csDesigning in ComponentState) then
  2537.       ValidateWebParent(Self, Value);
  2538.     if FWebParent <> nil then
  2539.     begin
  2540.       FWebParent.GetInterface(IGetWebComponentList, List);
  2541.       if FDefaultField then
  2542.         (List.GetDefaultComponentList as TWebComponentList).Remove(Self)
  2543.       else
  2544.         (List.GetComponentList as TWebComponentList).Remove(Self)
  2545.     end;
  2546.     if Value <> nil then
  2547.     begin
  2548.       Value.GetInterface(IGetWebComponentList, List);
  2549.       if FDefaultField then
  2550.         (List.GetDefaultComponentList as TWebComponentList).Add(Self)
  2551.       else
  2552.         (List.GetComponentList as TWebComponentList).Add(Self)
  2553.     end;
  2554.     FWebParent := Value;
  2555.   end;
  2556. end;
  2557.  
  2558. constructor TWebDataDisplay.Create(AOwner: TComponent);
  2559. begin
  2560.   inherited;
  2561.   FDefaultField := AOwner = nil;
  2562.   FTabIndex := -1;
  2563.   FCaptionAttributes := TCaptionAttributes.Create(Self);
  2564.   FLayoutAttributes := TLayoutAttributes.Create;
  2565.   FCaptionPosition := capLeft;
  2566. end;
  2567.  
  2568. destructor TWebDataDisplay.Destroy;
  2569. begin
  2570.   inherited;
  2571.   if FWebComponents <> nil then
  2572.     FWebComponents.Remove(Self);
  2573.   FCaptionAttributes.Free;
  2574.   FLayoutAttributes.Free;
  2575. end;
  2576.  
  2577. procedure TWebDataDisplay.SetComponentList(List: TObject);
  2578. begin
  2579.   Assert((List = nil) or (List is TWebComponentList));
  2580.   FWebComponents := TWebComponentList(List);
  2581. end;
  2582.  
  2583. function TWebDataDisplay.Content(Options: TWebContentOptions; ParentLayout: TLayout): string;
  2584. begin
  2585.   Result := ImplContent(Options, ParentLayout);
  2586. end;
  2587.  
  2588. function TWebDataDisplay.GetCaption: string;
  2589. begin
  2590.   Result := FCaption;
  2591. end;
  2592.  
  2593. function TWebDataDisplay.EventContent(Options: TWebContentOptions): string;
  2594. begin
  2595.   Result := '';
  2596. end;
  2597.  
  2598. function TWebDataDisplay.GetXmlDisplayName: string;
  2599. var
  2600.   Component: TComponent;
  2601.   Intf: IXMLDisplay;
  2602. begin
  2603.   Component := Self;
  2604.   while Assigned(Component) and
  2605.     (not Component.GetInterface(IXMLDisplay, Intf)) do
  2606.     Component := Component.GetParentComponent;
  2607.   if Assigned(Component) then
  2608.     Result := Intf.XmlDisplayName;
  2609. end;
  2610.  
  2611. function TWebDataDisplay.GetXmlRowSetName: string;
  2612. var
  2613.   Component: TComponent;
  2614.   Intf: IXMLDisplay;
  2615. begin
  2616.   Component := Self;
  2617.   while Assigned(Component) and
  2618.     (not Component.GetInterface(IXMLDisplay, Intf)) do
  2619.     Component := Component.GetParentComponent;
  2620.   if Assigned(Component) then
  2621.     Result := Intf.XmlRowSetName;
  2622. end;
  2623.  
  2624. function TWebDataDisplay.GetHTMLForm: IHTMLForm;
  2625. var
  2626.   Component: TComponent;
  2627. begin
  2628.   Result := nil;
  2629.   Component := GetParentComponent;
  2630.   while Assigned(Component) and
  2631.     (not Component.GetInterface(IHTMLForm, Result)) do
  2632.     Component := Component.GetParentComponent;
  2633. end;
  2634.  
  2635. function TWebDataDisplay.ImplContent(Options: TWebContentOptions;
  2636.   ParentLayout: TLayout): string;
  2637. var
  2638.   Intf: ILayoutWebContent;
  2639. begin
  2640.   if Assigned(ParentLayout) and ParentLayout.GetInterface(ILayoutWebContent, Intf) then
  2641.     Result := Intf.LayoutLabelAndField(LabelContent, ControlContent(Options),
  2642.       GetLayoutAttributes)
  2643.   else
  2644.     Result := LabelContent + ControlContent(Options);
  2645. end;
  2646.  
  2647. procedure TWebDataDisplay.SetCaptionAttributes(
  2648.   const Value: TCaptionAttributes);
  2649. begin
  2650.   FCaptionAttributes.Assign(Value);
  2651. end;
  2652.  
  2653. function TWebDataDisplay.FormatCaption: string;
  2654. var
  2655.   Attribs: string;
  2656. begin
  2657.   AddQuotedAttrib(Attribs, 'STYLE', CaptionAttributes.Style);
  2658.   AddCustomAttrib(Attribs, CaptionAttributes.Custom);
  2659.   AddQuotedAttrib(Attribs, 'CLASS', CaptionAttributes.StyleRule);
  2660.   LayoutAttributes.LabelAttributes := Attribs;
  2661.   case CaptionPosition of
  2662.     capLeft: LayoutAttributes.LabelPosition := lposLeft;
  2663.     capRight: LayoutAttributes.LabelPosition := lposRight;
  2664.     capAbove: LayoutAttributes.LabelPosition := lposAbove;
  2665.     capBelow: LayoutAttributes.LabelPosition := lposBelow;
  2666.   else
  2667.     Assert(False, 'Unknown position');
  2668.   end;
  2669.   if Attribs <> '' then
  2670.     Result := Format('<SPAN%0:s>%1:s</SPAN>', [Attribs, Caption])
  2671.   else
  2672.     Result := Caption;
  2673. end;
  2674.  
  2675. function TWebDataDisplay.LabelContent: string;
  2676. begin
  2677.   Result := FormatCaption;
  2678. end;
  2679.  
  2680. function TWebDataDisplay.GetLayoutAttributes: TLayoutAttributes;
  2681. begin
  2682.   Result := FLayoutAttributes;
  2683. end;
  2684.  
  2685. class function TWebDataDisplay.IsColumn: Boolean;
  2686. begin
  2687.   Result := False;
  2688. end;
  2689.  
  2690. class function TWebDataDisplay.IsQueryField: Boolean;
  2691. begin
  2692.   Result := False;
  2693. end;
  2694.  
  2695. function TWebDataDisplay.GetHTMLControlName: string;
  2696. begin
  2697.   Result := ImplGetHTMLControlName;
  2698. end;
  2699.  
  2700. function TWebDataDisplay.ImplGetHTMLControlName: string;
  2701. begin
  2702.   Result := Name;
  2703. end;
  2704.  
  2705. procedure TWebDataDisplay.SetCaption(Value: string);
  2706. begin
  2707.   FCaption := Value;
  2708. end;
  2709.  
  2710. { TWebDataInput }
  2711.  
  2712. procedure TWebDataInput.SetFieldName(Value: string);
  2713. var
  2714.   Intf: IValidateFields;
  2715.   Component: TComponent;
  2716. begin
  2717.   if (AnsiCompareText(Value, FFieldName) <> 0) then
  2718.   begin
  2719.     FFieldName := Value;
  2720.     if (FCaption = Value) then FCaption := '';
  2721.     if Assigned(FWebParent) and
  2722.       not (csLoading in ComponentState) and (Length(Value) > 0) then
  2723.       RestoreDefaults;
  2724.     if [csLoading, csDesigning] * ComponentState <> [] then
  2725.     begin
  2726.       Component := GetParentComponent;
  2727.       while Assigned(Component) and
  2728.        (not Component.GetInterface(IValidateFields, Intf)) do
  2729.        Component := Component.GetParentComponent;
  2730.       if Assigned(Component) then
  2731.         Intf.EnableValidateFields := True;
  2732.     end;
  2733.   end;
  2734. end;
  2735.  
  2736. function TWebDataInput.ImplGetHTMLControlName: string;
  2737.   function CrunchFieldName(const FieldName: string): string;
  2738.   var
  2739.     I: Integer;
  2740.   begin
  2741.     Result := FieldName;
  2742.     I := 1;
  2743.     while I <= Length(Result) do
  2744.     begin
  2745.       if Result[I] in ['A'..'Z','a'..'z','_','0'..'9'] then
  2746.         Inc(I)
  2747.       else if Result[I] in LeadBytes then
  2748.         Delete(Result, I, 2)
  2749.       else
  2750.         Delete(Result, I, 1);
  2751.     end;
  2752.   end;
  2753.  
  2754. begin
  2755.   if IsQueryField then
  2756.   begin
  2757.     Result := ParamName;
  2758.     if Result = '' then
  2759.     begin
  2760.       Result := FieldName;
  2761.       if Result = '' then
  2762.         Result := Name;
  2763.     end;
  2764.   end
  2765.   else
  2766.   begin
  2767.     Result := Name;
  2768.     if Result = '' then
  2769.     begin
  2770.       Result := Format('%s_%s', [GetParentComponent.Name, CrunchFieldName(FieldName)]);
  2771.     end;
  2772.   end
  2773. end;
  2774.  
  2775. function TWebDataInput.GetCaption: string;
  2776. begin
  2777.   if FCaption = '' then
  2778.   begin
  2779.     Result := FFieldName;
  2780.     if Result = '' then
  2781.       Result := ParamName;
  2782.     if Result = '' then
  2783.       Result := Name;
  2784.   end
  2785.   else
  2786.     Result := FCaption;
  2787. end;
  2788.  
  2789. procedure TWebDataInput.SetCaption(Value: string);
  2790. begin
  2791.   if Value = FFieldName then Value := '';
  2792.   inherited SetCaption(Value);
  2793. end;
  2794.  
  2795. function TWebDataInput.EventContent(Options: TWebContentOptions): string;
  2796. var
  2797.   XMLDisplayName: string;
  2798. begin
  2799.   Result := '';
  2800.   if not IsQueryField then
  2801.   begin
  2802.     XMLDisplayName := GetXmlDisplayName;
  2803.     Result := Result +
  2804.       Format(' onFocus=''if(%s)%s.xfocus(this);''', [sXMLReadyVar, XMLDisplayName]);
  2805.     Result := Result +
  2806.       Format(' onkeydown=''if(%s)%s.keys(this);''', [sXMLReadyVar, XMLDisplayName]);
  2807.   end;
  2808. end;
  2809.  
  2810. procedure TWebDataInput.ImplRestoreDefaults;
  2811. var
  2812.   Field: TField;
  2813.   DataSet: IMidasWebDataSet;
  2814.   XMLDataSet: TXMLDataSetParent;
  2815. begin
  2816.   XMLDataSet := TXMLDataSetParent.Create(Self);
  2817.   try
  2818.     XMLDataSet.UseParent := True;
  2819.     DataSet := XMLDataSet.DataSet;
  2820.   finally
  2821.     XMLDataSet.Free;
  2822.   end;
  2823.   if not Assigned(DataSet) then
  2824.     Exit;
  2825.   Field := FindAssociatedField(DataSet);
  2826.   RestoreFieldDefaults(Field);
  2827. end;
  2828.  
  2829. function TWebDataInput.FindAssociatedField(DataSet: IMidasWebDataSet): TField;
  2830. begin
  2831.   if FieldName <> '' then
  2832.     Result := DataSet.Fields.FindField(FieldName)
  2833.   else if IsQueryField then
  2834.     Result := DataSet.Fields.FindField(ParamName)
  2835.   else
  2836.     Result := nil;
  2837. end;
  2838.  
  2839. procedure TWebDataInput.RestoreFieldDefaults(AField: TField);
  2840. begin
  2841.   if Assigned(AField) then
  2842.     Caption := AField.DisplayName;
  2843. end;
  2844.  
  2845. function TWebDataInput.GetFieldName: string;
  2846. begin
  2847.   Result := ImplGetFieldName;
  2848. end;
  2849.  
  2850. function TWebDataInput.ImplGetFieldName: string;
  2851. begin
  2852.   Result := FFieldName;
  2853. end;
  2854.  
  2855. procedure TWebDataInput.RestoreDefaults;
  2856. begin
  2857.   ImplRestoreDefaults;
  2858. end;
  2859.  
  2860. function TWebDataInput.GetParamName: string;
  2861. begin
  2862.   Result := FParamName;
  2863.   if (Result = '') and IsQueryField then
  2864.     Result := FieldName;
  2865. end;
  2866.  
  2867. procedure TWebDataInput.SetParamName(Value: string);
  2868. begin
  2869.   if Value <> FParamName then
  2870.   begin
  2871.     FParamName := Value;
  2872.     if Assigned(FWebParent) and
  2873.       not (csLoading in ComponentState) and (Length(Value) > 0) then
  2874.     begin
  2875.       RestoreDefaults;
  2876.     end;
  2877.   end;
  2878. end;
  2879.  
  2880. function TWebDataInput.GetRowSetFieldAttributes(
  2881.   const FieldVarName: string): string;
  2882. begin
  2883.   Result := ImplGetRowSetFieldAttributes(FieldVarName);
  2884. end;
  2885.  
  2886. function TWebDataInput.ImplGetRowSetFieldAttributes(
  2887.   const FieldVarName: string): string;
  2888. begin
  2889.   Result := '';
  2890. end;
  2891.  
  2892. function TWebDataInput.ValidateField(DataSet: IMidasWebDataSet;
  2893.   AddIntf: IAddScriptElements): Boolean;
  2894.  
  2895.   procedure AddError(Value: string);
  2896.   begin
  2897.     AddIntf.AddError(Value);
  2898.     Result := False;
  2899.   end;
  2900. begin
  2901.   Result := True;
  2902.   if FieldName = '' then
  2903.     AddError(Format(sFieldNameBlank, [Name]))
  2904.   else if Assigned(DataSet) then
  2905.     if FindAssociatedField(DataSet) = nil then
  2906.       AddError(Format(sFieldNotFound, [Name, FieldName]));
  2907. end;
  2908.  
  2909. { TWebTextInput }
  2910.  
  2911. constructor TWebTextInput.Create(AOwner: TComponent);
  2912. begin
  2913.   inherited;
  2914.   FDisplayWidth := -1;
  2915. end;
  2916.  
  2917. procedure TWebTextInput.AddAttributes(var Attrs: string);
  2918. begin
  2919.   AddQuotedAttrib(Attrs, 'NAME', GetHTMLControlName);
  2920.   AddIntAttrib(Attrs, 'SIZE', DisplayWidth);
  2921.   AddIntAttrib(Attrs, 'TABINDEX', TabIndex);
  2922.   AddQuotedAttrib(Attrs, 'STYLE', Style);
  2923.   AddQuotedAttrib(Attrs, 'CLASS', StyleRule);
  2924.   AddCustomAttrib(Attrs, Custom);
  2925. end;
  2926.  
  2927. function TWebTextInput.ControlContent(Options: TWebContentOptions): string;
  2928. var
  2929.   Attrs: string;
  2930.   Events: string;
  2931. begin
  2932.   AddAttributes(Attrs);
  2933.   if (not (coNoScript in Options.Flags)) then
  2934.     Events := EventContent(Options);
  2935.   Result := Format('<INPUT TYPE=TEXT%0:s%1:s>', [Attrs, Events]);
  2936. end;
  2937.  
  2938. procedure TWebTextInput.RestoreFieldDefaults(AField: TField);
  2939. begin
  2940.   inherited;
  2941.   if Assigned(AField) then
  2942.     DisplayWidth := AField.DisplayWidth;
  2943. end;
  2944.  
  2945. function TWebTextInput.ImplGetRowSetFieldAttributes(
  2946.   const FieldVarName: string): string;
  2947. begin
  2948.   if ReadOnly then
  2949.     Result := Format('%s.readonly=true;', [FieldVarName])
  2950.   else
  2951.     Result := '';
  2952. end;
  2953.  
  2954. { TXMLDisplayReferenceButton }
  2955.  
  2956. constructor TXMLDisplayReferenceButton.Create(AOwner: TComponent);
  2957. begin
  2958.   inherited;
  2959.   FXMLDisplay := TXMLDisplayParent.Create(Self);
  2960.   FXMLDisplay.UseParent := True;
  2961. end;
  2962.  
  2963. destructor TXMLDisplayReferenceButton.Destroy;
  2964. begin
  2965.   inherited;
  2966.   FXMLDisplay.Free;
  2967. end;
  2968.  
  2969. function TXMLDisplayReferenceButton.GetDisplayComponent: TComponent;
  2970. begin
  2971.   Result := FXMLDisplay.DisplayComponent;
  2972. end;
  2973.  
  2974. function TXMLDisplayReferenceButton.GetDisplayComponentParent: Boolean;
  2975. begin
  2976.   Result := FXMLDisplay.UseParent;
  2977. end;
  2978.  
  2979. procedure TXMLDisplayReferenceButton.SetDisplayComponent(const Value: TComponent);
  2980. begin
  2981.   FXMLDisplay.DisplayComponent := Value;
  2982. end;
  2983.  
  2984. procedure TXMLDisplayReferenceButton.SetDisplayComponentParent(const Value: Boolean);
  2985. begin
  2986.   FXMLDisplay.UseParent := Value;
  2987. end;
  2988.  
  2989. function TXMLDisplayReferenceButton.GetXmlDisplayName: string;
  2990. var
  2991.   Component: TComponent;
  2992.   Intf: IXMLDisplay;
  2993. begin
  2994.   Component := XMLDisplay.DisplayComponent;
  2995.   if Assigned(Component) and
  2996.     Component.GetInterface(IXMLDisplay, Intf) then
  2997.     Result := Intf.XmlDisplayName
  2998.   else
  2999.     Result := '';
  3000. end;
  3001.  
  3002. procedure TXMLDisplayReferenceButton.Notification(AComponent: TComponent;
  3003.   Operation: TOperation);
  3004. begin
  3005.   inherited Notification(AComponent, Operation);
  3006.   if Assigned(FXMLDisplay) then
  3007.     FXMLDisplay.Notification(AComponent, Operation);
  3008. end;
  3009.  
  3010. { TDataSetButton }
  3011.  
  3012. procedure TDataSetButton.AddElements(AddIntf: IAddScriptElements);
  3013. begin
  3014.   ImplAddElements(AddIntf);
  3015. end;
  3016.  
  3017. function TDataSetButton.GetCaption: string;
  3018. begin
  3019.   Result := inherited GetCaption;
  3020.   if Result = '' then
  3021.     Result := DefaultCaption;
  3022. end;
  3023.  
  3024. function TDataSetButton.GetMethodName: string;
  3025. begin
  3026.   Result := XMLMethodName;
  3027. end;
  3028.  
  3029. constructor TFirstButton.Create(AOwner: TComponent);
  3030. begin
  3031.   inherited;
  3032.   DefaultCaption := sFirstButton;
  3033.   XMLMethodName := 'first';
  3034. end;
  3035.  
  3036. constructor TLastButton.Create(AOwner: TComponent);
  3037. begin
  3038.   inherited;
  3039.   DefaultCaption := sLastButton;
  3040.   XMLMethodName := 'last';
  3041. end;
  3042.  
  3043. constructor TPriorButton.Create(AOwner: TComponent);
  3044. begin
  3045.   inherited;
  3046.   DefaultCaption := sPriorButton;
  3047.   XMLMethodName := 'up';
  3048. end;
  3049.  
  3050. constructor TNextButton.Create(AOwner: TComponent);
  3051. begin
  3052.   inherited;
  3053.   DefaultCaption := sNextButton;
  3054.   XMLMethodName := 'down';
  3055. end;
  3056.  
  3057. constructor TNextPageButton.Create(AOwner: TComponent);
  3058. begin
  3059.   inherited;
  3060.   DefaultCaption := sNextPageButton;
  3061.   XMLMethodName := 'pgdown';
  3062. end;
  3063.  
  3064. constructor TPriorPageButton.Create(AOwner: TComponent);
  3065. begin
  3066.   inherited;
  3067.   DefaultCaption := sPriorPageButton;
  3068.   XMLMethodName := 'pgup';
  3069. end;
  3070.  
  3071. constructor TInsertButton.Create(AOwner: TComponent);
  3072. begin
  3073.   inherited;
  3074.   DefaultCaption := sInsertButton;
  3075.   XMLMethodName := 'newRow';
  3076. end;
  3077.  
  3078. constructor TDeleteButton.Create(AOwner: TComponent);
  3079. begin
  3080.   inherited;
  3081.   DefaultCaption := sDeleteButton;
  3082.   XMLMethodName := 'removeRow';
  3083. end;
  3084.  
  3085. constructor TUndoButton.Create(AOwner: TComponent);
  3086. begin
  3087.   inherited;
  3088.   DefaultCaption := sUndoButton;
  3089.   XMLMethodName := 'undo';
  3090. end;
  3091.  
  3092. function TDataSetButton.GetSubComponents: TObject;
  3093. begin
  3094.   Result := nil;
  3095. end;
  3096.  
  3097. procedure TDataSetButton.ImplAddElements(AddIntf: IAddScriptElements);
  3098. begin
  3099.   if (XMLComponent = nil) and (Self.Name <> '') then
  3100.     AddIntf.AddError(Format(sXMLComponentNotDefined, [Self.Name]));
  3101. end;
  3102.  
  3103. function TDataSetButton.ImplContent(Options: TWebContentOptions; ParentLayout: TLayout): string;
  3104. var
  3105.   Attrs: string;
  3106.   Intf: ILayoutWebContent;
  3107. begin
  3108.   //AddQuotedAttrib(Attrs, 'NAME', Name);
  3109.   AddQuotedAttrib(Attrs, 'STYLE', Style);
  3110.   AddQuotedAttrib(Attrs, 'CLASS', StyleRule);
  3111.   AddQuotedAttrib(Attrs, 'VALUE', Self.Caption);
  3112.   AddCustomAttrib(Attrs, Custom);
  3113.   if not (coNoScript in Options.Flags) then
  3114.   begin
  3115.     Result :=
  3116.       Format('<INPUT TYPE=BUTTON%0:s onclick=''if(%3:s)%1:s.%2:s();''>'#13#10,
  3117.         [Attrs, Self.GetXmlDisplayName, Self.GetMethodName, sXMLReadyVar]);
  3118.   end
  3119.   else
  3120.     Result :=
  3121.       Format('<INPUT TYPE=BUTTON%0:s>'#13#10,
  3122.         [Attrs]);
  3123.   if Assigned(ParentLayout) and ParentLayout.GetInterface(ILayoutWebContent, Intf) then
  3124.     Result := Intf.LayoutButton(Result, GetLayoutAttributes);
  3125. end;
  3126.  
  3127. { TApplyUpdatesButton }
  3128.  
  3129. procedure TApplyUpdatesButton.AddElements(AddIntf: IAddScriptElements);
  3130. begin
  3131.   ImplAddElements(AddIntf);
  3132. end;
  3133.  
  3134. constructor TApplyUpdatesButton.Create(AOwner: TComponent);
  3135. begin
  3136.   inherited;
  3137.   DefaultCaption := sApplyUpdates;
  3138. end;
  3139.  
  3140.  
  3141. function TApplyUpdatesButton.GetSubComponents: TObject;
  3142. begin
  3143.   Result := nil;
  3144. end;
  3145.  
  3146. function FindProducer(Component: TComponent): TCustomContentProducer;
  3147. begin
  3148.   while Assigned(Component) and not (Component is TCustomContentProducer) do
  3149.     Component := Component.GetParentComponent;
  3150.   if Assigned(Component) then
  3151.     Result := TCustomContentProducer(Component)
  3152.   else
  3153.     Result := nil;
  3154. end;
  3155.  
  3156. function FindDispatcher(Component: TComponent): TCustomWebDispatcher;
  3157. var
  3158.   Producer: TCustomContentProducer;
  3159. begin
  3160.   Result := nil;
  3161.   if not (csDesigning in Component.ComponentState) then
  3162.   begin
  3163.     Producer := FindProducer(Component);
  3164.     if Assigned(Producer) then
  3165.       Result := Producer.Dispatcher;
  3166.   end;
  3167. end;
  3168.  
  3169. procedure DeclareSubmitForm(Component: TComponent; XMLBroker: TXMLBroker; AddIntf: IAddScriptElements);
  3170. const
  3171.   Indent1 = '  ';
  3172. var
  3173.   PathInfo: string;
  3174.   Redirect: string;
  3175.   Forms, Vars: string;
  3176.   Dispatcher: TCustomWebDispatcher;
  3177.   Producer: TCustomContentProducer;
  3178. begin
  3179.   Forms := '';
  3180.   Vars := '';
  3181.   if Assigned(XMLBroker) then
  3182.   begin
  3183.     PathInfo := XMLBroker.WebDispatch.PathInfo;
  3184.     if Copy(PathInfo, 1, 1) = '/' then
  3185.       Delete(PathInfo, 1, 1);
  3186.     Producer := FindProducer(Component);
  3187.     if Assigned(Producer) then
  3188.       Dispatcher := Producer.Dispatcher
  3189.     else
  3190.       Dispatcher := nil;
  3191.     if Assigned(Dispatcher) and Assigned(Dispatcher.Request) then
  3192.       PathInfo := Dispatcher.Request.ScriptName + '/' + PathInfo;
  3193.     Forms := Forms +
  3194.       Format(#13#10'<FORM NAME=%0:s ACTION="%1:s" METHOD="POST">',
  3195.         [XMLBroker.HTMLSubmitFormName, PathInfo]);
  3196.     Forms := Forms +
  3197.       Format('%0:s<INPUT TYPE=HIDDEN NAME="%1:s" VALUE="%2:s">'#13#10,
  3198.         [Indent1, sXMLBroker, XMLBroker.Name]);
  3199.     Forms := Forms +
  3200.       Format('%0:s<INPUT TYPE=HIDDEN NAME="%1:s">'#13#10,
  3201.         [Indent1, SPostDelta]);
  3202.     Forms := Forms +
  3203.       Format('%0:s<INPUT TYPE=HIDDEN NAME="%1:s" VALUE="%2:s">'#13#10,
  3204.         [Indent1, sProducer, Producer.Name]);
  3205.     if (Dispatcher <> nil) and (Dispatcher.Request <> nil) then
  3206.     begin
  3207.       if Assigned(Dispatcher) and Assigned(Dispatcher.Request) then
  3208.         Redirect := Format('http://%s%s', [Dispatcher.Request.Host, Dispatcher.Request.ScriptName]);
  3209.       if Length(Dispatcher.Request.PathInfo) > 1 then
  3210.       begin
  3211.         if Redirect <> '' then Redirect := Redirect + '/';
  3212.         Redirect := Redirect + Copy(Dispatcher.Request.PathInfo, 2, MaxInt);
  3213.       end;
  3214.       if Dispatcher.Request.Query <> '' then
  3215.         Redirect := Redirect + '?' + Dispatcher.Request.Query;
  3216.       Forms := Forms +
  3217.         Format('%0:s<INPUT TYPE=HIDDEN NAME="%1:s" VALUE="%2:s">'#13#10,
  3218.           [Indent1, sRedirect, Redirect]);
  3219.     end;
  3220.     Forms := Forms + '</FORM>';
  3221.     AddIntf.AddHTMLBlock(XMLBroker.HTMLSubmitFormName, Forms);
  3222.     AddIntf.AddVar(XMLBroker.SubmitFormVarName,
  3223.        Format('var %0:s = document.forms[''%1:s''];'#13#10,
  3224.         [XMLBroker.SubmitFormVarName, XMLBroker.HTMLSubmitFormName]));
  3225.   end;
  3226. end;
  3227.  
  3228. procedure TApplyUpdatesButton.ImplAddElements(AddIntf: IAddScriptElements);
  3229. begin
  3230.   DeclareSubmitForm(Self, XMLData.XMLBroker, AddIntf);
  3231. end;
  3232.  
  3233. function TApplyUpdatesButton.ImplContent(Options: TWebContentOptions;
  3234.   ParentLayout: TLayout): string;
  3235. var
  3236.   Attrs: string;
  3237.   Intf: ILayoutWebContent;
  3238.   FormVarName: string;
  3239.   RowSetVarName: string;
  3240. begin
  3241.   //AddQuotedAttrib(Attrs, 'NAME', Name);
  3242.   AddQuotedAttrib(Attrs, 'STYLE', Style);
  3243.   AddQuotedAttrib(Attrs, 'CLASS', StyleRule);
  3244.   AddQuotedAttrib(Attrs, 'VALUE', Self.Caption);
  3245.   AddCustomAttrib(Attrs, Custom);
  3246.   if Assigned(XMLData.XMLBroker) then
  3247.   begin
  3248.     FormVarName := XMLData.XMLBroker.SubmitFormVarName;
  3249.     RowSetVarName := XMLData.XMLBroker.RowSetVarName(nil);  
  3250.   end;
  3251.   if not (coNoScript in Options.Flags) then
  3252.     Result :=
  3253.       Format('<INPUT TYPE=BUTTON%0:s onclick=''if(%3:s)%1:s.Apply(%2:s, %2:s.postdelta);''>'#13#10,
  3254.         [Attrs, RowSetVarName, FormVarName, sXMLReadyVar])
  3255.   else
  3256.     Result :=
  3257.       Format('<INPUT TYPE=BUTTON%0:s>'#13#10,
  3258.         [Attrs]);
  3259.   if Assigned(ParentLayout) and ParentLayout.GetInterface(ILayoutWebContent, Intf) then
  3260.     Result := Intf.LayoutButton(Result, GetLayoutAttributes);
  3261. end;
  3262.  
  3263. { TXMLButton }
  3264.  
  3265. constructor TXMLButton.Create(AOwner: TComponent);
  3266. begin
  3267.   inherited;
  3268.   FXMLData := TXMLDataParent.Create(Self);
  3269.   FXMLData.UseParent := True;
  3270. end;
  3271.  
  3272. destructor TXMLButton.Destroy;
  3273. begin
  3274.   inherited;
  3275.   FXMLData.Free;
  3276. end;
  3277.  
  3278. function TXMLButton.GetCaption: string;
  3279. begin
  3280.   Result := inherited GetCaption;
  3281.   if Result = '' then
  3282.     Result := DefaultCaption;
  3283. end;
  3284.  
  3285. function TXMLButton.GetXMLBroker: TXMLBroker;
  3286. begin
  3287.   Result := FXMLData.XMLBroker;
  3288. end;
  3289.  
  3290. function TXMLButton.GetXMLUseParent: Boolean;
  3291. begin
  3292.   Result := XMLData.UseParent;
  3293. end;
  3294.  
  3295. procedure TXMLButton.Notification(AComponent: TComponent;
  3296.   Operation: TOperation);
  3297. begin
  3298.   inherited Notification(AComponent, Operation);
  3299.   if Assigned(XMLData) then
  3300.     XMLData.Notification(AComponent, Operation);
  3301. end;
  3302.  
  3303. procedure TXMLButton.SetXMLBroker(const Value: TXMLBroker);
  3304. begin
  3305.   FXMLData.XMLBroker := Value;
  3306. end;
  3307.  
  3308. procedure TXMLButton.SetXMLUseParent(const Value: Boolean);
  3309. begin
  3310.   XMLData.UseParent := Value;
  3311. end;
  3312.  
  3313. { TWebTextAreaInput }
  3314.  
  3315. constructor TWebTextAreaInput.Create(AOwner: TComponent);
  3316. begin
  3317.   inherited;
  3318.   FDisplayWidth := -1;
  3319.   FDisplayRows := -1;
  3320.   FWrap := wrVirtual;
  3321. end;
  3322.  
  3323. procedure TWebTextAreaInput.AddAttributes(var Attrs: string);
  3324. begin
  3325.   AddQuotedAttrib(Attrs, 'NAME', GetHTMLControlName);
  3326.   AddIntAttrib(Attrs, 'COLS', DisplayWidth);
  3327.   AddIntAttrib(Attrs, 'ROWS', DisplayRows);
  3328.   AddIntAttrib(Attrs, 'TABINDEX', TabIndex);
  3329.   AddStringAttrib(Attrs, 'WRAP', TextAreaWrap[Wrap]);
  3330.   AddQuotedAttrib(Attrs, 'STYLE', Style);
  3331.   AddQuotedAttrib(Attrs, 'CLASS', StyleRule);
  3332.   AddCustomAttrib(Attrs, Custom);
  3333. end;
  3334.  
  3335. function TWebTextAreaInput.ControlContent(Options: TWebContentOptions): string;
  3336. var
  3337.   Attrs: string;
  3338.   Events: string;
  3339. begin
  3340.   AddAttributes(Attrs);
  3341.   if (not (coNoScript in Options.Flags)) then
  3342.     Events := EventContent(Options);
  3343.   Result := Format('<TEXTAREA%0:s%1:s></TEXTAREA>', [Attrs, Events]);
  3344. end;
  3345.  
  3346. function TWebTextAreaInput.EventContent(Options: TWebContentOptions): string;
  3347. var
  3348.   XMLDisplayName: string;
  3349. begin
  3350.   Result := '';
  3351.   if not IsQueryField then
  3352.   begin
  3353.     XMLDisplayName := GetXmlDisplayName;
  3354.     Result := Result +
  3355.       Format(' onFocus=''if(%s)%s.xfocus(this);''', [sXMLReadyVar, XMLDisplayName]);
  3356.   end;
  3357. end;
  3358.  
  3359. procedure TWebTextAreaInput.RestoreFieldDefaults(AField: TField);
  3360. begin
  3361.   inherited;
  3362.   if Assigned(AField) then
  3363.     DisplayWidth := AField.DisplayWidth;
  3364. end;
  3365.  
  3366. function TWebTextAreaInput.ImplGetRowSetFieldAttributes(
  3367.   const FieldVarName: string): string;
  3368. begin
  3369.   if ReadOnly then
  3370.     Result := Format('%s.readonly=true;', [FieldVarName])
  3371.   else
  3372.     Result := '';
  3373. end;
  3374.  
  3375. { TWebListInput }
  3376.  
  3377. constructor TWebListInput.Create(AOwner: TComponent);
  3378. begin
  3379.   inherited;
  3380.   FValues := TStringList.Create;
  3381.   FItems := TStringList.Create;
  3382. end;
  3383.  
  3384. destructor TWebListInput.Destroy;
  3385. begin
  3386.   inherited;
  3387.   FValues.Free;
  3388.   FItems.Free;
  3389. end;
  3390.  
  3391. function TWebListInput.ControlContent(Options: TWebContentOptions): string;
  3392. var
  3393.   ValuesStrings, ItemsStrings: TStrings;
  3394. begin
  3395.   if GetItemValuesFromDataSet(FDataSet, ItemsField, ValuesField, ItemsStrings, ValuesStrings) then
  3396.   begin
  3397.     try
  3398.       Result := FormatInputs(ItemsStrings, ValuesStrings, Options);
  3399.     finally
  3400.       ItemsStrings.Free;
  3401.       ValuesStrings.Free;
  3402.     end;
  3403.   end
  3404.   else
  3405.     Result := FormatInputs(Items, Values, Options);
  3406. end;
  3407.  
  3408. procedure TWebListInput.SetItems(const Value: TStrings);
  3409. begin
  3410.   FItems.Assign(Value);
  3411. end;
  3412.  
  3413. procedure TWebListInput.SetValues(const Value: TStrings);
  3414. begin
  3415.   FValues.Assign(Value);
  3416. end;
  3417.  
  3418. procedure TWebListInput.SetDataSet(const Value: TDataSet);
  3419. begin
  3420.   if FDataSet <> Value then
  3421.   begin
  3422.     FDataSet := Value;
  3423.     if Value <> nil then
  3424.     begin
  3425.       Value.FreeNotification(Self);
  3426.       if not (csLoading in ComponentState) then
  3427.         Value.Active := True;
  3428.     end;
  3429.   end;
  3430. end;
  3431.  
  3432. procedure TWebListInput.Notification(AComponent: TComponent;
  3433.   Operation: TOperation);
  3434. begin
  3435.   inherited;
  3436.   if (Operation = opRemove) and (AComponent = FDataSet) then
  3437.     DataSet := nil;
  3438. end;
  3439.  
  3440. procedure TWebListInput.AddElements(AddIntf: IAddScriptElements);
  3441. begin
  3442.   ImplAddElements(AddIntf);
  3443. end;
  3444.  
  3445. function TWebListInput.GetSubComponents: TObject;
  3446. begin
  3447.   Result := nil;
  3448. end;
  3449.  
  3450. procedure TWebListInput.ImplAddElements(AddIntf: IAddScriptElements);
  3451. begin
  3452.   if Assigned(FDataSet) and (FDataSet.Active = False) then
  3453.     AddIntf.AddError(Format(sDataSetNotActive, [FDataSet.Name]));
  3454. end;
  3455.  
  3456. { TWebRadioGroupInput }
  3457.  
  3458. constructor TWebRadioGroupInput.Create(AOwner: TComponent);
  3459. begin
  3460.   inherited;
  3461.   FDisplayWidth := -1;
  3462.   FDisplayColumns := -1;
  3463.   FDisplayColumns := -1;
  3464. end;
  3465.  
  3466. procedure TWebRadioGroupInput.AddAttributes(var Attrs: string);
  3467. begin
  3468.   AddQuotedAttrib(Attrs, 'NAME', GetHTMLControlName);
  3469.   AddIntAttrib(Attrs, 'WIDTH', DisplayWidth);
  3470.   AddIntAttrib(Attrs, 'TABINDEX', TabIndex);
  3471.   AddCustomAttrib(Attrs, Custom);
  3472. end;
  3473.  
  3474. function TWebRadioGroupInput.FormatInputs(ItemsStrings, ValuesStrings: TStrings; Options: TWebContentOptions): string;
  3475.   function Min(X, Y: Integer): Integer;
  3476.   begin
  3477.     Result := X;
  3478.     if X > Y then Result := Y;
  3479.   end;
  3480. var
  3481.   I, J, Index: Integer;
  3482.   Element, Value, Attrs, Item: string;
  3483.   Columns, Rows: Integer;
  3484.   Skip: Integer;
  3485.   Events: string;
  3486.   CheckIndex: Integer;
  3487.   ItemAttr: string;
  3488. begin
  3489.   Skip := 0;
  3490.   Result := '';
  3491.   if ItemsStrings.Count > 0 then
  3492.   begin
  3493.     AddAttributes(Attrs);
  3494.     if (not (coNoScript in Options.Flags)) then
  3495.       Events := EventContent(Options);
  3496.     Element := Format('<INPUT TYPE=RADIO%0:s%1:s', [Attrs, Events]);
  3497.     CheckIndex := GetCheckIndex(ItemsStrings, ValuesStrings);
  3498.     if DisplayColumns > 0 then
  3499.     begin
  3500.       Columns := Min(DisplayColumns, ItemsStrings.Count);
  3501.       Rows := (ItemsStrings.Count + Columns - 1) div Columns;
  3502.       for I := 0 to Rows - 1 do
  3503.       begin
  3504.         Result := Format('%0:s<TR>', [Result]);
  3505.         for J := 0 to Columns -1 do
  3506.         begin
  3507.           Index := (Rows * J) + I + Skip;
  3508.           if Index < ItemsStrings.Count then
  3509.           begin
  3510.             Item := ItemsStrings[Index];
  3511.             if ItemsStrings.IndexOf(Item) <> Index then
  3512.             begin
  3513.               Inc(Skip);
  3514.               continue;  // not unique
  3515.             end;
  3516.             if ValuesStrings.Count > Index then
  3517.               Value := ValuesStrings[Index]
  3518.             else
  3519.               Value := Item;
  3520.             ItemAttr := '';
  3521.             AddQuotedAttrib(ItemAttr, 'VALUE', Value);
  3522.             AddBoolAttrib(ItemAttr, 'CHECKED', Index = CheckIndex);
  3523.             Result := Format('%0:s<TD>%1:s%2:s>%3:s</INPUT></TD>'#13#10,
  3524.               [Result, Element, ItemAttr, Item]);
  3525.           end;
  3526.         end;
  3527.         Result := Result + '</TR>';
  3528.       end;
  3529.       Attrs := '';
  3530.       AddQuotedAttrib(Attrs, 'STYLE', Style);
  3531.       AddQuotedAttrib(Attrs, 'CLASS', StyleRule);
  3532.       Result := Format(#13#10'<TABLE%s>%s</TABLE>', [Attrs, Result]);
  3533.     end
  3534.     else
  3535.     begin
  3536.       Attrs := '';
  3537.       AddQuotedAttrib(Attrs, 'STYLE', Style);
  3538.       AddQuotedAttrib(Attrs, 'CLASS', StyleRule);
  3539.       LayoutAttributes.ControlAttributes := Attrs;
  3540.       for Index := 0 to ItemsStrings.Count - 1 do
  3541.       begin
  3542.         Item := ItemsStrings[Index];
  3543.         if ItemsStrings.IndexOf(Item) <> Index then continue;
  3544.         if ValuesStrings.Count > Index then
  3545.           Value := ValuesStrings[Index]
  3546.         else
  3547.           Value := Item;
  3548.         ItemAttr := '';
  3549.         AddQuotedAttrib(ItemAttr, 'VALUE', Value);
  3550.         AddBoolAttrib(ItemAttr, 'CHECKED', Index = CheckIndex);
  3551.         Result := Format('%0:s %1:s%2:s>%3:s</INPUT>'#13#10,
  3552.           [Result, Element, ItemAttr, Item]);
  3553.       end;
  3554.     end;
  3555.   end;
  3556. end;
  3557.  
  3558. procedure TWebRadioGroupInput.RestoreFieldDefaults(AField: TField);
  3559. begin
  3560.   inherited;
  3561.   if Assigned(AField) then
  3562.     DisplayWidth := AField.DisplayWidth;
  3563. end;
  3564.  
  3565. function TWebRadioGroupInput.GetCheckIndex(ItemsStrings,
  3566.   ValuesStrings: TStrings): Integer;
  3567. begin
  3568.   Result := -1;
  3569. end;
  3570.  
  3571. function TWebRadioGroupInput.EventContent(
  3572.   Options: TWebContentOptions): string;
  3573. var
  3574.   XMLDisplayName: string;
  3575. begin
  3576.   Result := '';
  3577.   if not IsQueryField then
  3578.   begin
  3579.     XMLDisplayName := GetXmlDisplayName;
  3580.     Result := Result +
  3581.       Format(' onFocus=''if(%s)%s.xfocus(this);''', [sXMLReadyVar, XMLDisplayName]);
  3582.   end;
  3583. end;
  3584.  
  3585. function TWebRadioGroupInput.ImplGetRowSetFieldAttributes(
  3586.   const FieldVarName: string): string;
  3587. begin
  3588.   if ReadOnly then
  3589.     Result := Format('%s.readonly=true;', [FieldVarName])
  3590.   else
  3591.     Result := '';
  3592. end;
  3593.  
  3594. { TWebSelectOptionsInput }
  3595.  
  3596. constructor TWebSelectOptionsInput.Create(AOwner: TComponent);
  3597. begin
  3598.   inherited;
  3599.   FDisplayRows := -1;
  3600. end;
  3601.  
  3602. function TWebSelectOptionsInput.EventContent(Options: TWebContentOptions): string;
  3603. var
  3604.   XMLDisplayName: string;
  3605. begin
  3606.   Result := '';
  3607.   if not IsQueryField then
  3608.   begin
  3609.     XMLDisplayName := GetXmlDisplayName;
  3610.     Result := Result +
  3611.       Format(' onFocus=''if(%s)%s.xfocus(this);''', [sXMLReadyVar, XMLDisplayName]);
  3612.   end;
  3613. end;
  3614.  
  3615. procedure TWebSelectOptionsInput.AddAttributes(var Attrs: string);
  3616. begin
  3617.   AddQuotedAttrib(Attrs, 'NAME', GetHTMLControlName);
  3618.   AddIntAttrib(Attrs, 'SIZE', DisplayRows);
  3619.   AddIntAttrib(Attrs, 'TABINDEX', TabIndex);
  3620.   AddQuotedAttrib(Attrs, 'STYLE', Style);
  3621.   AddQuotedAttrib(Attrs, 'CLASS', StyleRule);
  3622.   AddCustomAttrib(Attrs, Custom);
  3623. end;
  3624.  
  3625. function TWebSelectOptionsInput.GetSelectIndex(ItemsStrings, ValuesStrings: TStrings): Integer;
  3626. begin
  3627.   Result := -1;
  3628. end;
  3629.  
  3630. function TWebSelectOptionsInput.FormatInputs(ItemsStrings, ValuesStrings: TStrings; Options: TWebContentOptions): string;
  3631. var
  3632.   Index: Integer;
  3633.   Attrs, Value: string;
  3634.   Item: string;
  3635.   Events: string;
  3636.   OptionAttr: string;
  3637.   SelectIndex: Integer;
  3638. begin
  3639.   Result := '';
  3640.   AddAttributes(Attrs);
  3641.   if (not (coNoScript in Options.Flags)) then
  3642.     Events := EventContent(Options);
  3643.   Result := Format('<SELECT%0:s%1:s>'#13#10, [Attrs, Events]);
  3644.   SelectIndex := GetSelectIndex(ItemsStrings, ValuesStrings);
  3645.   for Index := 0 to ItemsStrings.Count - 1 do
  3646.   begin
  3647.     Item := ItemsStrings[Index];
  3648.     if ItemsStrings.IndexOf(Item) <> Index then continue;  // no unique
  3649.     if ValuesStrings.Count > Index then
  3650.       Value := ValuesStrings[Index]
  3651.     else
  3652.       Value := Item;
  3653.     OptionAttr := '';
  3654.     AddQuotedAttrib(OptionAttr, 'VALUE', Value);
  3655.     AddBoolAttrib(OptionAttr, 'SELECTED', Index = SelectIndex);
  3656.  
  3657.     Result := Format('%0:s <OPTION%1:s>%2:s'#13#10,
  3658.       [Result, OptionAttr, Item]);
  3659.   end;
  3660.   Result := Format('%0:s</SELECT>'#13#10, [Result]);
  3661. end;
  3662.  
  3663. { TDataSetPostButton }
  3664.  
  3665. constructor TPostButton.Create(AOwner: TComponent);
  3666. begin
  3667.   inherited;
  3668.   DefaultCaption := sPostButton;
  3669.   XMLMethodName := 'post';
  3670. end;
  3671.  
  3672. { TCustomQueryForm }
  3673.  
  3674. procedure TCustomQueryForm.ImplAddElements(AddIntf: IAddScriptElements);
  3675. begin
  3676.   inherited;
  3677.   AddIntf.AddScriptBlock('', Format('var %0:s = document.forms[''%1:s''];'#13#10, [GetHTMLFormVarName, GetHTMLFormName]));
  3678. end;
  3679.  
  3680. function TCustomQueryForm.GetHTMLFormTag(Options: TWebContentOptions): string;
  3681. var
  3682.   Attribs: string;
  3683. begin
  3684.   AddStringAttrib(Attribs, 'NAME', GetHTMLFormName);
  3685.   AddQuotedAttrib(Attribs, 'STYLE', Style);
  3686.   AddQuotedAttrib(Attribs, 'CLASS', StyleRule);
  3687.   AddQuotedAttrib(Attribs, 'ACTION', Action);
  3688.   AddStringAttrib(Attribs, 'METHOD', MethodString);
  3689.   AddCustomAttrib(Attribs, Custom);
  3690.   Result :=
  3691.     Format(#13#10'<FORM%0:s>', [Attribs]);
  3692. end;
  3693.  
  3694. function TCustomQueryForm.MethodString: string;
  3695. begin
  3696.   Result := FormMethodNames[FMethod];
  3697. end;
  3698.  
  3699. constructor TCustomQueryForm.Create(AOwner: TComponent);
  3700. begin
  3701.   inherited;
  3702.   FMethod := fmGet;   // Default to Query because it can
  3703.                       // be bookmarked and can easily return
  3704.                       // to after apply
  3705. end;
  3706.  
  3707. type TComponentCracker = class(TComponent) end;
  3708.  
  3709. procedure TCustomQueryForm.AssignStringsCallback(AComponent: TComponent);
  3710. var
  3711.   QueryField: IQueryField;
  3712.   Index: Integer;
  3713. begin
  3714.   Assert(Assigned(FAssignStrings), 'Unexpected value');
  3715.   if AComponent.GetInterface(IQueryField, QueryField) then
  3716.   begin
  3717.     Index := FAssignStrings.IndexOfName(QueryField.HTMLControlName);
  3718.     if Index <> -1 then
  3719.       QueryField.Text := FAssignStrings.Values[FAssignStrings.Names[Index]];
  3720.   end;
  3721.   TComponentCracker(AComponent).GetChildren(AssignStringsCallback, Owner);
  3722. end;
  3723.  
  3724. procedure TCustomQueryForm.AssignStrings(Value: TStrings);
  3725. begin
  3726.   if Value.Count > 0 then
  3727.   begin
  3728.     FAssignStrings := Value;
  3729.     try
  3730.       GetChildren(AssignStringsCallback, Owner);
  3731.     finally
  3732.       FAssignStrings := nil;
  3733.     end;
  3734.   end;
  3735. end;
  3736.  
  3737. { TSubmitQueryButton }
  3738.  
  3739. constructor TSubmitQueryButton.Create(AOwner: TComponent);
  3740. begin
  3741.   inherited;
  3742.   DefaultCaption := sSubmitQuery;
  3743.   InputType := 'BUTTON';
  3744. end;
  3745.  
  3746. function TSubmitQueryButton.EventContent(
  3747.   Options: TWebContentOptions): string;
  3748. var
  3749.   HTMLForm: IHTMLForm;
  3750.   HTMLFormVarName: string;
  3751. begin
  3752.   HTMLForm := GetHTMLForm;
  3753.   if Assigned(HTMLForm) then
  3754.     HTMLFormVarName := HTMLForm.HTMLFormVarName;
  3755.   Result :=
  3756.     Format(' onclick=''%0:s.submit();''',
  3757.       [HTMLFormVarName]);
  3758. end;
  3759.  
  3760. { TResetQueryButton }
  3761.  
  3762. constructor TResetQueryButton.Create(AOwner: TComponent);
  3763. begin
  3764.   inherited;
  3765.   DefaultCaption := sResetQuery;
  3766.   InputType := 'BUTTON';
  3767. end;
  3768.  
  3769. function TResetQueryButton.EventContent(
  3770.   Options: TWebContentOptions): string;
  3771. var
  3772.   HTMLForm: IHTMLForm;
  3773.   HTMLFormVarName: string;
  3774. begin
  3775.   HTMLForm := GetHTMLForm;
  3776.   if Assigned(HTMLForm) then
  3777.     HTMLFormVarName := HTMLForm.HTMLFormVarName;
  3778.   Result :=
  3779.     Format(' onclick=''%0:s.reset();''',
  3780.       [HTMLFormVarName]);
  3781. end;
  3782.  
  3783. { TQueryButton }
  3784.  
  3785. function TQueryButton.GetCaption: string;
  3786. begin
  3787.   Result := FCaption;
  3788.   if Result = '' then
  3789.     Result := DefaultCaption;
  3790. end;
  3791.  
  3792. function TQueryButton.GetInputType: string;
  3793. begin
  3794.   Result := InputType;
  3795. end;
  3796.  
  3797. function TQueryButton.ImplContent(Options: TWebContentOptions; ParentLayout: TLayout): string;
  3798. var
  3799.   Attribs: string;
  3800.   Intf: ILayoutWebContent;
  3801.   Events: string;
  3802. begin
  3803.   Attribs := '';
  3804.   if not (coNoScript in Options.Flags) then
  3805.     Events := EventContent(Options);
  3806.  
  3807.   //AddStringAttrib(Attribs, 'NAME', GetHTMLControlName);
  3808.   AddStringAttrib(Attribs, 'TYPE', GetInputType);
  3809.   AddQuotedAttrib(Attribs, 'VALUE', Self.Caption);
  3810.   AddQuotedAttrib(Attribs, 'STYLE', Style);
  3811.   AddQuotedAttrib(Attribs, 'CLASS', StyleRule);
  3812.   AddCustomAttrib(Attribs, Custom);
  3813.   Result :=
  3814.     Format('<INPUT%0:s%1:s>'#13#10,
  3815.       [Attribs, Events]);
  3816.   if Assigned(ParentLayout) and ParentLayout.GetInterface(ILayoutWebContent, Intf) then
  3817.     Result := Intf.LayoutButton(Result, GetLayoutAttributes);
  3818. end;
  3819.  
  3820. function TQueryButton.EventContent(Options: TWebContentOptions): string;
  3821. begin
  3822.   Result := '';
  3823. end;
  3824.  
  3825. function TQueryButton.GetHTMLControlName: string;
  3826. begin
  3827.   Result := '';
  3828. end;
  3829.  
  3830. function TQueryButton.GetHTMLForm: IHTMLForm;
  3831. begin
  3832.   if Assigned(XMLComponent) then
  3833.     XMLComponent.GetInterface(IHTMLForm, Result)
  3834.   else
  3835.     Result := nil;
  3836. end;
  3837.  
  3838. function TQueryButton.ParentXMLComponent: TComponent;
  3839. var
  3840.   QueryForm: IQueryForm;
  3841. begin
  3842.   Result := GetParentComponent;
  3843.   while Assigned(Result) do
  3844.   begin
  3845.     if Result.GetInterface(IQueryForm, QueryForm) then Exit;
  3846.     Result := Result.GetParentComponent;
  3847.   end;
  3848.   Result := nil;
  3849. end;
  3850.  
  3851. function TQueryButton.GetXMLComponent: TComponent;
  3852. begin
  3853.   if not FXMLUseParent then
  3854.     Result := FXMLComponent
  3855.   else
  3856.     Result := ParentXMLComponent;
  3857. end;
  3858.  
  3859. procedure TQueryButton.SetXMLComponent(const Value: TComponent);
  3860. begin
  3861.   if not (csLoading in ComponentState) then
  3862.     FXMLUseParent := False;
  3863.   FXMLComponent := Value;
  3864.   if Value <> nil then Value.FreeNotification(Self);
  3865. end;
  3866.  
  3867. procedure TQueryButton.Notification(AComponent: TComponent;
  3868.   Operation: TOperation);
  3869. begin
  3870.   inherited;
  3871.   if (Operation = opRemove) and (AComponent = FXMLComponent) then
  3872.     XMLComponent := nil;
  3873. end;
  3874.  
  3875. procedure TQueryButton.SetXMLUseParent(const Value: Boolean);
  3876. begin
  3877.   if Value then
  3878.     FXMLComponent := nil;
  3879.   FXMLUseParent := Value;
  3880. end;
  3881.  
  3882. constructor TQueryButton.Create(AOwner: TComponent);
  3883. begin
  3884.   inherited;
  3885.   FXMLUseParent := True;
  3886. end;
  3887.  
  3888. { TCustomQueryButtons }
  3889.  
  3890. const
  3891.   DefaultQueryButtons: array[0..1] of TWebButtonClass =
  3892.   (TSubmitQueryButton, TResetQueryButton);
  3893.  
  3894. procedure TCustomQueryButtons.GetDefaultButtons;
  3895. begin
  3896.   if not Assigned(DefaultWebComponents) then
  3897.   begin
  3898.     DefaultWebComponents := TWebComponentList.Create(Self);
  3899.     CreateDefaultButtonClasses(DefaultQueryButtons, FWebComponents);
  3900.   end;
  3901. end;
  3902.  
  3903. procedure TCustomQueryButtons.ImplAddElements(AddIntf: IAddScriptElements);
  3904. begin
  3905.   inherited;
  3906. end;
  3907.  
  3908. function TCustomQueryButtons.ImplContent(Options: TWebContentOptions; ParentLayout: TLayout): string;
  3909. var
  3910.   ButtonsLayout: TFormLayout;
  3911.  
  3912.   function FormatButton(Button: TComponent): string;
  3913.   var
  3914.     Intf: IWebContent;
  3915.   begin
  3916.     Result := '';
  3917.     if Button.GetInterface(IWebContent, Intf) then
  3918.       Result := Intf.Content(Options, ButtonsLayout);
  3919.   end;
  3920. var
  3921.   Button: TComponent;
  3922.   I: Integer;
  3923.   Intf: ILayoutWebContent;
  3924.   Attribs: string;
  3925. begin
  3926.   Result := '';
  3927.   ButtonsLayout := TFormLayout.Create(ParentLayout);
  3928.   try
  3929.     // AddStringAttrib(Attribs, 'NAME', Name);
  3930.     AddQuotedAttrib(Attribs, 'STYLE', Style);
  3931.     AddQuotedAttrib(Attribs, 'CLASS', StyleRule);
  3932.     AddCustomAttrib(Attribs, Custom);
  3933.     ButtonsLayout.FTableHeader := Format(#13#10'<TABLE%s>', [Attribs]);
  3934.     for I := 0 to VisibleButtons.Count - 1 do
  3935.     begin
  3936.       Button := VisibleButtons.WebComponents[I];
  3937.       Result := Result + FormatButton(Button);
  3938.     end;
  3939.     Result := Result + ButtonsLayout.EndLayout;
  3940.   finally
  3941.     ButtonsLayout.Free;
  3942.   end;
  3943.   if Assigned(ParentLayout) and ParentLayout.GetInterface(ILayoutWebContent, Intf) then
  3944.     Result := Intf.LayoutField(Result, GetLayoutAttributes)
  3945. end;
  3946.  
  3947. function GetItemValuesFromDataSet(DataSet: TDataSet;
  3948.   const ItemsField, ValuesField: string;
  3949.   var ItemsStrings, ValuesStrings: TStrings): Boolean;
  3950. var
  3951.   DSValuesField, DSItemsField: TField;
  3952. begin
  3953.   Result := False;
  3954.   if Assigned(DataSet) then
  3955.   begin
  3956.     DSItemsField := nil;
  3957.     if ItemsField <> '' then
  3958.     begin
  3959.       if not (csDesigning in DataSet.ComponentState) then
  3960.         DataSet.Active := True;
  3961.       if DataSet.Active then
  3962.         DSItemsField := DataSet.FindField(ItemsField)
  3963.     end;
  3964.     if Assigned(DSItemsField) then
  3965.     begin
  3966.       if ValuesField <> '' then
  3967.         DSValuesField := DataSet.FindField(ValuesField)
  3968.       else
  3969.         DSValuesField := nil;
  3970.       ValuesStrings := TStringList.Create;
  3971.       ItemsStrings := TStringList.Create;
  3972.       try
  3973.         DataSet.First;
  3974.         while not DataSet.EOF do
  3975.         begin
  3976.           if not VarIsNull(DSItemsField.Value) then
  3977.             ItemsStrings.Add(DSItemsField.Value);
  3978.           if Assigned(DSValuesField) then
  3979.             if not VarIsNull(DSValuesField.Value) then
  3980.               ValuesStrings.Add(DSValuesField.Value);
  3981.           DataSet.Next;
  3982.         end;
  3983.         Result := True;
  3984.       except
  3985.         FreeAndNil(ValuesStrings);
  3986.         FreeAndNil(ItemsStrings);
  3987.       end;
  3988.     end;
  3989.   end
  3990. end;
  3991.  
  3992. function TCustomQueryButtons.VisibleButtons: TWebComponentList;
  3993. begin
  3994.   if WebFieldControls.Count > 0 then
  3995.     Result := WebFieldControls
  3996.   else
  3997.   begin
  3998.     GetDefaultButtons;
  3999.     Result := DefaultWebComponents;
  4000.   end;
  4001. end;
  4002.  
  4003.  
  4004. function TCustomQueryButtons.ImplCanAddClass(AParent: TComponent; AClass: TClass): Boolean;
  4005. begin
  4006.   Result := AClass.InheritsFrom(TQueryButton) or
  4007.      CanAddClassHelper(Self, AParent, AClass);
  4008.  
  4009. end;
  4010.  
  4011. { TWebStatus }
  4012.  
  4013. function TWebStatus.ControlContent(Options: TWebContentOptions): string;
  4014. var
  4015.   Attrs: string;
  4016.   Events: string;
  4017. begin
  4018.   AddQuotedAttrib(Attrs, 'NAME', GetHTMLControlName);
  4019.   AddIntAttrib(Attrs, 'SIZE', DisplayWidth);
  4020.   AddQuotedAttrib(Attrs, 'STYLE', Style);
  4021.   AddQuotedAttrib(Attrs, 'CLASS', StyleRule);
  4022.   AddCustomAttrib(Attrs, Custom);
  4023.   if (not (coNoScript in Options.Flags)) then
  4024.     Events := EventContent(Options);
  4025.   Result := Format('<INPUT TYPE=TEXT%0:s%1:s>', [Attrs, Events]);
  4026. end;
  4027.  
  4028. constructor TWebStatus.Create(AOwner: TComponent);
  4029. begin
  4030.   inherited;
  4031.   FDisplayWidth := 1;
  4032.   FCaption := '*';
  4033. end;
  4034.  
  4035. function TWebStatus.GetCaption: string;
  4036. begin
  4037.   Result := FCaption;
  4038.   if Result = '' then
  4039.     Result := Name;
  4040. end;
  4041.  
  4042. function TWebStatus.ImplGetHTMLControlName: string;
  4043. begin
  4044.   Result := Name;
  4045.   if Result = '' then
  4046.     Result := Copy(ClassName, 2, Length(ClassName));
  4047. end;
  4048.  
  4049. class function TWebStatus.Identifier: string;
  4050. begin
  4051.   Result := '*';    // No not localize
  4052. end;
  4053.  
  4054. { TWebControlGroup }
  4055.  
  4056. constructor TWebControlGroup.Create(AOwner: TComponent);
  4057. begin
  4058.   inherited;
  4059.   FWebComponents := TWebComponentList.Create(Self);
  4060.   FDefaultField := False;
  4061. end;
  4062.  
  4063. destructor TWebControlGroup.Destroy;
  4064. begin
  4065.   inherited;
  4066.   if FContainer <> nil then
  4067.     FContainer.Remove(Self);
  4068.   FWebComponents.Free;
  4069.   FDefaultWebComponents.Free;
  4070. end;
  4071.  
  4072. function TWebControlGroup.GetIndex: Integer;
  4073. begin
  4074.   Result := FContainer.IndexOf(Self);
  4075. end;
  4076.  
  4077. procedure TWebControlGroup.SetContainer(Container: TWebComponentContainer);
  4078. begin
  4079.   SetWebParent((Container as TWebComponentList).ParentComponent);
  4080. end;
  4081.  
  4082. procedure TWebControlGroup.SetIndex(Value: Integer);
  4083. begin
  4084.   FContainer.SetComponentIndex(Self, Value)
  4085. end;
  4086.  
  4087. function TWebControlGroup.GetParentComponent: TComponent;
  4088. begin
  4089.   if Assigned(FWebParent) then
  4090.     Result := FWebParent
  4091.   else
  4092.     Result := inherited GetParentComponent;
  4093. end;
  4094.  
  4095. function TWebControlGroup.HasParent: Boolean;
  4096. begin
  4097.   if Assigned(FWebParent) then
  4098.     Result := True
  4099.   else
  4100.     Result := inherited HasParent;
  4101. end;
  4102.  
  4103. procedure TWebControlGroup.ReadState(Reader: TReader);
  4104. begin
  4105.   inherited ReadState(Reader);
  4106.   SetWebParent(Reader.Parent);
  4107. end;
  4108.  
  4109. procedure TWebControlGroup.SetParentComponent(AParent: TComponent);
  4110. begin
  4111.   if not (csLoading in ComponentState) then
  4112.     SetWebParent(AParent);
  4113. end;
  4114.  
  4115. function TWebControlGroup.GetContainer: TWebComponentContainer;
  4116. begin
  4117.   Result := FContainer;
  4118. end;
  4119.  
  4120. procedure TWebControlGroup.SetComponentList(List: TObject);
  4121. begin
  4122.   Assert((List = nil) or (List is TWebComponentList));
  4123.   FContainer := TWebComponentList(List);
  4124. end;
  4125.  
  4126. function TWebControlGroup.GetComponentList: TObject;
  4127. begin
  4128.   Result := FWebComponents;
  4129. end;
  4130.  
  4131. function TWebControlGroup.GetDefaultComponentList: TObject;
  4132. begin
  4133.   Result := FDefaultWebComponents;
  4134. end;
  4135.  
  4136. procedure TWebControlGroup.SetWebParent(const Value: TComponent);
  4137. var
  4138.   List: IGetWebComponentList;
  4139. begin
  4140.   if Value <> FWebParent then
  4141.   begin
  4142.     if Assigned(Value) and (csDesigning in ComponentState) then
  4143.       ValidateWebParent(Self, Value);
  4144.     if FWebParent <> nil then
  4145.     begin
  4146.       FWebParent.GetInterface(IGetWebComponentList, List);
  4147.       if FDefaultField then
  4148.         (List.GetDefaultComponentList as TWebComponentList).Remove(Self)
  4149.       else
  4150.         (List.GetComponentList as TWebComponentList).Remove(Self)
  4151.     end;
  4152.     if Value <> nil then
  4153.     begin
  4154.       Value.GetInterface(IGetWebComponentList, List);
  4155.       if FDefaultField then
  4156.         (List.GetDefaultComponentList as TWebComponentList).Add(Self)
  4157.       else
  4158.         (List.GetComponentList as TWebComponentList).Add(Self)
  4159.     end;
  4160.     FWebParent := Value;
  4161.   end;
  4162. end;
  4163.  
  4164. procedure TWebControlGroup.GetChildren(Proc: TGetChildProc;
  4165.   Root: TComponent);
  4166. var
  4167.   I: Integer;
  4168.   WebComponent: TComponent;
  4169. begin
  4170.   for I := 0 to FWebComponents.Count - 1 do
  4171.   begin
  4172.     WebComponent := FWebComponents.WebComponents[I];
  4173.     if WebComponent.Owner = Root then Proc(WebComponent);
  4174.   end;
  4175. end;
  4176.  
  4177.  
  4178. procedure TWebControlGroup.SetChildOrder(Component: TComponent;
  4179.   Order: Integer);
  4180. var
  4181.   Intf: IWebComponent;
  4182. begin
  4183.   if FWebComponents.IndexOf(Component) >= 0 then
  4184.     if Component.GetInterface(IWebComponent, Intf) then
  4185.       Intf.Index := Order
  4186.     else
  4187.       Assert(False, 'Interface not supported');
  4188. end;
  4189.  
  4190. procedure TWebControlGroup.AddElements(AddIntf: IAddScriptElements);
  4191. begin
  4192.   inherited;
  4193.   ImplAddElements(AddIntf);
  4194. end;
  4195.  
  4196. function TWebControlGroup.CanAddClass(AParent: TComponent; AClass: TClass): Boolean;
  4197. begin
  4198.   Result := ImplCanAddClass(AParent, AClass);
  4199. end;
  4200.  
  4201. function TWebControlGroup.GetSubComponents: TObject;
  4202. begin
  4203.   Result := ImplGetSubComponents;
  4204. end;
  4205.  
  4206. procedure TWebControlGroup.ImplAddElements(AddIntf: IAddScriptElements);
  4207. begin
  4208.   inherited;
  4209.   //
  4210. end;
  4211.  
  4212. function TWebControlGroup.ImplCanAddClass(AParent: TComponent; AClass: TClass): Boolean;
  4213. begin
  4214.   Result := True;
  4215. end;
  4216.  
  4217. function TWebControlGroup.Content(Options: TWebContentOptions;
  4218.   ParentLayout: TLayout): string;
  4219. begin
  4220.   Result := ImplContent(Options, ParentLayout);
  4221. end;
  4222.  
  4223. function TWebControlGroup.ImplContent(Options: TWebContentOptions;
  4224.   ParentLayout: TLayout): string;
  4225. begin
  4226.   Result := '';
  4227. end;
  4228.  
  4229. function TWebControlGroup.GetLayoutAttributes: TLayoutAttributes;
  4230. begin
  4231.   Result := nil;
  4232. end;
  4233.  
  4234. function TWebControlGroup.ImplGetSubComponents: TObject;
  4235. begin
  4236.   Result := WebFieldControls;
  4237. end;
  4238.  
  4239. { TXMLDisplayGroup }
  4240.  
  4241. constructor TXMLDisplayGroup.Create(AComponent: TComponent);
  4242. begin
  4243.   inherited;
  4244.   FEnableValidateFields := True;
  4245.   FXMLDataSet := TXMLDataSet.Create(Self);
  4246.   FXMLDataSet.OnChange := XMLDataChange;
  4247. end;
  4248.  
  4249. procedure TXMLDisplayGroup.XMLDataChange(Sender: TObject);
  4250. begin
  4251.   FreeAndNil(FDefaultWebComponents);
  4252.   EnableValidateFields := True;
  4253. end;
  4254.  
  4255. destructor TXMLDisplayGroup.Destroy;
  4256. begin
  4257.   inherited;
  4258.   FXMLDataSet.Free;
  4259. end;
  4260.  
  4261. procedure TXMLDisplayGroup.Notification(AComponent: TComponent;
  4262.   Operation: TOperation);
  4263. begin
  4264.   inherited Notification(AComponent, Operation);
  4265.   if Assigned(XMLDataSet) then
  4266.     XMLDataSet.Notification(AComponent, Operation);
  4267. end;
  4268.  
  4269. function TXMLDisplayGroup.GetXmlDisplayName: string;
  4270. begin
  4271.   Result := Format(ScriptXMLDisplayName, [Self.Name]);
  4272. end;
  4273.  
  4274. function TXMLDisplayGroup.GetVisibleFields: TWebComponentList;
  4275. begin
  4276.   if FWebComponents.Count > 0 then
  4277.     Result := FWebComponents
  4278.   else
  4279.   begin
  4280.     if Assigned(FDefaultWebComponents) and
  4281.       (FDefaultWebComponents.Count = 0) then
  4282.       FreeAndNil(FDefaultWebComponents);
  4283.     if not Assigned(FDefaultWebComponents) then
  4284.       CreateDefaultFields;
  4285.     Result := FDefaultWebComponents;
  4286.   end;
  4287. end;
  4288.  
  4289. procedure TXMLDisplayGroup.CreateDefaultFields;
  4290. var
  4291.   DataSet: IMidasWebDataSet;
  4292.   WebComponent: IWebComponent;
  4293.   DataSetField: IDataSetField;
  4294.   FieldControl: TComponent;
  4295.   FieldClass: TComponentClass;
  4296.   List: TStrings;
  4297.   I: integer;
  4298. begin
  4299.   FDefaultWebComponents := TWebComponentList.Create(Self);
  4300.   DataSet := XMLDataSet.DataSet;
  4301.   if (DataSet <> nil) then
  4302.   begin
  4303.     List := TStringList.Create;
  4304.     try
  4305.       GetFieldsList(List);
  4306.       for I := 0 to List.Count - 1 do
  4307.       begin
  4308.         if not IsFieldInUse(List[I]) then
  4309.         begin
  4310.           FieldClass := TComponentClass(List.Objects[I]);
  4311.           FieldControl := FieldClass.Create(nil);  // not owned
  4312.           FieldControl.GetInterface(IWebComponent, WebComponent);
  4313.           WebComponent.Container := Self.WebFieldControls;
  4314.           if FieldControl.GetInterface(IDataSetField, DataSetField) then
  4315.              DataSetField.FieldName := List[I];
  4316.         end;
  4317.       end;
  4318.     finally
  4319.       List.Free;
  4320.     end;
  4321.   end;
  4322. end;
  4323.  
  4324. function TXMLDisplayGroup.FindField(const AName: string): TComponent;
  4325. var
  4326.   I: Integer;
  4327.   DataSetField: IDataSetField;
  4328. begin
  4329.   for I := 0 to FWebComponents.Count - 1 do
  4330.   begin
  4331.     if FWebComponents.WebComponents[I].GetInterface(IDataSetField, DataSetField) then
  4332.     begin
  4333.       Result := FWebComponents.WebComponents[I];
  4334.       if AnsiCompareText(DataSetField.FieldName, AName) = 0 then Exit;
  4335.     end;
  4336.   end;
  4337.   Result := nil;
  4338. end;
  4339.  
  4340. function TXMLDisplayGroup.GetDataSet: IMidasWebDataSet;
  4341. begin
  4342.   Result := XMLDataSet.DataSet;
  4343. end;
  4344.  
  4345. procedure TXMLDisplayGroup.GetFieldsList(List: TStrings);
  4346. var
  4347.   I: Integer;
  4348.   DataSet: IMidasWebDataSet;
  4349.   TextClass: TWebDataInputClass;
  4350.   StatusClass: TWebStatusClass;
  4351. begin
  4352.   if ImplCanAddClass(Self, TFieldText) then
  4353.     TextClass := TFieldText
  4354.   else if ImplCanAddClass(Self, TQueryText) then
  4355.     TextClass := TQueryText
  4356.   else if ImplCanAddClass(Self, TTextColumn) then
  4357.     TextClass := TTextColumn
  4358.   else
  4359.     TextClass := nil;
  4360.  
  4361.   if ImplCanAddClass(Self, TFieldStatus) then
  4362.     StatusClass := TFieldStatus
  4363.   else if ImplCanAddClass(Self, TStatusColumn) then
  4364.     StatusClass := TStatusColumn
  4365.   else
  4366.     StatusClass := nil;
  4367.   List.Clear;
  4368.   DataSet := XMLDataSet.DataSet;
  4369.   if (DataSet <> nil) then
  4370.     with Dataset do
  4371.     begin
  4372.       if Assigned(TextClass) then
  4373.         for I := 0 to FieldCount - 1 do
  4374.           if not (Fields[I].DataType in [ftADT, ftArray, ftDataSet]) then
  4375.             List.AddObject(Fields[I].FullName, TObject(TextClass));
  4376.       if Assigned(StatusClass) then
  4377.         List.AddObject(TWebStatus.Identifier, TObject(StatusClass));
  4378.     end;
  4379. end;
  4380.  
  4381. function TXMLDisplayGroup.GetXMLBroker: TXMLBroker;
  4382. begin
  4383.   Result := XMLDataSet.XMLBroker;
  4384. end;
  4385.  
  4386. function TXMLDisplayGroup.IsFieldInUse(AName: string): Boolean;
  4387. begin
  4388.   Result := FindField(AName) <> nil;
  4389. end;
  4390.  
  4391. function TXMLDisplayGroup.HasStatusField: Boolean;
  4392. var
  4393.   StatusField: IStatusField;
  4394.   I: Integer;
  4395. begin
  4396.   Result := False;
  4397.   for I := 0 to WebFieldControls.Count - 1 do
  4398.     if WebFieldControls.WebComponents[I].GetInterface(IStatusField, StatusField) then
  4399.     begin
  4400.       Result := True;
  4401.       break;
  4402.     end;
  4403. end;
  4404.  
  4405. function TXMLDisplayGroup.GetXMLDataSet: TXMLDataSet;
  4406. begin
  4407.   Result := FXMLDataSet;
  4408. end;
  4409.  
  4410. function TXMLDisplayGroup.GetDataSetField: string;
  4411. begin
  4412.   Result := FXMLDataSet.DataSetField;
  4413. end;
  4414.  
  4415. procedure TXMLDisplayGroup.SetDataSetField(const Value: string);
  4416. begin
  4417.   FXMLDataSet.DataSetField := Value;
  4418. end;
  4419.  
  4420. procedure TXMLDisplayGroup.SetXMLBroker(const Value: TXMLBroker);
  4421. begin
  4422.   FXMLDataSet.XMLBroker := Value;
  4423. end;
  4424.  
  4425. procedure TXMLDisplayGroup.ValidateDataSet;
  4426. begin
  4427.   if not Assigned(XMLBroker) then
  4428.     raise EComponentError.CreateResFmt(@sNoXMLBroker, [Name]);
  4429. end;
  4430.  
  4431. function TXMLDisplayGroup.GetXMLRowSetName: string;
  4432. begin
  4433.   if Assigned(XMLDataSet.XMLBroker) then
  4434.     Result := XMLDataSet.XMLBroker.RowSetVarName(XMLDataSet.DataSetPath)
  4435.   else
  4436.     Result := '';
  4437. end;
  4438.  
  4439. function TXMLDisplayGroup.GetIsMultipleRecordView: Boolean;
  4440. begin
  4441.   Result := ImplIsMultipleRecordView;
  4442. end;
  4443.  
  4444. function TXMLDisplayGroup.ImplIsMultipleRecordView: Boolean;
  4445. begin
  4446.   Result := False;
  4447. end;
  4448.  
  4449. function TXMLDisplayGroup.ValidateFields(AddIntf: IAddScriptElements): Boolean;
  4450. var
  4451.   I: Integer;
  4452.   ValidateField: IValidateField;
  4453. begin
  4454.   if EnableValidateFields then
  4455.   begin
  4456.     EnableValidateFields := False;
  4457.     for I := 0 to VisibleFields.Count - 1 do
  4458.       if VisibleFields[I].GetInterface(IValidateField, ValidateField) then
  4459.         if not ValidateField.ValidateField(XMLDataSet.DataSet, AddIntf) then
  4460.           EnableValidateFields := True;
  4461.   end;
  4462.   Result := not EnableValidateFields;
  4463. end;
  4464.  
  4465. function TXMLDisplayGroup.GetEnableValidateFields: Boolean;
  4466. begin
  4467.   Result := FEnableValidateFields;
  4468. end;
  4469.  
  4470. procedure TXMLDisplayGroup.SetEnableValidateFields(Value: Boolean);
  4471. begin
  4472.   FEnableValidateFields := Value;
  4473. end;
  4474.  
  4475. function TXMLDisplayGroup.ImplGetSubComponents: TObject;
  4476. begin
  4477.   Result := VisibleFields;
  4478. end;
  4479.  
  4480. procedure TXMLDisplayGroup.ImplAddElements(AddIntf: IAddScriptElements);
  4481. begin
  4482.   inherited;
  4483.   if Assigned(XMLBroker) and not (XMLBroker.Connected) then
  4484.     AddIntf.AddError(Format(sXMLBrokerNotConnected, [XMLBroker.Name]));
  4485. end;
  4486.  
  4487. { TCustomDataGrid }
  4488.  
  4489. constructor TCustomDataGrid.Create(AOwner: TComponent);
  4490. begin
  4491.   inherited;
  4492.   FDisplayRows := 4;
  4493.   FTableAttributes := TGridAttributes.Create(Self);
  4494.   FHeadingAttributes := TGridRowAttributes.Create(Self);
  4495.   FRowAttributes := TGridRowAttributes.Create(Self);
  4496.   FTableAttributes.Border := 1;
  4497. end;
  4498.  
  4499. function TCustomDataGrid.FormatTable(Layout: TLayoutWebContent;
  4500.   Options: TWebContentOptions): string;
  4501.  
  4502.   function TableHeader: string;
  4503.   var
  4504.     Attribs: string;
  4505.   begin
  4506.     with TableAttributes do
  4507.     begin
  4508.       Attribs := Attribs + HTMLAlign[Align];
  4509.       AddIntAttrib(Attribs, 'CELLSPACING', CellSpacing);
  4510.       AddIntAttrib(Attribs, 'CELLPADDING', CellPadding);
  4511.       AddIntAttrib(Attribs, 'BORDER', Border);
  4512.       AddStringAttrib(Attribs, 'BGCOLOR', BgColor);
  4513.       AddQuotedAttrib(Attribs, 'STYLE', Style);
  4514.       AddQuotedAttrib(Attribs, 'CLASS', StyleRule);
  4515.       AddCustomAttrib(Attribs, Custom);
  4516.     end;
  4517.     Result := Format(#13#10'<TABLE%s>', [Attribs]);
  4518.   end;
  4519.  
  4520.   function RowHeader(HeadingAttributes: TGridRowAttributes): string;
  4521.   var
  4522.     Attribs: string;
  4523.   begin
  4524.     with HeadingAttributes do
  4525.     begin
  4526.       Attribs := Attribs + HTMLAlign[Align];
  4527.       Attribs := Attribs + HTMLVAlign[VAlign];
  4528.       AddQuotedAttrib(Attribs, 'BGCOLOR', BgColor);
  4529.       AddQuotedAttrib(Attribs, 'STYLE', Style);
  4530.       AddQuotedAttrib(Attribs, 'CLASS', StyleRule);
  4531.       AddCustomAttrib(Attribs, Custom);
  4532.     end;
  4533.     Result := Format('<TR%s>', [Attribs]);
  4534.   end;
  4535.  
  4536. var
  4537.   I: Integer;
  4538.   OneRow: string;
  4539.   Field: TWebDataDisplay;
  4540.   RowHeaderStr: string;
  4541.   FormatColumn: IFormatColumn;
  4542. begin
  4543.   Result := TableHeader + RowHeader(HeadingAttributes) + #13#10;
  4544.   for I := 0 to VisibleFields.Count - 1 do
  4545.   begin
  4546.     if VisibleFields[I] is TWebDataDisplay then
  4547.     begin
  4548.       Field := TWebDataDisplay(VisibleFields[I]);
  4549.       if Field.GetInterface(IFormatColumn, FormatColumn) then
  4550.       begin
  4551.         Result := Result + FormatColumn.FormatColumnHeading;
  4552.         OneRow := OneRow + FormatColumn.FormatColumnData(Field.Content(Options, Layout));
  4553.       end
  4554.       else
  4555.       begin
  4556.         // Default formatting
  4557.         Result := Result + FormatColumnHeading(Field);
  4558.         OneRow := OneRow + FormatColumnData(Field, Field.Content(Options, Layout));
  4559.       end;
  4560.     end;
  4561.   end;
  4562.   Result := Result + '</TR>';
  4563.   RowHeaderStr := RowHeader(RowAttributes);
  4564.   for I := 0 to DisplayRows - 1 do
  4565.     Result := Format('%0:s%1:s%2:s</TR>'#13#10, [Result, RowHeaderStr, OneRow]);
  4566.   Result := Result + '</TABLE>';
  4567. end;
  4568.  
  4569. function TCustomDataGrid.ImplContent(Options: TWebContentOptions; ParentLayout: TLayout): string;
  4570. var
  4571.   TableLayout: TGridLayout;
  4572.   Intf: ILayoutWebContent;
  4573. begin
  4574.   TableLayout := TGridLayout.Create(ParentLayout);
  4575.   try
  4576.     Result := FormatTable(TableLayout, Options);
  4577.   finally
  4578.     TableLayout.Free;
  4579.   end;
  4580.   if Assigned(ParentLayout) and ParentLayout.GetInterface(ILayoutWebContent, Intf) then
  4581.     Result := Intf.LayoutTable(Result, GetLayoutAttributes)
  4582. end;
  4583.  
  4584. procedure TCustomDataGrid.SetTableAttributes(
  4585.   const Value: TGridAttributes);
  4586. begin
  4587.   FTableAttributes.Assign(Value);
  4588. end;
  4589.  
  4590. destructor TCustomDataGrid.Destroy;
  4591. begin
  4592.   inherited;
  4593.   FTableAttributes.Free;
  4594.   FHeadingAttributes.Free;
  4595.   FRowAttributes.Free;
  4596. end;
  4597.  
  4598. procedure TCustomDataGrid.SetHeadingAttributes(
  4599.   const Value: TGridRowAttributes);
  4600. begin
  4601.   FHeadingAttributes.Assign(Value);
  4602. end;
  4603.  
  4604. function TCustomQueryForm.ImplCanAddClass(AParent: TComponent; AClass: TClass): Boolean;
  4605. begin
  4606.   Result := AClass.InheritsFrom(TCustomQueryButtons) or
  4607.     AClass.InheritsFrom(TQueryFieldGroup)
  4608.     or
  4609.     AClass.InheritsFrom(TCustomLayoutGroup);
  4610. end;
  4611.  
  4612. function TCustomDataGrid.ImplCanAddClass(AParent: TComponent; AClass: TClass): Boolean;
  4613. begin
  4614.   Result := AClass.InheritsFrom(TWebDataDisplay) and
  4615.     TWebDataInputClass(AClass).IsColumn;
  4616. end;
  4617.  
  4618. procedure TCustomDataGrid.ImplAddElements(AddIntf: IAddScriptElements);
  4619. begin
  4620.   inherited;
  4621.   if Assigned(XMLDataSet.XMLBroker) then
  4622.   begin
  4623.     AddIntf.AddRowSet(XMLDataSet.XMLBroker, XMLDataSet.DataSetPath);
  4624.     DefineXMLDisplayBlock(AddIntf, Self, GetXMLRowSetName);
  4625.   end
  4626.   else
  4627.     AddIntf.AddError(Format(sXMLBrokerNotDefined, [Self.Name]));
  4628. end;
  4629.  
  4630. procedure TCustomDataGrid.SetRowAttributes(
  4631.   const Value: TGridRowAttributes);
  4632. begin
  4633.   FRowAttributes.Assign(Value);
  4634. end;
  4635.  
  4636. function TCustomDataGrid.ImplIsMultipleRecordView: Boolean;
  4637. begin
  4638.   Result := True;
  4639. end;
  4640.  
  4641. { TXMLData }
  4642.  
  4643. procedure TXMLData.Changed;
  4644. begin
  4645.   if Assigned(FOnChange) then FOnChange(Self);
  4646. end;
  4647.  
  4648. procedure TXMLData.ChangedXMLBroker;
  4649. begin
  4650.   Changed;
  4651. end;
  4652.  
  4653. constructor TXMLData.Create(AParent: TComponent);
  4654. begin
  4655.   inherited Create;
  4656.   FParent := AParent;
  4657. end;
  4658.  
  4659. procedure TXMLData.Notification(AComponent: TComponent;
  4660.   Operation: TOperation);
  4661. begin
  4662.   if (Operation = opRemove) and (AComponent = FXMLBroker) then
  4663.     XMLBroker := nil;
  4664. end;
  4665.  
  4666. procedure TXMLData.SetXMLBroker(const Value: TXMLBroker);
  4667. begin
  4668.   if FXMLBroker <> Value then
  4669.   begin
  4670.     FXMLBroker := Value;
  4671.     if Value <> nil then Value.FreeNotification(FParent);
  4672.     ChangedXMLBroker;
  4673.     // Automatically connect when setting the XMLBroker property
  4674.     if not (csLoading in FParent.ComponentState) then
  4675.       if Assigned(FXMLBroker) then
  4676.         FXMLBroker.Connected := True;
  4677.   end;
  4678. end;
  4679.  
  4680. function TXMLData.GetXMLBroker: TXMLBroker;
  4681. begin
  4682.   Result := FXMLBroker;
  4683. end;
  4684.  
  4685. { TXMLDataSet }
  4686.  
  4687. procedure TXMLDataSet.ChangedDataSetField;
  4688. begin
  4689.   if Assigned(FDataSet) then
  4690.   begin
  4691.     FDataSet.RemoveOnDataChange(WrapperDataChange);
  4692.     // Add to list to avoid destroying
  4693.     // TClientDataSet in a notification
  4694.     FDiscardDataSetList.Add(FDataSet);
  4695.   end;
  4696.   FDataSet := nil;
  4697.   Changed;
  4698. end;
  4699.  
  4700. procedure TXMLDataSet.ChangedXMLBroker;
  4701. begin
  4702.   if Assigned(FDataSet) then
  4703.   begin
  4704.     FDataSet.RemoveOnDataChange(WrapperDataChange);
  4705.     // Add to list to avoid destroying
  4706.     // a TClientDataSet in a notification
  4707.     FDiscardDataSetList.Add(FDataSet);
  4708.   end;
  4709.   FDataSet := nil;
  4710.   if not (csLoading in FParent.ComponentState) then
  4711.     FDataSetField := '';
  4712.   inherited;
  4713. end;
  4714.  
  4715. constructor TXMLDataSet.Create(AParent: TComponent);
  4716. begin
  4717.   inherited;
  4718.   XMLDataSetList.Add(Self);
  4719.   FDiscardDataSetList := TInterfaceList.Create;
  4720. end;
  4721.  
  4722. function TXMLDataSet.GetDataSetPath: TStrings;
  4723. var
  4724.   Dot: Integer;
  4725.   FieldName: string;
  4726.   S: string;
  4727. begin
  4728.   if not Assigned(FDataSetPath) then
  4729.     FDataSetPath := TStringList.Create;
  4730.   FDataSetPath.Clear;
  4731.   S := DataSetField;
  4732.   while S <> '' do
  4733.   begin
  4734.     Dot := Pos('.', S);
  4735.     if Dot = 0 then
  4736.     begin
  4737.       FieldName := Trim(S);
  4738.       S := '';
  4739.     end
  4740.     else
  4741.     begin
  4742.       FieldName := Trim(Copy(S, 1, Dot-1));
  4743.       System.Delete(S, 1, Dot);
  4744.     end;
  4745.     if FieldName <> '' then
  4746.       FDataSetPath.Add(FieldName);
  4747.   end;
  4748.   Result := FDataSetPath;
  4749. end;
  4750.  
  4751. function TXMLDataSet.CreateDataSet: IMidasWebDataSet;
  4752. var
  4753.   Wrapper: TDataSetWrapper;
  4754.   Field: TField;
  4755.   I: Integer;
  4756.   FieldName: string;
  4757.   ProvComp: TComponent;
  4758. begin
  4759.   Wrapper := nil;
  4760.   if Assigned(XMLBroker) and (XMLBroker.Connected) then
  4761.   begin
  4762.     Wrapper := TDataSetWrapper.Create;
  4763.     try
  4764.       if Assigned(XMLBroker.Owner) and (XMLBroker.ProviderName <> '') and (not Assigned(XMLBroker.RemoteServer)) then
  4765.       begin
  4766.         ProvComp := XMLBroker.Owner.FindComponent(XMLBroker.ProviderName);
  4767.         if Assigned(ProvComp) and (ProvComp is TCustomProvider) then
  4768.           Wrapper.FDataSet.SetProvider(ProvComp)
  4769.       end
  4770.       else
  4771.       begin
  4772.         Wrapper.FDataSet.RemoteServer := XMLBroker.RemoteServer;
  4773.         Wrapper.FDataSet.ProviderName := XMLBroker.ProviderName;
  4774.       end;
  4775.       Wrapper.FDataSet.PacketRecords := 0; // Meta data only
  4776.       Wrapper.FDataSet.Active := True;
  4777.       Wrapper.FDetailDataSet := Wrapper.FDataSet;
  4778.       for I := 0 to DataSetPath.Count - 1 do
  4779.       begin
  4780.         FieldName := DataSetPath[I];
  4781.         if FieldName = '' then
  4782.           raise Exception.CreateRes(@sDataSetFieldBlank);
  4783.         Field := Wrapper.FDetailDataSet.Fields.FieldByName(FieldName);
  4784.         if not Assigned(Field) then
  4785.           raise Exception.CreateResFmt(@sDataSetFieldNotFound, [FieldName]);
  4786.         if not (Field is TDataSetField) then
  4787.           raise Exception.CreateResFmt(@sNotDataSetField, [FieldName]);
  4788.         Wrapper.FDetailDataSet := TDataSetField(Field).NestedDataSet;
  4789.         Assert(Assigned(Wrapper.FDetailDataSet), 'NestedDataSet is nil');
  4790.       end
  4791.     except
  4792.       Wrapper.Free;
  4793.       Wrapper := nil;
  4794.       Application.HandleException(Self);
  4795.     end;
  4796.   end;
  4797.   if Assigned(Wrapper) then
  4798.   begin
  4799.     Result := Wrapper as IMidasWebDataSet;
  4800.     Result.AddOnDataChange(WrapperDataChange);
  4801.   end
  4802.   else
  4803.     Result := nil;
  4804. end;
  4805.  
  4806. procedure TXMLDataSet.WrapperDataChange(Sender: TObject);
  4807. begin
  4808.   FDataSet.RemoveOnDataChange(WrapperDataChange);
  4809.   // Add to list to avoid destroying
  4810.   // a TClientDataSet in a notification
  4811.   FDiscardDataSetList.Add(FDataSet);
  4812.   FDataSet := nil;
  4813.   Changed;
  4814. end;
  4815.  
  4816. function TXMLDataSet.FindDataSet: IMidasWebDataSet;
  4817. var
  4818.   I: Integer;
  4819.   XMLDataSet: TXMLDataSet;
  4820. begin
  4821.   for I := 0 to XMLDataSetList.Count - 1 do
  4822.   begin
  4823.     XMLDataSet := TXMLDataSet(XMLDataSetList[I]);
  4824.     Result := XMLDataSet.FDataSet;
  4825.     if (Result <> nil) and (CompareXMLData(XMLDataSet)) then
  4826.       Exit;
  4827.   end;
  4828.   Result := nil;
  4829. end;
  4830.  
  4831. function TXMLDataSet.GetDataSet: IMidasWebDataSet;
  4832. begin
  4833.   if not Assigned(FDataSet) then
  4834.   begin
  4835.     FDiscardDataSetList.Clear;
  4836.     FDataSet := FindDataSet;
  4837.     if not Assigned(FDataSet) then
  4838.       FDataSet := CreateDataSet
  4839.     else
  4840.       FDataSet.AddOnDataChange(WrapperDataChange);
  4841.   end;
  4842.   Result := FDataSet;
  4843. end;
  4844.  
  4845. procedure TXMLDataSet.SetDataSetField(const Value: string);
  4846. begin
  4847.   if FDataSetField <> Value then
  4848.   begin
  4849.     FDataSetField := Value;
  4850.     ChangedDataSetField;
  4851.   end;
  4852. end;
  4853.  
  4854. destructor TXMLDataSet.Destroy;
  4855. begin
  4856.   if Assigned(FDataSet) then
  4857.     FDataSet.RemoveOnDataChange(WrapperDataChange);
  4858.   if XMLBroker <> nil then
  4859.     XMLBroker.RemoveNotify(Self);
  4860.   inherited;
  4861.   FDataSetPath.Free;
  4862.   XMLDataSetList.Remove(Self);
  4863. end;
  4864.  
  4865. function TXMLDataSet.CompareXMLData(XMLDataSet: TXMLDataSet): Boolean;
  4866. begin
  4867.   Result := (XMLBroker = XMLDataSet.XMLBroker)
  4868.      and (DataSetField = XMLDataSet.DataSetField);
  4869. end;
  4870.  
  4871. function TXMLDataSet.GetDataSetField: string;
  4872. begin
  4873.   Result := FDataSetField;
  4874. end;
  4875.  
  4876. function TXMLDataSet._AddRef: Integer;
  4877. begin
  4878.   Result := -1;
  4879. end;
  4880.  
  4881. function TXMLDataSet._Release: Integer;
  4882. begin
  4883.   Result := -1;
  4884. end;
  4885.  
  4886. function TXMLDataSet.QueryInterface(const IID: TGUID; out Obj): HResult;
  4887. begin
  4888.   if GetInterface(IID, Obj) then Result := S_OK
  4889.   else Result := E_NOINTERFACE
  4890. end;
  4891.  
  4892. procedure TXMLDataSet.ConnectionChange(Sender: TComponent;
  4893.   Connecting: Boolean);
  4894. begin
  4895.   Changed;
  4896. end;
  4897.  
  4898. procedure TXMLDataSet.SetXMLBroker(const Value: TXMLBroker);
  4899. begin
  4900.   if XMLBroker <> nil then
  4901.     XMLBroker.RemoveNotify(Self);
  4902.   inherited;
  4903.   if XMLBroker <> nil then
  4904.     XMLBroker.AddNotify(Self);
  4905. end;
  4906.  
  4907. { TXMLDataSetParent }
  4908.  
  4909. procedure TXMLDataSetParent.ChangedUseParent;
  4910. begin
  4911.   if UseParent then
  4912.   begin
  4913.     FXMLBroker := nil;
  4914.     FDataSetField := '';
  4915.   end;
  4916.   Changed;
  4917. end;
  4918.  
  4919. procedure TXMLDataSetParent.SetUseParent(const Value: Boolean);
  4920. begin
  4921.   if Value <> FUseParent then
  4922.   begin
  4923.     FUseParent := Value;
  4924.     ChangedUseParent;
  4925.   end;
  4926. end;
  4927.  
  4928. procedure TXMLDataSetParent.ChangedDataSetField;
  4929. begin
  4930.   if not (csLoading in Parent.ComponentState) then
  4931.     FUseParent := False;
  4932.   inherited;
  4933. end;
  4934.  
  4935. procedure TXMLDataSetParent.ChangedXMLBroker;
  4936. begin
  4937.   if Assigned(Parent) and not (csLoading in Parent.ComponentState) then
  4938.     FUseParent := False;
  4939.   inherited;
  4940. end;
  4941.  
  4942. function TXMLDataSetParent.ParentDataSetField: string;
  4943. var
  4944.   XMLDataSet: TXMLDataSet;
  4945. begin
  4946.   XMLDataSet := ParentXMLDataSet;
  4947.   if Assigned(XMLDataSet) then
  4948.     Result := XMLDataSet.DataSetField
  4949.   else
  4950.     Result := '';
  4951. end;
  4952.  
  4953. function TXMLDataSetParent.GetDataSetField: string;
  4954. begin
  4955.   if not UseParent then
  4956.     Result := inherited GetDataSetField
  4957.   else
  4958.     Result := ParentDataSetField;
  4959. end;
  4960.  
  4961. function TXMLDataSetParent.ParentXMLBroker: TXMLBroker;
  4962. var
  4963.   XMLDataSet: TXMLDataSet;
  4964. begin
  4965.   XMLDataSet := ParentXMLDataSet;
  4966.   if Assigned(XMLDataSet) then
  4967.     Result := XMLDataSet.XMLBroker
  4968.   else
  4969.     Result := nil;
  4970. end;
  4971.  
  4972. function TXMLDataSetParent.GetXMLBroker: TXMLBroker;
  4973. begin
  4974.   if not UseParent then
  4975.     Result := inherited GetXMLBroker
  4976.   else
  4977.     Result := ParentXMLBroker;
  4978. end;
  4979.  
  4980. function TXMLDataSetParent.ParentXMLDataSet: TXMLDataSet;
  4981. var
  4982.   Component: TComponent;
  4983.   Intf: IDataSetComponent;
  4984. begin
  4985.   Component := Parent.GetParentComponent;
  4986.   while Assigned(Component) do
  4987.   begin
  4988.     if Component.GetInterface(IDataSetComponent, Intf) then
  4989.     begin
  4990.       Result := Intf.XMLDataSet;
  4991.       Exit;
  4992.     end;
  4993.     Component := Component.GetParentComponent;
  4994.   end;
  4995.   Result := nil;
  4996. end;
  4997.  
  4998. { TXMLDataParent }
  4999.  
  5000. procedure TXMLDataParent.ChangedUseParent;
  5001. begin
  5002.   if UseParent then
  5003.     FXMLBroker := nil;
  5004.   Changed;
  5005. end;
  5006.  
  5007. procedure TXMLDataParent.SetUseParent(const Value: Boolean);
  5008. begin
  5009.   if Value <> FUseParent then
  5010.   begin
  5011.     FUseParent := Value;
  5012.     ChangedUseParent;
  5013.   end;
  5014. end;
  5015.  
  5016. procedure TXMLDataParent.ChangedXMLBroker;
  5017. begin
  5018.   if Assigned(Parent) and not (csLoading in Parent.ComponentState) then
  5019.     FUseParent := False;
  5020.   inherited;
  5021. end;
  5022.  
  5023. function TXMLDataParent.ParentXMLBroker: TXMLBroker;
  5024. var
  5025.   Component, XMLDisplay: TComponent;
  5026.   DataSetComponent: IDataSetComponent;
  5027.   XMLDisplayReference: IXMLDisplayReference;
  5028. begin
  5029.   Component := Parent.GetParentComponent;
  5030.   while Assigned(Component) do
  5031.   begin
  5032.     if Component.GetInterface(IXMLDisplayReference, XMLDisplayReference) then
  5033.     begin
  5034.       XMLDisplay := XMLDisplayReference.XMLDisplayComponent;
  5035.       if Assigned(XMLDisplay) and
  5036.         XMLDisplay.GetInterface(IDataSetComponent, DataSetComponent) then
  5037.       begin
  5038.         Result := DataSetComponent.XMLDataSet.XMLBroker;
  5039.         Exit;
  5040.       end;
  5041.     end;
  5042.  
  5043.     if Component.GetInterface(IDataSetComponent, DataSetComponent) then
  5044.     begin
  5045.       Result := DataSetComponent.XMLDataSet.XMLBroker;
  5046.       Exit;
  5047.     end;
  5048.     Component := Component.GetParentComponent;
  5049.   end;
  5050.   Result := nil;
  5051. end;
  5052.  
  5053. function TXMLDataParent.GetXMLBroker: TXMLBroker;
  5054. begin
  5055.   if not UseParent then
  5056.     Result := inherited GetXMLBroker
  5057.   else
  5058.     Result := ParentXMLBroker;
  5059. end;
  5060.  
  5061. { TXMLDisplay }
  5062.  
  5063. procedure TXMLDisplay.Changed;
  5064. begin
  5065.   if Assigned(FOnChange) then FOnChange(Self);
  5066. end;
  5067.  
  5068. procedure TXMLDisplay.ChangedDisplayComponent;
  5069. begin
  5070.   Changed;
  5071. end;
  5072.  
  5073. constructor TXMLDisplay.Create(AParent: TComponent);
  5074. begin
  5075.   inherited Create;
  5076.   FParent := AParent;
  5077. end;
  5078.  
  5079. function TXMLDisplay.GetDisplayComponent: TComponent;
  5080. begin
  5081.   Result := FDisplayComponent;
  5082. end;
  5083.  
  5084. procedure TXMLDisplay.Notification(AComponent: TComponent;
  5085.   Operation: TOperation);
  5086. begin
  5087.   if (Operation = opRemove) and (AComponent = FDisplayComponent) then
  5088.     DisplayComponent := nil;
  5089. end;
  5090.  
  5091. procedure TXMLDisplay.SetDisplayComponent(const Value: TComponent);
  5092. begin
  5093.   if FDisplayComponent <> Value then
  5094.   begin
  5095.     FDisplayComponent := Value;
  5096.     if Value <> nil then Value.FreeNotification(FParent);
  5097.     ChangedDisplayComponent;
  5098.   end;
  5099. end;
  5100.  
  5101. { TXMLDisplayParent }
  5102.  
  5103. procedure TXMLDisplayParent.ChangedDisplayComponent;
  5104. begin
  5105.   if Assigned(Parent) and not (csLoading in Parent.ComponentState) then
  5106.     FUseParent := False;
  5107.   inherited;
  5108. end;
  5109.  
  5110. procedure TXMLDisplayParent.ChangedUseParent;
  5111. begin
  5112.   if UseParent then
  5113.     FDisplayComponent := nil;
  5114.   Changed;
  5115. end;
  5116.  
  5117. constructor TXMLDisplayParent.Create(AParent: TComponent);
  5118. begin
  5119.   inherited;
  5120.   FUseParent := True;
  5121. end;
  5122.  
  5123. function TXMLDisplayParent.GetDisplayComponent: TComponent;
  5124. var
  5125.   Intf: IXMLDisplayReference;
  5126.   Reference: TComponent;
  5127. begin
  5128.   if not UseParent then
  5129.     Result := inherited GetDisplayComponent
  5130.   else
  5131.   begin
  5132.     Reference := Parent;
  5133.     while Assigned(Reference) do
  5134.     begin
  5135.       if Reference.GetInterface(IXMLDisplayReference, Intf) then
  5136.       begin
  5137.         Result := Intf.XMLDisplayComponent;
  5138.         Exit;
  5139.       end;
  5140.       Reference := Reference.GetParentComponent;
  5141.     end;
  5142.     Result := nil;
  5143.   end;
  5144. end;
  5145.  
  5146. procedure TXMLDisplayParent.SetUseParent(const Value: Boolean);
  5147. begin
  5148.   if Value <> FUseParent then
  5149.   begin
  5150.     FUseParent := Value;
  5151.     Changed;
  5152.   end;
  5153. end;
  5154.  
  5155. function TCustomQueryForm.ImplContent(Options: TWebContentOptions;
  5156.   ParentLayout: TLayout): string;
  5157. var
  5158.   FormLayout: TFormLayout;
  5159.  
  5160.   function FormatField(Field: TComponent): string;
  5161.   var
  5162.     Intf: IWebContent;
  5163.   begin
  5164.     if Field.GetInterface(IWebContent, Intf) then
  5165.       Result := Intf.Content(Options, FormLayout)
  5166.     else
  5167.       Result := '';
  5168.   end;
  5169.  
  5170. var
  5171.   I: Integer;
  5172.   Intf: ILayoutWebContent;
  5173. begin
  5174.   FormLayout := TFormLayout.Create(ParentLayout);
  5175.   try
  5176.     Result := GetHTMLFormTag(Options);
  5177.     for I := 0 to VisibleFields.Count - 1 do
  5178.     begin
  5179.       Result := Result +
  5180.         FormatField(VisibleFields[I]);
  5181.     end;
  5182.     Result := Result + FormLayout.EndLayout;
  5183.     Result := Result + '</FORM>';
  5184.     if Assigned(ParentLayout) and ParentLayout.GetInterface(ILayoutWebContent, Intf) then
  5185.       Result := Intf.LayoutField(Result, GetLayoutAttributes)
  5186.   finally
  5187.     FormLayout.Free;
  5188.   end;
  5189. end;
  5190.  
  5191. { TStatusColumn }
  5192.  
  5193. class function TStatusColumn.IsColumn: Boolean;
  5194. begin
  5195.   Result := True;
  5196. end;
  5197.  
  5198. { TSelectOptionsColumn }
  5199.  
  5200. class function TSelectOptionsColumn.IsColumn: Boolean;
  5201. begin
  5202.   Result := True;
  5203. end;
  5204.  
  5205. { TTextColumn }
  5206.  
  5207. class function TTextColumn.IsColumn: Boolean;
  5208. begin
  5209.   Result := True;
  5210. end;
  5211.  
  5212. { TFieldGroup }
  5213.  
  5214. constructor TCustomFieldGroup.Create(AOwner: TComponent);
  5215. begin
  5216.   inherited;
  5217.   FLayoutAttributes := TLayoutAttributes.Create;
  5218. end;
  5219.  
  5220. destructor TCustomFieldGroup.Destroy;
  5221. begin
  5222.   inherited;
  5223.   FLayoutAttributes.Free;
  5224. end;
  5225.  
  5226. function TCustomFieldGroup.ImplContent(Options: TWebContentOptions;
  5227.   ParentLayout: TLayout): string;
  5228. var
  5229.   FormLayout: TFormLayout;
  5230.  
  5231.   function FormatField(Field: TComponent): string;
  5232.   var
  5233.     Intf: IWebContent;
  5234.   begin
  5235.     if Field.GetInterface(IWebContent, Intf) then
  5236.       Result := Intf.Content(Options, FormLayout)
  5237.     else
  5238.       Result := '';
  5239.   end;
  5240. var
  5241.   I: Integer;
  5242.   Intf: ILayoutWebContent;
  5243.   Attribs: string;
  5244. begin
  5245.   Result := '';
  5246.   FormLayout := TFormLayout.Create(ParentLayout);
  5247.   try
  5248.     // AddStringAttrib(Attribs, 'NAME', Name);
  5249.     AddQuotedAttrib(Attribs, 'STYLE', Style);
  5250.     AddQuotedAttrib(Attribs, 'CLASS', StyleRule);
  5251.     AddCustomAttrib(Attribs, Custom);
  5252.     FormLayout.TableHeader := Format(#13#10'<TABLE%s>', [Attribs]);
  5253.     for I := 0 to VisibleFields.Count - 1 do
  5254.     begin
  5255.       Result := Result +
  5256.         FormatField(VisibleFields[I]);
  5257.     end;
  5258.     Result := Result +  FormLayout.EndLayout;
  5259.     if Assigned(ParentLayout) and ParentLayout.GetInterface(ILayoutWebContent, Intf) then
  5260.       Result := Intf.LayoutTable(Result, GetLayoutAttributes)
  5261.   finally
  5262.     FormLayout.Free;
  5263.   end;
  5264. end;
  5265.  
  5266. { TFieldGroup }
  5267.  
  5268. procedure TFieldGroup.ImplAddElements(AddIntf: IAddScriptElements);
  5269. begin
  5270.   inherited;
  5271.   if Assigned(XMLDataSet.XMLBroker) then
  5272.   begin
  5273.     AddIntf.AddRowSet(XMLDataSet.XMLBroker, XMLDataSet.DataSetPath);
  5274.     DefineXMLDisplayBlock(AddIntf, Self, GetXMLRowSetName);
  5275.   end
  5276.   else
  5277.     AddIntf.AddError(Format(sXMLBrokerNotDefined, [Self.Name]));
  5278. end;
  5279.  
  5280. function TFieldGroup.ImplCanAddClass(AParent: TComponent;
  5281.   AClass: TClass): Boolean;
  5282. begin
  5283.   Result :=
  5284.     (AClass.InheritsFrom(TWebDataDisplay) and not
  5285.       (TWebDataDisplayClass(AClass).IsColumn or TWebDataDisplayClass(AClass).IsQueryField))
  5286.        or AClass.InheritsFrom(TCustomLayoutGroup);
  5287. end;
  5288.  
  5289. { TQueryText }
  5290.  
  5291. procedure TQueryText.AddAttributes(var Attrs: string);
  5292. begin
  5293.   Inherited;
  5294.   AddQuotedAttrib(Attrs, 'VALUE', Text);
  5295.   AddBoolAttrib(Attrs, 'READONLY', ReadOnly);
  5296.   AddIntAttrib(Attrs, 'MAXLENGTH', MaxWidth);
  5297. end;
  5298.  
  5299. constructor TQueryText.Create(AOwner: TComponent);
  5300. begin
  5301.   inherited;
  5302.   FMaxWidth := -1;
  5303. end;
  5304.  
  5305. function TQueryText.GetText: string;
  5306. begin
  5307.   Result := FText;
  5308. end;
  5309.  
  5310. class function TQueryText.IsQueryField: Boolean;
  5311. begin
  5312.   Result := True;
  5313. end;
  5314.  
  5315. procedure TQueryText.SetText(const Value: string);
  5316. begin
  5317.   FText := Value;
  5318. end;
  5319.  
  5320. { TQueryTextArea }
  5321.  
  5322. procedure TQueryTextArea.AddAttributes(var Attrs: string);
  5323. begin
  5324.   inherited;
  5325.   AddBoolAttrib(Attrs, 'READONLY', ReadOnly);
  5326. end;
  5327.  
  5328. function TQueryTextArea.ControlContent(
  5329.   Options: TWebContentOptions): string;
  5330. var
  5331.   Attrs: string;
  5332.   Events: string;
  5333. begin
  5334.   AddAttributes(Attrs);
  5335.   if (not (coNoScript in Options.Flags)) then
  5336.     Events := EventContent(Options);
  5337.   Result := Format('<TEXTAREA%0:s%1:s>%2:s</TEXTAREA>', [Attrs, Events, Lines.Text]);
  5338. end;
  5339.  
  5340. constructor TQueryTextArea.Create(AOwner: TComponent);
  5341. begin
  5342.   inherited;
  5343.   FLines := TStringList.Create;
  5344. end;
  5345.  
  5346. destructor TQueryTextArea.Destroy;
  5347. begin
  5348.   inherited;
  5349.   FLines.Free;
  5350. end;
  5351.  
  5352. function TQueryTextArea.GetText: string;
  5353. begin
  5354.   Result := Lines.Text;
  5355. end;
  5356.  
  5357. class function TQueryTextArea.IsQueryField: Boolean;
  5358. begin
  5359.   Result := True;
  5360. end;
  5361.  
  5362. procedure TQueryTextArea.SetLines(const Value: TStrings);
  5363. begin
  5364.   FLines.Assign(Value);
  5365. end;
  5366.  
  5367. procedure TQueryTextArea.SetText(const Value: string);
  5368. begin
  5369.   Lines.Text := Value;
  5370. end;
  5371.  
  5372. { TQueryRadioGroup }
  5373.  
  5374. procedure TQueryRadioGroup.AddAttributes(var Attrs: string);
  5375. begin
  5376.   inherited;
  5377.   AddBoolAttrib(Attrs, 'READONLY', ReadOnly);
  5378. end;
  5379.  
  5380. function TQueryRadioGroup.GetCheckIndex(ItemsStrings,
  5381.   ValuesStrings: TStrings): Integer;
  5382. begin
  5383.   Result := ItemsStrings.IndexOf(Text);
  5384.   if (Result = -1) and Assigned(ValuesStrings) then
  5385.     Result := ValuesStrings.IndexOf(Text);
  5386. end;
  5387.  
  5388. function TQueryRadioGroup.GetText: string;
  5389. begin
  5390.   Result := FText;
  5391. end;
  5392.  
  5393. class function TQueryRadioGroup.IsQueryField: Boolean;
  5394. begin
  5395.   Result := True;
  5396. end;
  5397.  
  5398. procedure TQueryRadioGroup.SetText(const Value: string);
  5399. begin
  5400.   FText := Value;
  5401. end;
  5402.  
  5403. { TQuerySelectOptions }
  5404.  
  5405. function TQuerySelectOptions.GetSelectIndex(ItemsStrings,
  5406.   ValuesStrings: TStrings): Integer;
  5407. begin
  5408.   Result := ItemsStrings.IndexOf(Text);
  5409.   if (Result = -1) and Assigned(ValuesStrings) then
  5410.     Result := ValuesStrings.IndexOf(Text);
  5411. end;
  5412.  
  5413. function TQuerySelectOptions.GetText: string;
  5414. begin
  5415.   Result := FText;
  5416. end;
  5417.  
  5418. class function TQuerySelectOptions.IsQueryField: Boolean;
  5419. begin
  5420.   Result := True;
  5421. end;
  5422.  
  5423. procedure TQuerySelectOptions.SetText(const Value: string);
  5424. begin
  5425.   FText := Value;
  5426. end;
  5427.  
  5428. { TTextAreaColumn }
  5429.  
  5430. class function TTextAreaColumn.IsColumn: Boolean;
  5431. begin
  5432.   Result := True;
  5433. end;
  5434.  
  5435. { TCustomLayoutGroup }
  5436.  
  5437. constructor TCustomLayoutGroup.Create(AComponent: TComponent);
  5438. begin
  5439.   inherited;
  5440.   FDisplayColumns := -1;
  5441.   FLayoutAttributes := TLayoutAttributes.Create;
  5442. end;
  5443.  
  5444. destructor TCustomLayoutGroup.Destroy;
  5445. begin
  5446.   inherited;
  5447.   FLayoutAttributes.Free;
  5448. end;
  5449.  
  5450. function TCustomLayoutGroup.ImplCanAddClass(AParent: TComponent; AClass: TClass): Boolean;
  5451. var
  5452.   Intf: IWebComponentEditor;
  5453.   Parent: TComponent;
  5454. begin
  5455.   Parent := GetParentComponent;
  5456.   if Assigned(Parent) and Parent.GetInterface(IWebComponentEditor, Intf) then
  5457.     Result := Intf.CanAddClass(AParent, AClass)
  5458.   else
  5459.     Result := not Assigned(Parent);
  5460. end;
  5461.  
  5462. function TCustomLayoutGroup.ImplContent(Options: TWebContentOptions;
  5463.   ParentLayout: TLayout): string;
  5464. var
  5465.   FormLayout: TFormLayout;
  5466.  
  5467.   function FormatField(Field: TComponent): string;
  5468.   var
  5469.     Intf: IWebContent;
  5470.   begin
  5471.     if Field.GetInterface(IWebContent, Intf) then
  5472.       Result := Intf.Content(Options, FormLayout)
  5473.     else
  5474.       Result := '';
  5475.   end;
  5476.  
  5477.   function Min(X, Y: Integer): Integer;
  5478.   begin
  5479.     Result := X;
  5480.     if X > Y then Result := Y;
  5481.   end;
  5482. var
  5483.   I: Integer;
  5484.   Intf: ILayoutWebContent;
  5485.   Attribs: string;
  5486. begin
  5487.   Result := '';
  5488.   if WebFieldControls.Count = 0 then
  5489.     Exit;
  5490.   FormLayout := TFormLayout.Create(ParentLayout);
  5491.   try
  5492.     // AddStringAttrib(Attribs, 'NAME', Name);
  5493.     AddQuotedAttrib(Attribs, 'STYLE', Style);
  5494.     AddQuotedAttrib(Attribs, 'CLASS', StyleRule);
  5495.     AddCustomAttrib(Attribs, Custom);
  5496.  
  5497.     if DisplayColumns >= 1 then
  5498.     begin
  5499.       FormLayout.ColumnCount := Min(DisplayColumns, WebFieldControls.Count);
  5500.       FormLayout.BreakButtons := True;
  5501.     end;
  5502.     FormLayout.TableHeader :=
  5503.       Format(#13#10'<TABLE%s>', [Attribs]);
  5504.     for I := 0 to WebFieldControls.Count - 1 do
  5505.     begin
  5506.       Result := Result +
  5507.         FormatField(WebFieldControls[I]);
  5508.     end;
  5509.     Result := Result + FormLayout.EndLayout;
  5510.  
  5511.     if Assigned(ParentLayout) and ParentLayout.GetInterface(ILayoutWebContent, Intf) then
  5512.       Result := Intf.LayoutTable(Result, GetLayoutAttributes)
  5513.   finally
  5514.     FormLayout.Free;
  5515.   end;
  5516. end;
  5517.  
  5518. function TGridLayout.ImplLayoutTable(const HTMLTable: string;
  5519.   Attributes: TLayoutAttributes): string;
  5520. begin
  5521.   Assert(False, 'Unexpected call to ImplLayoutTable');
  5522. end;
  5523.  
  5524. function TCustomLayoutGroup.GetLayoutAttributes: TLayoutAttributes;
  5525. begin
  5526.   with FLayoutAttributes do
  5527.   begin
  5528.     ControlAttributes := '';
  5529.     AddQuotedAttrib(ControlAttributes, 'STYLE', Style);
  5530.     AddQuotedAttrib(ControlAttributes, 'CLASS', StyleRule);
  5531.     AddCustomAttrib(ControlAttributes, Custom);
  5532.   end;
  5533.   Result := FLayoutAttributes;
  5534. end;
  5535.  
  5536. { TCaptionAttributes }
  5537.  
  5538. constructor TCaptionAttributes.Create(AParent: TComponent);
  5539. begin
  5540.   inherited Create;
  5541.   FParent := AParent;
  5542. end;
  5543.  
  5544. { TQueryFieldGroup }
  5545.  
  5546. function TQueryFieldGroup.IsParamInUse(AName: string): Boolean;
  5547. begin
  5548.   Result := FindParam(AName) <> nil;
  5549. end;
  5550.  
  5551. function TQueryFieldGroup.FindParam(const AName: string): TComponent;
  5552. var
  5553.   I: Integer;
  5554.   QueryField: IQueryField;
  5555. begin
  5556.   for I := 0 to FWebComponents.Count - 1 do
  5557.   begin
  5558.     if FWebComponents.WebComponents[I].GetInterface(IQueryField, QueryField) then
  5559.     begin
  5560.       Result := FWebComponents.WebComponents[I];
  5561.       if AnsiCompareText(QueryField.ParamName, AName) = 0 then Exit;
  5562.     end;
  5563.   end;
  5564.   Result := nil;
  5565. end;
  5566.  
  5567. procedure TQueryFieldGroup.GetParamsList(List: TStrings);
  5568. var
  5569.   I: Integer;
  5570.   TextClass: TWebDataInputClass;
  5571. begin
  5572.   if ImplCanAddClass(Self, TFieldText) then
  5573.     TextClass := TFieldText
  5574.   else if ImplCanAddClass(Self, TQueryText) then
  5575.     TextClass := TQueryText
  5576.   else if ImplCanAddClass(Self, TTextColumn) then
  5577.     TextClass := TTextColumn
  5578.   else
  5579.     TextClass := nil;
  5580.  
  5581.   List.Clear;
  5582.   if XMLDataSet.XMLBroker <> nil then
  5583.     with XMLDataSet.XMLBroker do
  5584.     begin
  5585.       if Params.Count = 0 then
  5586.         FetchParams;
  5587.       for I := 0 to Params.Count - 1 do
  5588.         List.AddObject(Params.Items[I].Name, TObject(TextClass));
  5589.     end;
  5590. end;
  5591.  
  5592. function TQueryFieldGroup.ImplCanAddClass(AParent: TComponent;
  5593.   AClass: TClass): Boolean;
  5594. begin
  5595.   Result :=
  5596.     (AClass.InheritsFrom(TWebDataDisplay) and
  5597.       TWebDataDisplayClass(AClass).IsQueryField)
  5598.        or AClass.InheritsFrom(TCustomLayoutGroup);
  5599. end;
  5600.  
  5601. { TWebButton }
  5602.  
  5603. constructor TWebButton.Create(AOwner: TComponent);
  5604. begin
  5605.   inherited;
  5606.   FDefaultButton := AOwner = nil;
  5607. end;
  5608.  
  5609. destructor TWebButton.Destroy;
  5610. begin
  5611.   inherited;
  5612.   if FWebButtonsList <> nil then
  5613.     FWebButtonsList.Remove(Self);
  5614. end;
  5615.  
  5616. function TWebButton.GetContainer: TWebComponentContainer;
  5617. begin
  5618.   Result := FWebButtonsList;
  5619. end;
  5620.  
  5621. function TWebButton.GetIndex: Integer;
  5622. begin
  5623.   Result := FWebButtonsList.IndexOf(Self);
  5624. end;
  5625.  
  5626. function TWebButton.GetParentComponent: TComponent;
  5627. begin
  5628.   if FWebParent <> nil then
  5629.     Result := FWebParent else
  5630.     Result := inherited GetParentComponent;
  5631. end;
  5632.  
  5633. function TWebButton.HasParent: Boolean;
  5634. begin
  5635.   if FWebParent <> nil then
  5636.     Result := True else
  5637.     Result := inherited HasParent;
  5638. end;
  5639.  
  5640. procedure TWebButton.ReadState(Reader: TReader);
  5641. begin
  5642.   inherited ReadState(Reader);
  5643.   SetWebParent(Reader.Parent);
  5644. end;
  5645.  
  5646. procedure TWebButton.SetComponentList(List: TObject);
  5647. begin
  5648.   Assert((List = nil) or (List is TWebComponentList));
  5649.   FWebButtonsList := TWebComponentList(List);
  5650. end;
  5651.  
  5652. procedure TWebButton.SetIndex(Value: Integer);
  5653. begin
  5654.   FWebButtonsList.SetComponentIndex(Self, Value)
  5655. end;
  5656.  
  5657. procedure TWebButton.SetContainer(
  5658.   Container: TWebComponentContainer);
  5659. begin
  5660.   SetWebParent((Container as TWebComponentList).ParentComponent);
  5661. end;
  5662.  
  5663. procedure TWebButton.SetParentComponent(AParent: TComponent);
  5664. begin
  5665.   if not (csLoading in ComponentState) then
  5666.     SetWebParent(AParent);
  5667. end;
  5668.  
  5669. procedure TWebButton.SetWebParent(const Value: TComponent);
  5670. var
  5671.   List: IGetWebComponentList;
  5672. begin
  5673.   if Value <> FWebParent then
  5674.   begin
  5675.     if Assigned(Value) and (csDesigning in ComponentState) then
  5676.       ValidateWebParent(Self, Value);
  5677.     if FWebParent <> nil then
  5678.     begin
  5679.       FWebParent.GetInterface(IGetWebComponentList, List);
  5680.       if FDefaultButton then
  5681.         (List.GetDefaultComponentList as TWebComponentList).Remove(Self)
  5682.       else
  5683.         (List.GetComponentList as TWebComponentList).Remove(Self)
  5684.     end;
  5685.     if Value <> nil then
  5686.     begin
  5687.       Value.GetInterface(IGetWebComponentList, List);
  5688.       if FDefaultButton then
  5689.         (List.GetDefaultComponentList as TWebComponentList).Add(Self)
  5690.       else
  5691.         (List.GetComponentList as TWebComponentList).Add(Self)
  5692.     end;
  5693.     FWebParent := Value;
  5694.   end;
  5695. end;
  5696.  
  5697. function TWebButton.Content(Options: TWebContentOptions; Layout: TLayout): string;
  5698. begin
  5699.   Result := ImplContent(Options, Layout);
  5700. end;
  5701.  
  5702. function TWebButton.GetCaption: string;
  5703. begin
  5704.   Result := FCaption;
  5705. end;
  5706.  
  5707. function TWebButton.GetLayoutAttributes: TLayoutAttributes;
  5708. begin
  5709.   Result := nil;
  5710. end;
  5711.  
  5712. function TCustomFieldGroup.GetLayoutAttributes: TLayoutAttributes;
  5713. begin
  5714.   with FLayoutAttributes do
  5715.   begin
  5716.     AddQuotedAttrib(ControlAttributes, 'STYLE', Style);
  5717.     AddQuotedAttrib(ControlAttributes, 'CLASS', StyleRule);
  5718.     AddCustomAttrib(ControlAttributes, Custom);
  5719.   end;
  5720.   Result := FLayoutAttributes;
  5721. end;
  5722.  
  5723. { TGridAttributes }
  5724.  
  5725. procedure TGridAttributes.AssignTo(Dest: TPersistent);
  5726. begin
  5727.   if Dest is TGridAttributes then
  5728.     with TGridAttributes(Dest) do
  5729.     begin
  5730.       FStyle := Self.FStyle;
  5731.       FStyleRule := Self.FStyleRule;
  5732.       FAlign := Self.FAlign;
  5733.       FBorder := Self.FBorder;
  5734.       FBgColor := Self.FBgColor;
  5735.       FCellSpacing := Self.FCellSpacing;
  5736.       FCellPadding := Self.FCellPadding;
  5737.       FCustom := Self.FCustom;
  5738.     end else inherited AssignTo(Dest);
  5739. end;
  5740.  
  5741. constructor TGridAttributes.Create(AParent: TComponent);
  5742. begin
  5743.   inherited Create;
  5744.   FParent := AParent;
  5745.   FBorder := 1;
  5746.   FCellPadding := -1;
  5747.   FCellSpacing := -1;
  5748. end;
  5749.  
  5750. { TGridRowAttributes }
  5751.  
  5752. procedure TGridRowAttributes.AssignTo(Dest: TPersistent);
  5753. begin
  5754.   if Dest is TGridRowAttributes then
  5755.     with TGridRowAttributes(Dest) do
  5756.     begin
  5757.       FAlign := Self.FAlign;
  5758.       FVAlign := Self.FVAlign;
  5759.       FBgColor := Self.FBgColor;
  5760.       FStyle := Self.FStyle;
  5761.       FStyleRule := Self.FStyleRule;
  5762.       FCustom := Self.FCustom;
  5763.     end else inherited AssignTo(Dest);
  5764. end;
  5765.  
  5766. constructor TGridRowAttributes.Create(AParent: TComponent);
  5767. begin
  5768.   inherited Create;
  5769.   FParent := AParent;
  5770.   FAlign := haDefault;
  5771.   VAlign := haVDefault;
  5772. end;
  5773.  
  5774. { TClientDataSetEvent }
  5775.  
  5776. procedure TClientDataSetEvent.DataEvent(Event: TDataEvent; Info: Integer);
  5777. begin
  5778.   inherited;
  5779.   if (Event = deConnectChange) and (Info = 0) then
  5780.   begin
  5781.     if Assigned(FOnDataChange) then
  5782.       FOnDataChange(Self);
  5783.   end;
  5784. end;
  5785.  
  5786. initialization
  5787.   XMLDataSetList := TList.Create;
  5788. finalization
  5789.   XMLDataSetList.Free;
  5790.   XMLDataSetList := nil;
  5791. end.
  5792.