* Implemented THTMLDatasetFormProducer.AfterSetRecord

* Fixed some compiler-warnings
 * Fixed possible AV
 * When a label also is a link, really make a link
 * Removed (almost) duplicate code in PlaceFieldValue

git-svn-id: trunk@12974 -

packages/fcl-web/src/fpdatasetform.pp

@@ -32,6 +32,7 @@ type
                       Button : THTMLAttrsElement) of object;
   TProducerEvent = procedure (Sender:THTMLDatasetFormProducer;  FieldDef:TFormFieldItem;
                       Producer:THTMLContentProducer) of object;
+  TProducerSetRecordEvent = procedure (Sender:THTMLDatasetFormProducer) of object;
   THTMLElementEvent = procedure (Sender:THTMLDatasetFormProducer; element : THTMLCustomElement) of object;
   TFieldCheckEvent = procedure (aField:TField; var check:boolean) of object;
   
@@ -86,7 +87,7 @@ type
   protected
     procedure AssignTo(Dest: TPersistent); override;
     Function  GetDisplayName : String; override;
-    Procedure SetDisplayName(AValue : String);
+    Procedure SetDisplayName(const Value : String); override;
   public
     constructor Create(ACollection: TCollection); override;
     destructor Destroy; override;
@@ -271,6 +272,7 @@ type
 
   THTMLDatasetFormProducer = class (THTMLContentProducer)
   private
+    FAfterSetRecord: TProducerSetRecordEvent;
     FOnInitializeProducer : TProducerEvent;
     FOnFieldChecked : TFieldCheckEvent;
     FAfterTBodyCreate,
@@ -299,8 +301,8 @@ type
     procedure CorrectCellSpans;
     procedure SearchControlFields;
   protected
-    function WriteContent (aWriter : THTMLWriter) : THTMLCustomElement; override;
     procedure FillTableDef (IsHeader:boolean); virtual;
+    procedure PlaceFieldValue(aControldef : TFormFieldItem); virtual;
     procedure ControlToTableDef (aControldef : TFormFieldItem; IsHeader:boolean); virtual; abstract;
     function StartForm (aWriter : THTMLWriter) : THTMLCustomElement; virtual;
     procedure EndForm (aWriter : THTMLWriter); virtual;
@@ -316,6 +318,7 @@ type
   public
     constructor create (aOwner : TComponent); override;
     destructor destroy; override;
+    function WriteContent (aWriter : THTMLWriter) : THTMLCustomElement; override;
   published
     property FormAction : string read FFormAction write FFormAction;
       // action of the form (link), if not given; don't use a form element
@@ -347,6 +350,8 @@ type
       // Called after the creation of the table
     property AfterTBodyCreate : THTMLElementEvent read FAfterTBodyCreate write FAfterTBodyCreate;
       // Called after finishing the tbody of each record
+    property AfterSetRecord : TProducerSetRecordEvent read FAfterSetRecord write FAfterSetRecord;
+      // Called after the dataset is scrolled to the next record
     property OnFieldChecked : TFieldCheckEvent read FOnFieldChecked write FOnFieldChecked;
       // return if the field is true or false if the false string differs from '0','false','-'
   end;
@@ -376,6 +381,7 @@ type
     property RecordsPerPage;
     property Page;
     property IncludeHeader;
+    property AfterSetRecord;
   end;
   
 implementation
@@ -481,10 +487,10 @@ begin
   Result:=FName;
 end;
 
-procedure TFormFieldItem.SetDisplayName(AValue: String);
+procedure TFormFieldItem.SetDisplayName(const Value: String);
 begin
   Inherited;
-  FName:=AValue;
+  FName:=Value;
 end;
 
 constructor TFormFieldItem.Create(ACollection: TCollection);
@@ -791,7 +797,6 @@ end;
 procedure THTMLDatasetFormProducer.CorrectCellSpans;
 var r, s, t : integer;
     c : TTableCell;
-    ReachedEnd : boolean;
 begin
   for r := 0 to TableDef.count-1 do
     with TableDef.items[r] do
@@ -898,6 +903,8 @@ begin
           r := 0;
           while not eof and (r < RecordsPerPage) do
             begin
+            if assigned (FAfterSetRecord) then
+              FAfterSetRecord (self);
             FillTableDef (false);
             CorrectCellSpans;
             WriteTableDef (aWriter);
@@ -921,35 +928,9 @@ begin
     ControlToTableDef (Controls.items[r], IsHeader);
 end;
 
-function THTMLDatasetFormProducer.SingleRecord: boolean;
+procedure THTMLDatasetFormProducer.PlaceFieldValue(aControldef : TFormFieldItem);
+var check : boolean;
 begin
-  result := true;
-end;
-
-constructor THTMLDatasetFormProducer.create(aOwner: TComponent);
-begin
-  inherited create(aOwner);
-  FTableCols := 2;
-  FButtonsHor := bhpLeft;
-  FButtonsVer := [bvpTop, bvpBottom];
-  Fbuttonrow := TFormButtonCollection.create;
-  FControls := TFormFieldCollection.Create;
-end;
-
-destructor THTMLDatasetFormProducer.destroy;
-begin
-  Fbuttonrow.Free;
-  FControls.Free;
-  inherited destroy;
-end;
-
-{ THTMLDatasetFormEditProducer }
-
-procedure THTMLDatasetFormEditProducer.ControlToTableDef (aControldef : TFormFieldItem; IsHeader:boolean);
-
-  procedure PlaceFieldValue;
-  var check : boolean;
-  begin
   with TableDef.CopyTablePosition(aControlDef.ValuePos) do
     begin
     FormField := aControldef;
@@ -981,18 +962,46 @@ procedure THTMLDatasetFormEditProducer.ControlToTableDef (aControldef : TFormFie
         begin
         CellType := ctProducer;
         Producer := aControlDef.Producer;
+//        if Producer is THTMLSelectProducer then THTMLSelectProducer(Producer).PreSelected:=aControldef.getValue;
         end;
       fitrecordselection : ;
     end;
     IsLabel := false;
     Value := aControlDef.getValue;
+    Link := aControldef.getAction;
     if not FSeparateLabel and not FIncludeHeader then
       begin
       Caption := aControldef.getLabel;
       IncludeBreak := aControldef.LabelAbove;
       end;
     end;
-  end;
+end;
+
+function THTMLDatasetFormProducer.SingleRecord: boolean;
+begin
+  result := true;
+end;
+
+constructor THTMLDatasetFormProducer.create(aOwner: TComponent);
+begin
+  inherited create(aOwner);
+  FTableCols := 2;
+  FButtonsHor := bhpLeft;
+  FButtonsVer := [bvpTop, bvpBottom];
+  Fbuttonrow := TFormButtonCollection.create;
+  FControls := TFormFieldCollection.Create;
+end;
+
+destructor THTMLDatasetFormProducer.destroy;
+begin
+  Fbuttonrow.Free;
+  FControls.Free;
+  inherited destroy;
+end;
+
+{ THTMLDatasetFormEditProducer }
+
+procedure THTMLDatasetFormEditProducer.ControlToTableDef (aControldef : TFormFieldItem; IsHeader:boolean);
 
   procedure PlaceLabel;
   begin
@@ -1007,7 +1016,7 @@ procedure THTMLDatasetFormEditProducer.ControlToTableDef (aControldef : TFormFie
 
 begin
   if assigned (aControlDef.FField) then
-    PlaceFieldValue;
+    PlaceFieldValue(aControldef);
   if FSeparateLabel and (aControlDef.getLabel <> '') then
     PlaceLabel;
 end;
@@ -1102,35 +1111,6 @@ end;
 
 procedure THTMLDatasetFormGridProducer.ControlToTableDef (aControldef : TFormFieldItem; IsHeader:boolean);
 
-  procedure PlaceFieldValue;
-  var check : boolean;
-  begin
-    with TableDef.CopyTablePosition(aControlDef.ValuePos) do
-      begin
-      if aControldef.InputType = fitcheckbox then
-        begin
-        CellType := ctInput;
-        InputType := aControldef.InputType;
-        Disabled := True;
-        with aControlDef.Field do
-          Check := asBoolean;
-        if assigned (FOnFieldChecked) then
-          FOnFieldChecked (aControlDef.Field, check);
-        Checked := check;
-        end
-      else
-        CellType := ctLabel;
-      IsLabel := false;
-      Value := aControlDef.getValue;
-      Link := aControldef.getAction;
-      if not FSeparateLabel and not FIncludeHeader then
-        begin
-        Caption := aControldef.getLabel;
-        IncludeBreak := aControldef.LabelAbove;
-        end;
-      end;
-  end;
-
   procedure PlaceLabel;
   begin
     with TableDef.CopyTablePosition(aControlDef.LabelPos) do
@@ -1143,7 +1123,7 @@ procedure THTMLDatasetFormGridProducer.ControlToTableDef (aControldef : TFormFie
 
 begin
   if assigned (aControlDef.FField) and not IsHeader then
-    PlaceFieldValue;
+    PlaceFieldValue(aControldef);
   if (IsHeader or FSeparateLabel) and (aControlDef.getLabel <> '') then
     PlaceLabel;
 end;
@@ -1215,13 +1195,16 @@ function TTableCell.WriteContent(aWriter: THTMLWriter) : THTMLCustomElement;
       fithidden :
         aWriter.FormHidden (Name, Value);
       fitlabel :
+        if link <> '' then
+          aWriter.Anchor(Value).href := Link
+        else
           aWriter.Text (Value);
     end;
   end;
 
   procedure WriteProducer;
   begin
-    with Producer do
+    if assigned(Producer) then with Producer do
       begin
       ParentElement := aWriter.CurrentElement;
       HTMLDocument := aWriter.Document;
@@ -1270,7 +1253,6 @@ end;
 
 function TTableCell.WriteHeader(aWriter: THTMLWriter) : THTMLCustomElement;
 var c : THTML_th;
-    s : string;
 begin
     with aWriter do
       begin