paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-28 03:30:30 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Fixed (BLOB) display, added support for transcoding

Browse Source 
git-svn-id: trunk@15893 -
This commit is contained in:
michael 2010-08-24 14:40:22 +00:00
parent 8b874e0646
commit 6f17f34fee
3 changed files with 27 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
packages/fcl-web/src/webdata/extjsjson.pp
View File

@ -106,6 +106,10 @@ end;
function TExtJSJSONDataFormatter.AddFieldToJSON(O : TJSONObject; AFieldName : String; F : TField): TJSONData;
Var
S : String;
begin
if F.IsNull then
Result:=O.Items[O.Add(AFieldName)]
@ -129,9 +133,18 @@ begin
ftMemo,
ftFmtMemo,
ftWideMemo,
ftBlob :O.Items[O.Add(AFieldName,F.AsString)];
ftBlob :
begin
S:=F.AsString;
If (OnTranscode<>Nil) then
OnTranscode(Self,F,S,True);
Result:=O.Items[O.Add(AFieldName,S)];
end;
else
Result:=O.Items[O.Add(AFieldName,F.DisplayText)];
S:=F.DisplayText;
If (OnTranscode<>Nil) then
OnTranscode(Self,F,S,True);
Result:=O.Items[O.Add(AFieldName,S)];
end;
end;

9
packages/fcl-web/src/webdata/extjsxml.pp
View File

@ -172,6 +172,7 @@ Var
E : TDOMElement;
F : TField;
I : Integer;
S : String;
begin
Result:=Doc.CreateElement(RecordProperty);
try
@ -180,7 +181,13 @@ begin
begin
F:=Dataset.Fields[i];
E:=Doc.CreateElement(F.FieldName);
E.AppendChild(Doc.CreateTextNode(F.DisplayText));
If F.DataType in [ftMemo, ftFmtMemo, ftWideMemo, ftBlob ] then
S:=F.AsString
else
S:=F.DisplayText;
If (OnTranscode<>Nil) then
OnTranscode(Self,F,S,True);
E.AppendChild(Doc.CreateTextNode(S));
Result.AppendChild(E);
end;
DoAfterRow(Result);

4
packages/fcl-web/src/webdata/fpwebdata.pp
View File

@ -122,12 +122,15 @@ type
// Handle request for read/create/update/delete and return a result.
{ TCustomHTTPDataContentProducer }
// Support for transcoding from/to UTF-8. If outbound is true, the value is going from server to browser.
TOnTranscodeEvent = Procedure (Sender : TObject; F : TField; Var S : String; Outbound : Boolean) of object;
TCustomHTTPDataContentProducer = Class(THTTPContentProducer)
Private
FAllowPageSize: Boolean;
FDataProvider: TFPCustomWebDataProvider;
FMetadata: Boolean;
FOnTranscode: TOnTranscodeEvent;
FPageSize: Integer;
FPageStart: Integer;
FSD: Boolean;
@ -161,6 +164,7 @@ type
Property SortField : String Read FSortField Write FSortField;
Property SortDescending : Boolean Read FSD Write FSD default False;
Property AllowPageSize : Boolean Read FAllowPageSize Write FAllowPageSize default True;
Property OnTransCode : TOnTranscodeEvent Read FOnTranscode Write FOnTranscode;
end;
TCustomHTTPDataContentProducerClass = Class of TCustomHTTPDataContentProducer;