Halaman utama Jelajahi Bantuan
Masuk
pascal
/
fpc
cermin dari https://gitlab.com/freepascal.org/fpc/source.git
2
0
Fork 0
Berkas Masalah 0 Wiki
Jelajahi Sumber

Merged revisions 8520-8521,8535-8537,8539-8546,8554,8560,8571-8572,8574-8576,8581-8587,8590,8593-8594,8596,8600,8605,8607,8625,8630-8638,8640-8641,8647 via svnmerge from
http://svn.freepascal.org/svn/fpc/trunk

........
r8520 | joost | 2007-09-17 16:39:27 +0200 (Mon, 17 Sep 2007) | 1 line

* Append content in DoHandleRequest, instead of replacing it
........
r8521 | joost | 2007-09-17 17:20:17 +0200 (Mon, 17 Sep 2007) | 1 line

* Added TIniwebSession.SessionCookiePath
........
r8571 | joost | 2007-09-20 21:26:48 +0200 (Thu, 20 Sep 2007) | 1 line

* Made THTMLWriter.StartElement and EndElement public instead of protected
........
r8572 | joost | 2007-09-20 21:33:55 +0200 (Thu, 20 Sep 2007) | 1 line

* Implemented TFormFieldItem.OnGetValue, OnGetLabel and OnGetAction
........
r8574 | joost | 2007-09-20 21:56:13 +0200 (Thu, 20 Sep 2007) | 3 lines

* TCustomPageContentProducer is renamed to THTMLEntityProducer and changed in such a way that it can produce more then only <html> tags.
* THTMLDatasetSelectProducer.Size is now an integer
* THTMLDatasetSelectProducer.PreSelected and UseValues implemented like in THTMLSelectProducer
........
r8647 | joost | 2007-09-26 01:03:33 +0200 (Wed, 26 Sep 2007) | 2 lines

* The value of a Checkbox or Rabiobutton should contain the value it should return if the control is checked. Not the value of the field itself.
* Fixed setting the Checked property
........

git-svn-id: branches/fixes_2_2@8714 -

peter 18 tahun lalu
induk
798e1461d2
melakukan
6b9822cce3
5 mengubah file dengan 98 tambahan dan 37 penghapusan
Tampilan Split Tampilkan Statistik Diff
  1. 50 15
      packages/fcl-web/src/fpdatasetform.pp
  2. 40 18
      packages/fcl-web/src/fphtml.pp
  3. 1 1
      packages/fcl-web/src/fpweb.pp
  4. 5 1
      packages/fcl-web/src/websession.pp
  5. 2 2
      packages/fcl-xml/src/htmlwriter.pp

+ 50 - 15
packages/fcl-web/src/fpdatasetform.pp
Tampilan Berkas 

@@ -35,6 +35,8 @@ type
 
   THTMLElementEvent = procedure (Sender:THTMLDatasetFormProducer; element : THTMLCustomElement) of object;
 
   TFieldCheckEvent = procedure (aField:TField; var check:boolean) of object;
 
   
+  TFieldItemEvent = procedure (Sender:TFormFieldItem; var aValue : string) of object;
 
+  
   TFormInputType = (fittext,fitpassword,fitcheckbox,fitradio,fitfile,fithidden,
 
                     fitproducer,fittextarea,fitrecordselection,fitlabel);
 
 
@@ -74,6 +76,10 @@ type
 
     FLabelPos: TTablePosition;
 
     FProducer: THTMLContentProducer;
 
     FValuePos: TTablePosition;
 
+    
+    FOnGetValue: TFieldItemEvent;
 
+    FOnGetLabel: TFieldItemEvent;
 
+    FOnGetAction: TFieldItemEvent;
 
     procedure SetLabelPos(const AValue: TTablePosition);
 
     procedure SetValuePos(const AValue: TTablePosition);
 
   protected
 
@@ -81,6 +87,9 @@ type
 
   public
 
     constructor Create(ACollection: TCollection); override;
 
     destructor Destroy; override;
 
+    function getValue : String; virtual;
 
+    function getLabel : String; virtual;
 
+    function getAction : String; virtual;
 
     property Field : TField read FField;
 
   published
 
     property Fieldname : string read FFieldName write FFieldname;
 
@@ -101,6 +110,9 @@ type
 
     { only when showing: }
 
     property Action : string read FAction write FAction;
 
       // the link to include in the value
 
+    property OnGetValue : TFieldItemEvent read FOnGetValue write FOnGetValue;
 
+    property OnGetLabel : TFieldItemEvent read FOnGetLabel write FOnGetLabel;
 
+    property OnGetAction : TFieldItemEvent read FOnGetAction write FOnGetAction;
 
   end;
 
 
   { TFormFieldCollection }
 
@@ -467,6 +479,30 @@ begin
 
   inherited Destroy;
 
 end;
 
 
+function TFormFieldItem.getValue: String;
 
+begin
 
+  if inputType in [fitcheckbox,fitradio] then
 
+    Result := 'T'
 
+  else
 
+    Result := FField.asstring;
 
+  if assigned (FOnGetValue) then
 
+    onGetValue(self,Result);
 
+end;
 
+
 
+function TFormFieldItem.getLabel: String;
 
+begin
 
+  Result := LabelCaption;
 
+  if assigned(FOnGetLabel) then
 
+    onGetLabel(Self,Result);
 
+end;
 
+
 
+function TFormFieldItem.getAction: String;
 
+begin
 
+  Result := Format(Action,[FField.asstring]);
 
+  if assigned(FOnGetAction) then
 
+    onGetAction(Self,Result);
 
+end;
 
+
 
 { TFormFieldCollection }
 
 
 function TFormFieldCollection.GetItem(index : integer): TFormFieldItem;
 
@@ -886,7 +922,7 @@ procedure THTMLDatasetFormEditProducer.ControlToTableDef (aControldef : TFormFie
 
           if aControlDef.inputType in [fitcheckbox,fitradio] then
 
             begin
 
             with aControlDef.Field do
 
-              Checked := asBoolean;
 
+              Check := asBoolean;
 
             if assigned (FOnFieldChecked) then
 
               FOnFieldChecked (aControlDef.Field, check);
 
             Checked := check;
 
@@ -900,10 +936,10 @@ procedure THTMLDatasetFormEditProducer.ControlToTableDef (aControldef : TFormFie
 
         fitrecordselection : ;
 
       end;
 
       IsLabel := false;
 
-      Value := aControlDef.FField.asstring;
 
+      Value := aControlDef.getValue;
 
       if not FSeparateLabel and not FIncludeHeader then
 
         begin
 
-        Caption := aControldef.LabelCaption;
 
+        Caption := aControldef.getLabel;
 
         IncludeBreak := aControldef.LabelAbove;
 
         end;
 
       end;
 
@@ -915,14 +951,14 @@ procedure THTMLDatasetFormEditProducer.ControlToTableDef (aControldef : TFormFie
 
       begin
 
       CellType := ctLabel;
 
       IsLabel := true;
 
-      Value := aControldef.labelcaption;
 
+      Value := aControldef.getLabel;
 
       end;
 
   end;
 
 
 begin
 
   if assigned (aControlDef.FField) then
 
     PlaceFieldValue;
 
-  if FSeparateLabel and (aControlDef.LabelCaption <> '') then
 
+  if FSeparateLabel and (aControlDef.getLabel <> '') then
 
     PlaceLabel;
 
 end;
 
 
@@ -984,10 +1020,10 @@ procedure THTMLDatasetFormShowProducer.ControlToTableDef (aControldef : TFormFie
 
       begin
 
       CellType := ctLabel;
 
       IsLabel := false;
 
-      Value := aControlDef.FField.asstring;
 
+      Value := aControlDef.getValue;
 
       if not FSeparateLabel and not FIncludeHeader then
 
         begin
 
-        Caption := aControldef.LabelCaption;
 
+        Caption := aControldef.getLabel;
 
         IncludeBreak := aControldef.LabelAbove;
 
         end;
 
       end;
 
@@ -999,14 +1035,14 @@ procedure THTMLDatasetFormShowProducer.ControlToTableDef (aControldef : TFormFie
 
       begin
 
       CellType := ctLabel;
 
       IsLabel := true;
 
-      Value := aControldef.labelcaption;
 
+      Value := aControldef.getLabel;
 
       end;
 
   end;
 
 
 begin
 
   if assigned (aControlDef.FField) then
 
     PlaceFieldValue;
 
-  if FSeparateLabel and (aControlDef.LabelCaption <> '') then
 
+  if FSeparateLabel and (aControlDef.getLabel <> '') then
 
     PlaceLabel;
 
 end;
 
 
@@ -1020,12 +1056,11 @@ procedure THTMLDatasetFormGridProducer.ControlToTableDef (aControldef : TFormFie
 
       begin
 
       CellType := ctLabel;
 
       IsLabel := false;
 
-      Value := aControlDef.FField.asstring;
 
-      if aControldef.Action <> '' then
 
-        Link := Format(aControldef.Action,[value]);
 
+      Value := aControlDef.getValue;
 
+      Link := aControldef.getAction;
 
       if not FSeparateLabel and not FIncludeHeader then
 
         begin
 
-        Caption := aControldef.LabelCaption;
 
+        Caption := aControldef.getLabel;
 
         IncludeBreak := aControldef.LabelAbove;
 
         end;
 
       end;
 
@@ -1037,14 +1072,14 @@ procedure THTMLDatasetFormGridProducer.ControlToTableDef (aControldef : TFormFie
 
       begin
 
       CellType := ctLabel;
 
       IsLabel := true;
 
-      Value := aControldef.labelcaption;
 
+      Value := aControldef.getLabel;
 
       end;
 
   end;
 
 
 begin
 
   if assigned (aControlDef.FField) and not IsHeader then
 
     PlaceFieldValue;
 
-  if (IsHeader or FSeparateLabel) and (aControlDef.LabelCaption <> '') then
 
+  if (IsHeader or FSeparateLabel) and (aControlDef.getLabel <> '') then
 
     PlaceLabel;
 
 end;

+ 40 - 18
packages/fcl-web/src/fphtml.pp
Tampilan Berkas 

@@ -20,6 +20,13 @@ interface
 
 uses
 
   Classes, SysUtils, htmlelements, htmlwriter, httpdefs, fphttp, db;
 
 
+type
 
+  THtmlEntities = (heHtml,heBody,heHead,heDiv,heParagraph);
 
+
 
+const
 
+  THtmlEntitiesClasses : array[THtmlEntities] of THTMLElementClass =
 
+    (THTML_html, THTML_body, THTML_head, THTML_div, THTML_p);
 
+
 
 type
 
 
   { THTMLContentProducer }
 
@@ -46,25 +53,27 @@ type
 
   TWriterEvent = procedure (Sender:THTMLContentProducer; aWriter : THTMLWriter) of object;
 
   TBooleanEvent = procedure (Sender:THTMLContentProducer; var flag : boolean) of object;
 
 
-  { THTMLCustomPagContentProducer }
 
-
 
-  { THTMLCustomPageContentProducer }
 
+  { THTMLCustomEntityProducer }
 
 
-  THTMLCustomPageContentProducer = class (THTMLContentProducer)
 
+  THTMLCustomEntityProducer = class (THTMLContentProducer)
 
   private
 
     FOnWritePage: TWriterEvent;
 
+    FEntity: THtmlEntities;
 
   protected
 
     function WriteContent (aWriter : THTMLWriter) : THTMLCustomElement; override;
 
     procedure DoWritePage (aWriter : THTMLWriter); virtual;
 
   public
 
+    constructor Create(AOwner: TComponent); override;
 
     Property OnWritePage : TWriterEvent read FOnWritePage write FOnWritePage;
 
+    Property Entity : THtmlEntities read FEntity write FEntity default heHtml;
 
   end;
 
 
   { THTMLCustomPagContentProducer }
 
 
-  THTMLPageContentProducer = class (THTMLCustomPageContentProducer)
 
+  THTMLEntityProducer = class (THTMLCustomEntityProducer)
 
   published
 
     Property OnWritePage;
 
+    Property Entity;
 
   end;
 
 
   { THTMLCustomDatasetContentProducer }
 
@@ -130,9 +139,11 @@ type
 
     FControlName: string;
 
     FIsPreSelected: TBooleanEvent;
 
     FItemField: string;
 
-    FSize: string;
 
+    FSize: integer;
 
     FValueField: string;
 
     FValue, FItem : TField;
 
+    FPreSelected: string;
 
+    FUseValues: boolean;
 
   protected
 
     procedure DoWriteHeader (aWriter : THTMLWriter; var el : THTMLCustomElement); override;
 
     procedure DoWriteFooter (aWriter : THTMLWriter); override;
 
@@ -140,10 +151,12 @@ type
 
   public
 
     constructor create (aOwner : TComponent); override;
 
   published
 
+    property UseValues : boolean read FUseValues write FUseValues default false;
 
+    property PreSelected : string read FPreSelected write FPreSelected;
 
     property ItemField : string read FItemField write FItemField;
 
     property ValueField : string read FValueField write FValueField;
 
     property OnIsPreSelected : TBooleanEvent read FIsPreSelected write FIsPreSelected;
 
-    property Size : string read FSize write FSize;
 
+    property Size : integer read FSize write FSize;
 
     property ControlName : string read FControlName write FControlName;
 
     property OnWriteHeader;
 
   end;
 
@@ -348,6 +361,7 @@ end;
 
 constructor THTMLSelectProducer.create(aOwner: TComponent);
 
 begin
 
   inherited create (aOwner);
 
+  FUseValues := False;
 
   FItems := TStringlist.Create;
 
   size := 1;
 
 end;
 
@@ -364,7 +378,7 @@ procedure THTMLDatasetSelectProducer.DoWriteHeader (aWriter : THTMLWriter; var e
 
 var s : THTML_Select;
 
 begin
 
   s := aWriter.StartSelect;
 
-  s.size := FSize;
 
+  s.size := IntToStr(FSize);
 
   s.name := FControlName;
 
   el := s;
 
   if FValueField <> '' then
 
@@ -386,12 +400,13 @@ begin
 
   if assigned (FItem) then
 
     with aWriter.Option(FItem.asstring) do
 
       begin
 
+      if FUseValues then
 
+        sel := (FValue.AsString = FPreSelected)
 
+      else
 
+        sel := (FItem.AsString = FPreSelected);
 
       if assigned (FIsPreSelected) then
 
-        begin
 
-        sel := false;
 
         FIsPreSelected (self, sel);
 
-        selected := sel;
 
-        end;
 
+      selected := sel;
 
       if assigned (FValue) then
 
         Value := FValue.Asstring;
 
       end;
 
@@ -400,7 +415,8 @@ end;
 
 constructor THTMLDatasetSelectProducer.create(aOwner: TComponent);
 
 begin
 
   inherited create(aOwner);
 
-  Size := '1';
 
+  Size := 1;
 
+  FUseValues := False;
 
 end;
 
 
 { TCustomHTMLDataModule }
 
@@ -492,21 +508,27 @@ begin
 
     FOnGetContent(Self,ARequest,HTMLPage,Handled);
 
 end;
 
 
-{ THTMLCustomPageContentProducer }
 
+{ THTMLCustomEntityProducer }
 
 
-function THTMLCustomPageContentProducer.WriteContent(aWriter: THTMLWriter
 
+function THTMLCustomEntityProducer.WriteContent(aWriter: THTMLWriter
 
   ): THTMLCustomElement;
 
 begin
 
-  result := aWriter.Starthtml;
 
+  result := aWriter.StartElement(THtmlEntitiesClasses[FEntity]);
 
   DoWritePage(aWriter);
 
-  aWriter.Endhtml;
 
+  aWriter.EndElement(THtmlEntitiesClasses[FEntity]);
 
 end;
 
 
-procedure THTMLCustomPageContentProducer.DoWritePage(aWriter: THTMLWriter);
 
+procedure THTMLCustomEntityProducer.DoWritePage(aWriter: THTMLWriter);
 
 begin
 
   if assigned (FOnWritePage) then
 
     FOnWritePage (self, aWriter);
 
 end;
 
 
+constructor THTMLCustomEntityProducer.Create(AOwner: TComponent);
 
+begin
 
+  inherited Create(AOwner);
 
+  FEntity := heHtml;
 
+end;
 
+
 
 end.

+ 1 - 1
packages/fcl-web/src/fpweb.pp
Tampilan Berkas 

@@ -253,7 +253,7 @@ begin
 
     Inherited DoHandleRequest(ARequest,AResponse,Handled);
 
     If not Handled then
 
       begin
 
-      AResponse.Content:=Self.Content;
 
+      AResponse.Contents.AddStrings(Self.Contents);
 
       Handled:=(AResponse.Content<>'');
 
       end;
 
     end;

+ 5 - 1
packages/fcl-web/src/websession.pp
Tampilan Berkas 

@@ -53,6 +53,7 @@ Type
 
     FCached: Boolean;
 
     FIniFile : TMemInifile;
 
     FSessionCookie: String;
 
+    FSessionCookiePath: String;
 
     FSessionDir: String;
 
     FTerminated :Boolean;
 
     SID : String;
 
@@ -64,6 +65,7 @@ Type
 
     Property Cached : Boolean Read FCached Write FCached;
 
     property SessionCookie : String Read FSessionCookie Write FSessionCookie;
 
     Property SessionDir : String Read FSessionDir Write FSessionDir;
 
+    Property SessionCookiePath : String Read FSessionCookiePath write FSessionCookiePath;
 
   Public
 
     Destructor Destroy; override;
 
     Procedure Terminate; override;
 
@@ -77,6 +79,7 @@ Type
 
   Public
 
     Property Cached;
 
     property SessionCookie;
 
+    Property SessionCookiePath;
 
     Property SessionDir;
 
   end;
 
 
@@ -263,7 +266,8 @@ begin
 
     C:=AResponse.Cookies.Add;
 
     C.Name:=SessionCookie;
 
     C.Value:=SID;
 
-     end
 
+    C.Path:=FSessionCookiePath;
 
+    end
 
   else If FTerminated then
 
     begin
 
 {$ifdef cgidebug}SendDebug('Session terminated');{$endif}

+ 2 - 2
packages/fcl-xml/src/htmlwriter.pp
Tampilan Berkas 

@@ -37,10 +37,10 @@ type
 
     function CreateElement (tag : THTMLElementClass; sub : THTMLCustomElement) : THTMLCustomElement;
 
     function CreateElement (tag : THTMLElementClass; subs : Array of THTMLCustomElement) : THTMLCustomElement;
 
     function CreateElement (tag : THTMLElementClass; subs : TDOMNodelist) : THTMLCustomElement;
 
-    function StartElement (tag : THTMLElementClass) : THTMLCustomElement;
 
-    function EndElement (tag : THTMLElementClass) : THTMLCustomElement;
 
     function AddElement (tag : THTMLElementClass) : THTMLCustomElement;
 
   public
 
+    function StartElement (tag : THTMLElementClass) : THTMLCustomElement;
 
+    function EndElement (tag : THTMLElementClass) : THTMLCustomElement;
 
     constructor create (aDocument : THTMLDocument);
 
     procedure AddElement (el : THTMLCustomElement);
 
     procedure AddElements (subs : TDOMNodelist);