paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-21 15:29:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Implemented THTMLDatasetFormProducer.AfterSetRecord

Browse Source 
* 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 -
This commit is contained in:
joost 2009-03-29 09:40:09 +00:00
parent 986553771d
commit 8ffb1a751e
1 changed files with 68 additions and 86 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

154
packages/fcl-web/src/fpdatasetform.pp
View File

@ -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,6 +928,55 @@ begin
ControlToTableDef (Controls.items[r], IsHeader);
end;
procedure THTMLDatasetFormProducer.PlaceFieldValue(aControldef : TFormFieldItem);
var check : boolean;
begin
with TableDef.CopyTablePosition(aControlDef.ValuePos) do
begin
FormField := aControldef;
case aControlDef.inputtype of
fitlabel,
fittext,
fitpassword,
fitcheckbox,
fitradio,
fitfile,
fithidden,
fittextarea :
begin
CellType := ctInput;
InputType := aControlDef.InputType;
Name := aControlDef.Field.FieldName;
Size := aControlDef.Field.DisplayWidth;
MaxLength := aControldef.Field.Size;
if aControlDef.inputType in [fitcheckbox,fitradio] then
begin
with aControlDef.Field do
Check := asBoolean;
if assigned (FOnFieldChecked) then
FOnFieldChecked (aControlDef.Field, check);
Checked := check;
end;
end;
fitproducer :
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;
function THTMLDatasetFormProducer.SingleRecord: boolean;
begin
result := true;
@ -947,53 +1003,6 @@ end;
procedure THTMLDatasetFormEditProducer.ControlToTableDef (aControldef : TFormFieldItem; IsHeader:boolean);
procedure PlaceFieldValue;
var check : boolean;
begin
with TableDef.CopyTablePosition(aControlDef.ValuePos) do
begin
FormField := aControldef;
case aControlDef.inputtype of
fitlabel,
fittext,
fitpassword,
fitcheckbox,
fitradio,
fitfile,
fithidden,
fittextarea :
begin
CellType := ctInput;
InputType := aControlDef.InputType;
Name := aControlDef.Field.FieldName;
Size := aControlDef.Field.DisplayWidth;
MaxLength := aControldef.Field.Size;
if aControlDef.inputType in [fitcheckbox,fitradio] then
begin
with aControlDef.Field do
Check := asBoolean;
if assigned (FOnFieldChecked) then
FOnFieldChecked (aControlDef.Field, check);
Checked := check;
end;
end;
fitproducer :
begin
CellType := ctProducer;
Producer := aControlDef.Producer;
end;
fitrecordselection : ;
end;
IsLabel := false;
Value := aControlDef.getValue;
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
@ -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 :
aWriter.Text (Value);
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