home *** CD-ROM | disk | FTP | other *** search
/ Delphi Anthology / aDELPHI.iso / Runimage / Delphi50 / Demos / Midas / InternetExpress / InetXCustom / reconcileprod.pas < prev    next >
Pascal/Delphi Source File  |  1999-08-11  |  24KB  |  763 lines
  1. unit ReconcileProd;
  2.  
  3. interface
  4.  
  5. uses MidProd, WebComp, HTTPApp, Classes, XmlBrokr, MidItems;
  6.  
  7. type
  8.   TReconcileGrid = class;
  9.   TReconcilePageElements = class;
  10.   TReconcilePageProducer = class(TCustomMidasPageProducer)
  11.   private
  12.     FReconcileGrid: TReconcileGrid;
  13.     FXMLBroker: TXMLBroker;
  14.     procedure SetReconcileGrid(const Value: TReconcileGrid);
  15.   protected
  16.     procedure DoTagEvent(Tag: TTag; const TagString: string; TagParams: TStrings;
  17.       var ReplaceText: string); override;
  18.     procedure GeneratePageElements; override;
  19.     function CreatePageElements: TMidasPageElements; override;
  20.     procedure AddIncludes; override;
  21.     function DeclareRowSets: string; override;
  22.     procedure AddScriptComponents; override;
  23.     function DeclareXMLDocuments: string; override;
  24.     function DeclareXMLIslands: string; override;
  25.     procedure GetXMLInfo(
  26.       var XMLBrokerName, XMLErrors, XMLDelta: string;
  27.         XMLOptions: TXMLOptions);
  28.   public
  29.     constructor Create(AOwner: TComponent); override;
  30.     destructor Destroy; override;
  31.   published
  32.     property IncludePathURL;
  33.     property OnBeforeGetContent;
  34.     property OnAfterGetContent;
  35.     property Styles;
  36.     property StylesFile;
  37.     property WebPageItems;
  38.     property EnableXMLIslands;
  39.     property ReconcileGrid: TReconcileGrid read FReconcileGrid write SetReconcileGrid;
  40.   end;
  41.  
  42.   TReconcileColumn = class;
  43.   TReconcileGrid = class(TPersistent)
  44.   private
  45.     FDisplayRows: Integer;
  46.     FTableAttributes: TGridAttributes;
  47.     FHeadingAttributes: TGridRowAttributes;
  48.     FRowAttributes: TGridRowAttributes;
  49.     FFieldNameColumn: TReconcileColumn;
  50.     FModifiedColumn: TReconcileColumn;
  51.     FConflictingColumn: TReconcileColumn;
  52.     FOriginalColumn: TReconcileColumn;
  53.     function GetColumn(I: Integer): TReconcileColumn;
  54.     function GetColumnCount: Integer;
  55.     procedure SetConflictingColumn(const Value: TReconcileColumn);
  56.     procedure SetFieldNameColumn(const Value: TReconcileColumn);
  57.     procedure SetModifiedColumn(const Value: TReconcileColumn);
  58.     procedure SetOriginalColumn(const Value: TReconcileColumn);
  59.   protected
  60.     function HTMLTableName: string;
  61.     function FormatTable(Layout: TLayoutWebContent;
  62.       Options: TWebContentOptions): string;
  63.     procedure SetTableAttributes(const Value: TGridAttributes);
  64.     procedure SetHeadingAttributes(
  65.       const Value: TGridRowAttributes);
  66.     procedure SetRowAttributes(
  67.       const Value: TGridRowAttributes);
  68.     procedure AssignTo(Dest: TPersistent); override;
  69.   public
  70.     constructor Create(AOwner: TComponent);
  71.     destructor Destroy; override;
  72.     property ColumnCount: Integer read GetColumnCount;
  73.     property Column[I: Integer]: TReconcileColumn read GetColumn;
  74.   published
  75.     property DisplayRows: Integer read FDisplayRows write FDisplayRows default 4;
  76.     property TableAttributes: TGridAttributes read FTableAttributes
  77.       write SetTableAttributes;
  78.     property HeadingAttributes: TGridRowAttributes read FHeadingAttributes
  79.       write SetHeadingAttributes;
  80.     property RowAttributes: TGridRowAttributes read FRowAttributes
  81.       write SetRowAttributes;
  82.     property ConflictingColumn: TReconcileColumn read FConflictingColumn write SetConflictingColumn;
  83.     property FieldNameColumn: TReconcileColumn read FFieldNameColumn write SetFieldNameColumn;
  84.     property ModifiedColumn: TReconcileColumn read FModifiedColumn write SetModifiedColumn;
  85.     property OriginalColumn: TReconcileColumn read FOriginalColumn write SetOriginalColumn;
  86.   end;
  87.  
  88.   TReconcileColumn = class(TPersistent)
  89.   private
  90.     FCaption: string;
  91.     FStyle: string;
  92.     FStyleRule: string;
  93.     FCustom: string;
  94.     FCaptionAttributes: TCaptionAttributes;
  95.     FDisplayWidth: integer;
  96.     FMaxWidth: integer;
  97.     FName: string;
  98.     FEvents: string;
  99.     procedure SetCaptionAttributes(const Value: TCaptionAttributes);
  100.   protected
  101.     procedure AssignTo(Dest: TPersistent); override;
  102.     property Name: string read FName write FName;
  103.     property Events: string read FEvents write FEvents;
  104.   public
  105.     constructor Create(AOwner: TComponent);
  106.     destructor Destroy; override;
  107.     function ControlContent(Options: TWebContentOptions): string;
  108.     function GetHTMLControlName: string;
  109.   published
  110.     property Caption: string read FCaption write FCaption;
  111.     property Custom: string read FCustom write FCustom;
  112.     property Style: string read FStyle write FStyle;
  113.     property MaxWidth: Integer read FMaxWidth write FMaxWidth default -1;
  114.     property CaptionAttributes: TCaptionAttributes
  115.       read FCaptionAttributes write SetCaptionAttributes;
  116.     property DisplayWidth: integer read FDisplayWidth write FDisplayWidth;
  117.     property StyleRule: string read FStyleRule write FStyleRule;
  118.   end;
  119.  
  120.   TFieldNameColumn = class(TReconcileColumn)
  121.   public
  122.     constructor Create(AOwner: TComponent);
  123.   end;
  124.  
  125.   TModifiedColumn = class(TReconcileColumn)
  126.   public
  127.     constructor Create(AOwner: TComponent);
  128.   end;
  129.  
  130.   TConflictingColumn = class(TReconcileColumn)
  131.   public
  132.     constructor Create(AOwner: TComponent);
  133.   end;
  134.  
  135.   TOriginalColumn = class(TReconcileColumn)
  136.   public
  137.     constructor Create(AOwner: TComponent);
  138.   end;
  139.  
  140.   TReconcilePageElements = class(TMidasPageElements)
  141.   public
  142.     ReconcileGridContent: string;
  143.   end;
  144.  
  145. implementation
  146.  
  147. uses ScrptMgr, SysUtils, WbmConst;
  148.  
  149. const
  150.   sXMLBroker = 'XMLBROKER';
  151.   sErrorPacketTag = 'ERRORPACKET';
  152.   sDeltaPacketTag = 'DELTAPACKET';
  153.   sReconcileGridTag = 'RECONCILEGRID';
  154.   sQuoteXMLAttribute = 'QUOTE';
  155.   sQuoteXML = sQuoteXMLAttribute + '="True"'; // Do not localize
  156.   sDefaultXMLBrokerName = 'XMLBroker1';
  157.  
  158. resourcestring 
  159.   sFieldNameCaption = 'Field Name';
  160.   sModifiedCaption = 'Submitted Value';
  161.   sConflictingCaption = 'Conflicting Value';
  162.   sOriginalCaption = 'Original Value';
  163.  
  164. { TReconcilePageProducer }
  165.  
  166. procedure TReconcilePageProducer.DoTagEvent(Tag: TTag;
  167.   const TagString: string; TagParams: TStrings; var ReplaceText: string);
  168. var
  169.   XMLBroker: TXMLBroker;
  170.   XMLOptions: TXMLOptions;
  171. begin
  172.   if not (csDesigning in ComponentState) then
  173.     if (Tag = tgCustom) and (CompareText(TagString, sDeltaPacketTag) = 0) then
  174.     begin
  175.       XMLOptions := [];
  176.       if CompareText(TagParams.Values[sQuoteXMLAttribute], 'True') = 0 then
  177.         XMLOptions := XMLOptions + [xoQuote];
  178.       XMLBroker := FindXMLBroker(TagParams);
  179.       if Assigned(XMLBroker) then
  180.         ReplaceText :=
  181.           FormatXML(XMLBroker.GetDelta(Dispatcher.Request),
  182.             XMLOptions);
  183.       Exit;
  184.     end
  185.     else if (Tag = tgCustom) and (CompareText(TagString, sErrorPacketTag) = 0) then
  186.     begin
  187.       XMLOptions := [];
  188.       if CompareText(TagParams.Values[sQuoteXMLAttribute], 'True') = 0 then
  189.         XMLOptions := XMLOptions + [xoQuote];
  190.       XMLBroker := FindXMLBroker(TagParams);
  191.       if Assigned(XMLBroker) then
  192.         ReplaceText := FormatXML(XMLBroker.GetErrors, XMLOptions);
  193.       Exit;
  194.     end;
  195.  
  196.   if (Tag = tgCustom) and (CompareText(TagString, sReconcileGridTag) = 0) then
  197.   begin
  198.     if Assigned(PageElements) then
  199.       ReplaceText := (PageElements as TReconcilePageElements).ReconcileGridContent;
  200.     Exit;
  201.   end;
  202.   inherited DoTagEvent(Tag, TagString, TagParams, ReplaceText);
  203. end;
  204.  
  205. procedure TReconcilePageProducer.AddIncludes;
  206. var
  207.   StdIncludes: TStdIncludes;
  208. begin
  209.   StdIncludes := [jsDb, jsErrDisp];
  210.   if not GetUseXMLIslands then
  211.     StdIncludes := StdIncludes + [jsDom];
  212.   AddStdIncludes(StdIncludes, ScriptManager.GetAddElementsIntf);
  213. end;
  214.  
  215. function TReconcilePageProducer.CreatePageElements: TMidasPageElements;
  216. begin
  217.   Result := TReconcilePageElements.Create;
  218. end;
  219.  
  220. const
  221.   sErrXMLVarName = 'xmlErrStr';
  222.   sDeltaXMLVarName = 'xmlDeltaStr';
  223.   sErrDocVarName = 'xmlErrDoc';
  224.   sDeltaDocVarName = 'xmlDeltaDoc';
  225.  
  226. procedure TReconcilePageProducer.GeneratePageElements;
  227.   function FindXMLBroker: TXMLBroker;
  228.   var
  229.     I: Integer;
  230.   begin
  231.     for I := 0 to Owner.ComponentCount - 1 do
  232.       if Owner.Components[I] is TXMLBroker then
  233.       begin
  234.         Result := TXMLBroker(Owner.Components[I]);
  235.         if Result.GetErrors <> '' then  Exit;
  236.       end;
  237.     Result := nil;
  238.   end;
  239.  
  240. begin
  241.   if csDesigning in ComponentState then
  242.     FXMLBroker := nil
  243.   else
  244.     FXMLBroker := FindXMLBroker;
  245.   try
  246.     inherited GeneratePageElements;
  247.     (PageElements as TReconcilePageElements).ReconcileGridContent :=
  248.       FReconcileGrid.FormatTable(nil, ScriptManager.Options);
  249.   finally
  250.     FXMLBroker := nil;
  251.   end;
  252. end;
  253.  
  254. resourcestring
  255.   sErrorMessage = 'Error message:';
  256.   sOn =           'on';
  257.   sCancel = 'Cancel';
  258.   sCorrect = 'Correct';
  259.   sMerge = 'Merge';
  260.   sPrevRow = '<';
  261.   sNextRow = '>';
  262.   sPostNext = 'Post/Next';
  263.   sReapply = 'Reapply Updates';
  264.   sReconcileAction = 'Reconcile Action';
  265.  
  266. const
  267.   sDefaultHTMLDoc =
  268.     '<HTML>'#13#10 +
  269.     '<HEAD>'#13#10 +
  270.     '</HEAD>'#13#10 +
  271.     '<BODY>'#13#10 +
  272.     '<#INCLUDES><#STYLES><#WARNINGS>'#13#10 +
  273.     '<P>'#13#10 +
  274.     '<FORM name="FORM1">'#13#10 +
  275.     '<TABLE>'#13#10 +
  276.     '<TR>'#13#10 +
  277.     '<TD valign=top><H3>%0:s</H3></TD>'#13#10 +
  278.     '<TD valign=top><textarea name="ErrMessage" rows=2 cols=58 readonly onfocus=''blur();''></textarea></TD>'#13#10 +
  279.     '<TD valign=top><H3>%1:s</H3></TD>'#13#10 +
  280.     '<TD valign=top><input type=text name="ErrAction" size=12 readonly onfocus=''blur();''/></TD>'#13#10 +
  281.     '</TR>'#13#10 +
  282.     '</TABLE>'#13#10 +
  283.     '<P>'#13#10 +
  284.     '<#RECONCILEGRID>'#13#10 +
  285.     '</FORM>'#13#10 +
  286.     '<P>'#13#10 +
  287.     '<FORM>'#13#10 +
  288.     '<H3> %9:s </H3>'#13#10 +
  289.     '<input type=radio name="action" value="Cancel" onclick=''if(self.grid1!=null)grid1.cancel();''/> %2:s'#13#10 +
  290.     '<input type=radio name="action" value="Correct" onclick=''if(self.grid1!=null)grid1.correct();''/> %3:s'#13#10 +
  291.     '<input type=radio name="action" value="Merge" onclick=''if(self.grid1!=null)grid1.merge();''/> %4:s'#13#10 +
  292.     '<P>'#13#10 +
  293.     '<input type=button value="%5:s" onclick=''if(self.grid1!=null)grid1.up();'' />'#13#10 +
  294.     '<input type=button value="%6:s" onclick=''if(self.grid1!=null)grid1.down();'' />'#13#10 +
  295.     '<input type=button value="%7:s" onclick=''if(self.grid1!=null)grid1.post();''/>'#13#10 +
  296.     '<P>'#13#10 +
  297.     '<input type=button value="%8:s" onclick=''if(self.grid1!=null)grid1.Reapply(Submitfrm1, Submitfrm1.postdelta);''/>'#13#10 +
  298.     '</FORM>'#13#10 +
  299.     '<#FORMS><#SCRIPT>'#13#10 +
  300.     '</BODY>'#13#10 +
  301.     '</HTML>'#13#10;
  302.  
  303. constructor TReconcilePageProducer.Create(AOwner: TComponent);
  304. begin
  305.   inherited;
  306.   FReconcileGrid := TReconcileGrid.Create(Self);
  307.   HTMLDoc.Text := Format(sDefaultHTMLDoc,
  308.     [sErrorMessage, sOn, sCancel, sCorrect, sMerge,
  309.      sPrevRow, sNextRow, sPostNext, sReapply, sReconcileAction]);
  310. end;
  311.  
  312. destructor TReconcilePageProducer.Destroy;
  313. begin
  314.   inherited;
  315.   FReconcileGrid.Free;
  316.  
  317. end;
  318.  
  319. procedure TReconcilePageProducer.GetXMLInfo(
  320.   var XMLBrokerName, XMLErrors, XMLDelta: string;
  321.     XMLOptions: TXMLOptions);
  322. begin
  323.   XMLErrors := '';
  324.   XMLDelta := '';
  325.   if Assigned(FXMLBroker) then
  326.   begin
  327.     XMLErrors := FormatXML(FXMLBroker.GetErrors, XMLOptions);
  328.     if Assigned(Dispatcher) and Assigned(Dispatcher.Request) then
  329.       XMLDelta := FormatXML(FXMLBroker.GetDelta(Dispatcher.Request),
  330.         XMLOptions);
  331.     XMLBrokerName := FXMLBroker.Name;
  332.   end
  333.   else
  334.     XMLBrokerName := sDefaultXMLBrokerName;
  335. end;
  336.  
  337. function TReconcilePageProducer.DeclareXMLDocuments: string;
  338.  
  339.   function DeclareXMLDocument(const XMLBrokerName, XmlVarName, DocVarName,
  340.     TagName, XMLData: string): string;
  341.   begin
  342.     Result := '';
  343.     Result := Format('%svar %s = '#13#10, [Result, XMLVarName]);
  344.     if (csDesigning in ComponentState) or (XMLData = '') then
  345.       Result := Format('%s<#%s %s=%s %s>;'#13#10,
  346.         [Result, TagName, sXMLBroker, XMLBrokerName, sQuoteXML])
  347.     else
  348.       Result := Format('%s%s;'#13#10, [Result, XMLData]);;
  349.     Result := Format('%svar %s = new Document(%s);'#13#10,
  350.      [Result, DocVarName, XMLVarName]);
  351.   end;
  352.  
  353. var
  354.   XMLBrokerName: string;
  355.   XMLErrors, XMLDelta: string;
  356. begin
  357.   GetXMLInfo(XMLBrokerName, XMLErrors, XMLDelta, [xoQuote]);
  358.   Result := Result +
  359.     DeclareXMLDocument(XMLBrokerName, sErrXMLVarName, sErrDocVarName, sErrorPacketTag,
  360.     XMLErrors );
  361.   Result := Result +
  362.     DeclareXMLDocument(XMLBrokerName, sDeltaXMLVarName, sDeltaDocVarName, sDeltaPacketTag,
  363.     XMLDelta);
  364. end;
  365.  
  366. function TReconcilePageProducer.DeclareXMLIslands: string;
  367.   function DeclareXMLIsland(const XMLBrokerName, DocVarName, TagName, XMLData: string): string;
  368.   begin
  369.     Result := '';
  370.     Result := Format('%s<XML ID=%s>'#13#10, [Result, DocVarName]);
  371.     if (csDesigning in ComponentState) or (XMLData = '') then
  372.       Result := Format('%s<#%s %s=%s>'#13#10,
  373.         [Result, TagName, sXMLBroker, XMLBrokerName])
  374.     else
  375.       Result := Format('%s%s', [Result, XMLData]);
  376.     Result := Result + #13#10'</XML>'#13#10;
  377.   end;
  378. var
  379.   XMLBrokerName: string;
  380.   XMLErrors, XMLDelta: string;
  381. begin
  382.   GetXMLInfo(XMLBrokerName, XMLErrors, XMLDelta, []);
  383.   Result :=
  384.     DeclareXMLIsland(XMLBrokerName, sErrDocVarName, sErrorPacketTag,
  385.     XMLErrors);
  386.   Result := Result +
  387.     DeclareXMLIsland(XMLBrokerName, sDeltaDocVarName, sDeltaPacketTag,
  388.     XMLDelta);
  389. end;
  390.  
  391. function TReconcilePageProducer.DeclareRowSets: string;
  392. begin
  393.   Result := Format(
  394.     'var rowsetErr = new xmlRowSet(%0:s, null, null);'#13#10 +      // do not localize
  395.     'var rowsetDelta = new xmlRowSet(%1:s, null, null);'#13#10 +
  396.     'var frm1 = document.forms[''FORM1''];'#13#10 +
  397.     'var grid1 = new ErrReconcile(rowsetDelta,rowsetErr,'#13#10 +
  398.     '   new Array(frm1.col_FieldName,frm1.col_Modified,frm1.col_Conflicting,frm1.col_Original),'#13#10 +
  399.     '   new Array("FieldName","Modified","Conflicting","Original"),'#13#10 +
  400.     '   frm1.ErrMessage,frm1.ErrAction);'#13#10 +
  401.     '   grid1.setFocus(0,1);'#13#10,
  402.     [sErrDocVarName, sDeltaDocVarName]);
  403. end;
  404.  
  405. const
  406.   sSubmitFormName = 'Submitfrm1'; // Do not localize
  407.  
  408. procedure TReconcilePageProducer.AddScriptComponents;
  409.   procedure DeclareSubmitForm;
  410.   const
  411.     Indent1 = '  ';
  412.   var
  413.     PathInfo: string;
  414.     Redirect: string;
  415.     HTMLSubmitFormName: string;
  416.     SubmitFormVarName: string;
  417.     XMLBrokerName: string;
  418.     Forms: string;
  419.   begin
  420.     Forms := '';
  421.     HTMLSubmitFormName := sSubmitFormName;
  422.     SubmitFormVarName := sSubmitFormName;
  423.     if Assigned(FXMLBroker) then
  424.     begin
  425.       PathInfo := FXMLBroker.WebDispatch.PathInfo;
  426.       XMLBrokerName := FXMLBroker.Name;
  427.     end
  428.     else
  429.     begin
  430.       PathInfo := '';
  431.       XMLBrokerName := sDefaultXMLBrokerName;
  432.     end;
  433.     if Copy(PathInfo, 1, 1) = '/' then
  434.       Delete(PathInfo, 1, 1);
  435.     if Assigned(Dispatcher) and Assigned(Dispatcher.Request) then
  436.       PathInfo := Dispatcher.Request.ScriptName + '/' + PathInfo;
  437.     Forms := Forms +
  438.       Format('<FORM NAME=%0:s ACTION="%1:s" METHOD="POST">'#13#10,
  439.         [HTMLSubmitFormName, PathInfo]);
  440.     Forms := Forms +
  441.       Format('%0:s<INPUT TYPE=HIDDEN NAME="%1:s" VALUE="%2:s">'#13#10,
  442.         [Indent1, sXMLBroker, XMLBrokerName]);
  443.     Forms := Forms +
  444.       Format('%0:s<INPUT TYPE=HIDDEN NAME="%1:s">'#13#10,
  445.         [Indent1, SPostDelta]);
  446.     Forms := Forms +
  447.       Format('%0:s<INPUT TYPE=HIDDEN NAME="%1:s" VALUE="%2:s">'#13#10,
  448.         [Indent1, sProducer, Self.Name]);
  449.     if (Dispatcher <> nil) and (Dispatcher.Request <> nil) then
  450.     begin
  451.       Redirect := Dispatcher.Request.ContentFields.Values[SRedirect];
  452.       Forms := Forms +
  453.         Format('%0:s<INPUT TYPE=HIDDEN NAME="%1:s" VALUE="%2:s">'#13#10,
  454.           [Indent1, sRedirect, Redirect]);
  455.     end;
  456.     Forms := Forms + '</FORM>'#13#10;
  457.     ScriptManager.GetAddElementsIntf.AddHTMLBlock(HTMLSubmitFormName, Forms);
  458.     ScriptManager.GetAddElementsIntf.AddVar(SubmitFormVarName,
  459.        Format('var %0:s = document.forms[''%1:s''];'#13#10,
  460.       [SubmitFormVarName, HTMLSubmitFormName]));
  461.   end;
  462.  
  463. begin
  464.   inherited;
  465.   DeclareSubmitForm;
  466. end;
  467.  
  468. procedure TReconcilePageProducer.SetReconcileGrid(
  469.   const Value: TReconcileGrid);
  470. begin
  471.   FReconcileGrid.Assign(Value);
  472. end;
  473.  
  474. { TReconcileGrid }
  475.  
  476. constructor TReconcileGrid.Create(AOwner: TComponent);
  477. begin
  478.   inherited Create;
  479.   FDisplayRows := 4;
  480.   FTableAttributes := TGridAttributes.Create(AOwner);
  481.   FHeadingAttributes := TGridRowAttributes.Create(AOwner);
  482.   FRowAttributes := TGridRowAttributes.Create(AOwner);
  483.  
  484.   FTableAttributes.Border := 1;
  485.   FFieldNameColumn := TFieldNameColumn.Create(AOwner);
  486.   FModifiedColumn := TModifiedColumn.Create(AOwner);
  487.   FOriginalColumn := TOriginalColumn.Create(AOwner);
  488.   FConflictingColumn := TConflictingColumn.Create(AOwner);
  489. end;
  490.  
  491. destructor TReconcileGrid.Destroy;
  492. var
  493.   I: Integer;
  494. begin
  495.   inherited;
  496.   FTableAttributes.Free;
  497.   FHeadingAttributes.Free;
  498.   FRowAttributes.Free;
  499.   for I := 0 to ColumnCount - 1 do
  500.     Column[I].Free;
  501. end;
  502.  
  503. procedure TReconcileGrid.AssignTo(Dest: TPersistent);
  504. var
  505.   I: Integer;
  506. begin
  507.   if Dest is TReconcileGrid then
  508.     with TReconcileGrid(Dest) do
  509.     begin
  510.       FDisplayRows := Self.FDisplayRows;
  511.       FTableAttributes.Assign(Self.FTableAttributes);
  512.       FHeadingAttributes.Assign(Self.FHeadingAttributes);
  513.       FRowAttributes.Assign(Self.FRowAttributes);
  514.       for I := 0 to ColumnCount do
  515.         Column[I].Assign(Self.Column[I]);
  516.     end else inherited AssignTo(Dest);
  517. end;
  518.  
  519. function TReconcileGrid.FormatTable(Layout: TLayoutWebContent;
  520.   Options: TWebContentOptions): string;
  521.  
  522.   function TableHeader: string;
  523.   var
  524.     Attribs: string;
  525.   begin
  526.     AddStringAttrib(Attribs, 'NAME', HTMLTableName);
  527.     with TableAttributes do
  528.     begin
  529.       Attribs := Attribs + HTMLAlign[Align];
  530.       AddIntAttrib(Attribs, 'CELLSPACING', CellSpacing);
  531.       AddIntAttrib(Attribs, 'CELLPADDING', CellPadding);
  532.       AddIntAttrib(Attribs, 'BORDER', Border);
  533.       AddStringAttrib(Attribs, 'BGCOLOR', BgColor);
  534.       AddQuotedAttrib(Attribs, 'STYLE', Style);
  535.       AddQuotedAttrib(Attribs, 'CLASS', StyleRule);
  536.       AddCustomAttrib(Attribs, Custom);
  537.     end;
  538.     Result := Format(#13#10'<TABLE%s>', [Attribs]);
  539.   end;
  540.  
  541.   function RowHeader(HeadingAttributes: TGridRowAttributes): string;
  542.   var
  543.     Attribs: string;
  544.   begin
  545.     with HeadingAttributes do
  546.     begin
  547.       Attribs := Attribs + HTMLAlign[Align];
  548.       Attribs := Attribs + HTMLVAlign[VAlign];
  549.       AddQuotedAttrib(Attribs, 'BGCOLOR', BgColor);
  550.       AddQuotedAttrib(Attribs, 'STYLE', Style);
  551.       AddQuotedAttrib(Attribs, 'CLASS', StyleRule);
  552.       AddCustomAttrib(Attribs, Custom);
  553.     end;
  554.     Result := Format('<TR%s>', [Attribs]);
  555.   end;
  556.  
  557.   function FormatColumn(AColumn: TReconcileColumn; var OneRow: string): string;
  558.   var
  559.     Attribs: string;
  560.   begin
  561.     Result := '';
  562.     Attribs := '';
  563.     AddQuotedAttrib(Attribs, 'STYLE', AColumn.CaptionAttributes.Style);
  564.     AddCustomAttrib(Attribs, AColumn.CaptionAttributes.Custom);
  565.     AddQuotedAttrib(Attribs, 'CLASS', AColumn.CaptionAttributes.StyleRule);
  566.     Result := Format('%s<TH%s>%s</TH>'#13#10, [Result, Attribs, AColumn.Caption]);
  567.     Attribs := '';
  568.     AddQuotedAttrib(Attribs, 'STYLE', AColumn.Style);
  569.     AddCustomAttrib(Attribs, AColumn.Custom);
  570.     AddQuotedAttrib(Attribs, 'CLASS', AColumn.StyleRule);
  571.     OneRow := Format('%s<TD%s><DIV>%s</DIV></TD>'#13#10, [OneRow, Attribs,
  572.       AColumn.ControlContent(Options)]);
  573.   end;
  574.  
  575. var
  576.   I: Integer;
  577.   OneRow: string;
  578.   RowHeaderStr: string;
  579. begin
  580.   Result := TableHeader + RowHeader(HeadingAttributes) + #13#10;
  581.   for I := 0 to ColumnCount - 1 do
  582.     Result := Result + FormatColumn(Column[I], OneRow);
  583.   Result := Result + '</TR>';
  584.   RowHeaderStr := RowHeader(RowAttributes);
  585.   for I := 0 to DisplayRows - 1 do
  586.     Result := Format('%0:s%1:s%2:s</TR>'#13#10, [Result, RowHeaderStr, OneRow]);
  587.   Result := Result + '</TABLE>';
  588. end;
  589.  
  590. function TReconcileGrid.HTMLTableName: string;
  591. begin
  592.   Result := Format(ScriptTableName, ['Reconcile']);
  593. end;
  594.  
  595. procedure TReconcileGrid.SetHeadingAttributes(
  596.   const Value: TGridRowAttributes);
  597. begin
  598.   FHeadingAttributes.Assign(Value);
  599. end;
  600.  
  601. procedure TReconcileGrid.SetRowAttributes(const Value: TGridRowAttributes);
  602. begin
  603.   FRowAttributes.Assign(Value);
  604. end;
  605.  
  606. procedure TReconcileGrid.SetTableAttributes(const Value: TGridAttributes);
  607. begin
  608.   FTableAttributes.Assign(Value);
  609. end;
  610.  
  611. function TReconcileGrid.GetColumn(I: Integer): TReconcileColumn;
  612. begin
  613.   Result := nil;
  614.   case I of
  615.     0: Result := FFieldNameColumn;
  616.     1: Result := FModifiedColumn;
  617.     2: Result := FConflictingColumn;
  618.     3: Result := FOriginalColumn;
  619.   else
  620.     Assert(False, 'Column out of range');
  621.   end;
  622. end;
  623.  
  624. function TReconcileGrid.GetColumnCount: Integer;
  625. begin
  626.   Result := 4;
  627. end;
  628.  
  629. procedure TReconcileGrid.SetConflictingColumn(
  630.   const Value: TReconcileColumn);
  631. begin
  632.   FConflictingColumn.Assign(Value);
  633. end;
  634.  
  635. procedure TReconcileGrid.SetFieldNameColumn(const Value: TReconcileColumn);
  636. begin
  637.   FFieldNameColumn.Assign(Value);
  638. end;
  639.  
  640. procedure TReconcileGrid.SetModifiedColumn(const Value: TReconcileColumn);
  641. begin
  642.   FModifiedColumn.Assign(Value);
  643. end;
  644.  
  645. procedure TReconcileGrid.SetOriginalColumn(const Value: TReconcileColumn);
  646. begin
  647.   FOriginalColumn.Assign(Value);
  648. end;
  649.  
  650. { TReconcileColumn }
  651.  
  652. procedure TReconcileColumn.AssignTo(Dest: TPersistent);
  653. begin
  654.   if Dest is TReconcileColumn then
  655.     with TReconcileColumn(Dest) do
  656.     begin
  657.       FCaption := Self.FCaption;
  658.       FCustom := Self.FCustom;
  659.       FStyle := Self.FStyle;
  660.       FStyleRule := Self.FStyleRule;
  661.       FCaptionAttributes.Assign(Self.FCaptionAttributes);
  662.       FDisplayWidth := Self.FDisplayWidth;
  663.     end else inherited AssignTo(Dest);
  664. end;
  665.  
  666. function TReconcileColumn.ControlContent(
  667.   Options: TWebContentOptions): string;
  668.  
  669.   procedure AddAttributes(var Attrs: string);
  670.   begin
  671.     AddQuotedAttrib(Attrs, 'NAME', GetHTMLControlName);
  672.     AddIntAttrib(Attrs, 'SIZE', DisplayWidth);
  673.     AddIntAttrib(Attrs, 'MAXLENGTH', MaxWidth);
  674.     AddQuotedAttrib(Attrs, 'STYLE', Style);
  675.     AddQuotedAttrib(Attrs, 'CLASS', StyleRule);
  676.     AddCustomAttrib(Attrs, Custom);
  677.   end;
  678.  
  679.   function EventContent(Options: TWebContentOptions): string;
  680.   begin
  681.     Result := FEvents;
  682.   end;
  683.   
  684. var
  685.   Attrs: string;
  686.   Events: string;
  687. begin
  688.   AddAttributes(Attrs);
  689.   if (not (coNoScript in Options.Flags)) then
  690.     Events := EventContent(Options);
  691.   Result := Format('<INPUT TYPE=TEXT %0:s %1:s>', [Attrs, Events]);
  692. end;
  693.  
  694. constructor TReconcileColumn.Create(AOwner: TComponent);
  695. begin
  696.   inherited Create;
  697.   FCaptionAttributes := TCaptionAttributes.Create(AOwner);
  698.   FMaxWidth := -1;
  699. end;
  700.  
  701. destructor TReconcileColumn.Destroy;
  702. begin
  703.   inherited;
  704.   FCaptionAttributes.Free;
  705. end;
  706.  
  707. function TReconcileColumn.GetHTMLControlName: string;
  708. begin
  709.   Result := FName;
  710. end;
  711.  
  712. procedure TReconcileColumn.SetCaptionAttributes(
  713.   const Value: TCaptionAttributes);
  714. begin
  715.   FCaptionAttributes.Assign(Value);
  716. end;
  717.  
  718. { TFieldNameColumn }
  719.  
  720. constructor TFieldNameColumn.Create(AOwner: TComponent);
  721. begin
  722.   inherited;
  723.   FName := 'col_FieldName';
  724.   FEvents := 'onfocus = "blur();"';
  725.   FDisplayWidth := 18;
  726.   FCaption := sFieldNameCaption;
  727. end;
  728.  
  729. { TModifiedColumn }
  730.  
  731. constructor TModifiedColumn.Create(AOwner: TComponent);
  732. begin
  733.   inherited;
  734.   FName := 'col_Modified';
  735.   FEvents := 'onfocus = "grid1.xfocus(this);"';
  736.   FDisplayWidth := 24;
  737.   FCaption := sModifiedCaption;
  738. end;
  739.  
  740. { TConflictingColumn }
  741.  
  742. constructor TConflictingColumn.Create(AOwner: TComponent);
  743. begin
  744.   inherited;
  745.   FName := 'col_Conflicting';
  746.   FEvents := 'onfocus = "blur();"';
  747.   FDisplayWidth := 24;
  748.   FCaption := sConflictingCaption;
  749. end;
  750.  
  751. { TOriginalColumn }
  752.  
  753. constructor TOriginalColumn.Create(AOwner: TComponent);
  754. begin
  755.   inherited;
  756.   FName := 'col_Original';
  757.   FEvents := 'onfocus = "blur();"';
  758.   FDisplayWidth := 24;
  759.   FCaption := sOriginalCaption;
  760. end;
  761.  
  762. end.
  763.