Browse Source

--- Merging r16874 into '.':
U packages/fcl-web/src/base/fpweb.pp
--- Merging r16896 into '.':
U packages/fcl-web/src/base/webpage.pp
U packages/fcl-web/src/base/fphtml.pp
--- Merging r16898 into '.':
U packages/fcl-web/src/base/custweb.pp

# revisions: 16874,16896,16898
------------------------------------------------------------------------
r16874 | michael | 2011-02-03 16:52:28 +0100 (Thu, 03 Feb 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-web/src/base/fpweb.pp

* If request handled correctly, send content if it was not yet sent
------------------------------------------------------------------------
------------------------------------------------------------------------
r16896 | joost | 2011-02-08 17:58:48 +0100 (Tue, 08 Feb 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-web/src/base/fphtml.pp
M /trunk/packages/fcl-web/src/base/webpage.pp

* Implemented TContainerStylesheets
------------------------------------------------------------------------
------------------------------------------------------------------------
r16898 | joost | 2011-02-08 20:22:09 +0100 (Tue, 08 Feb 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-web/src/base/custweb.pp

* Make Terminated property accessible for descendents
------------------------------------------------------------------------

git-svn-id: branches/fixes_2_4@16970 -

marco 14 years ago
parent
commit
acb4ca126f

+ 1 - 0
packages/fcl-web/src/base/custweb.pp

@@ -108,6 +108,7 @@ Type
     procedure ShowRequestException(R: TResponse; E: Exception); virtual;
     Function GetEmail : String; virtual;
     Function GetAdministrator : String; virtual;
+    property Terminated: boolean read FTerminated;
   Public
     constructor Create(AOwner: TComponent); override;
     Procedure Run; virtual;

+ 43 - 0
packages/fcl-web/src/base/fphtml.pp

@@ -63,6 +63,28 @@ type
     property WebController: TWebController read GetWebController;
   end;
 
+  { TContainerStylesheet }
+
+  TContainerStylesheet = class(TCollectionItem)
+  private
+    Fhref: string;
+    Fmedia: string;
+  published
+    property href: string read Fhref write Fhref;
+    property media: string read Fmedia write Fmedia;
+  end;
+
+  { TContainerStylesheets }
+
+  TContainerStylesheets = class(TCollection)
+  private
+    function GetItem(Index: integer): TContainerStylesheet;
+    procedure SetItem(Index: integer; const AValue: TContainerStylesheet);
+  public
+    function Add: TContainerStylesheet;
+    property Items[Index: integer]: TContainerStylesheet read GetItem write SetItem;
+  end;
+
   { TWebController }
 
   TWebController = class(TComponent)
@@ -77,12 +99,14 @@ type
   protected
     function GetScriptFileReferences: TStringList; virtual; abstract;
     function GetCurrentJavaScriptStack: TJavaScriptStack; virtual;
+    function GetStyleSheetReferences: TContainerStylesheets; virtual; abstract;
     function GetScripts: TFPObjectList; virtual; abstract;
     function GetRequest: TRequest;
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
     procedure AddScriptFileReference(AScriptFile: String); virtual; abstract;
+    procedure AddStylesheetReference(Ahref, Amedia: String); virtual; abstract;
     function CreateNewJavascriptStack: TJavaScriptStack; virtual; abstract;
     function InitializeJavaScriptStack: TJavaScriptStack;
     procedure FreeJavascriptStack; virtual;
@@ -100,6 +124,7 @@ type
     function AddrelativeLinkPrefix(AnURL: string): string;
     procedure FreeScript(var AScript: TStringList); virtual; abstract;
     property ScriptFileReferences: TStringList read GetScriptFileReferences;
+    property StyleSheetReferences: TContainerStylesheets read GetStyleSheetReferences;
     property Scripts: TFPObjectList read GetScripts;
     property CurrentJavaScriptStack: TJavaScriptStack read GetCurrentJavaScriptStack;
     property MessageBoxHandler: TMessageBoxHandler read FMessageBoxHandler write FMessageBoxHandler;
@@ -451,6 +476,24 @@ resourcestring
   SErrRequestNotHandled = 'Web request was not handled by actions.';
   SErrNoContentProduced = 'The content producer "%s" didn''t produce any content.';
 
+{ TcontainerStylesheets }
+
+function TcontainerStylesheets.GetItem(Index: integer): TContainerStylesheet;
+begin
+  result := TContainerStylesheet(Inherited GetItem(Index));
+end;
+
+procedure TcontainerStylesheets.SetItem(Index: integer; const AValue: TContainerStylesheet);
+begin
+  inherited SetItem(Index, AValue);
+end;
+
+function TcontainerStylesheets.Add: TContainerStylesheet;
+begin
+  result := inherited Add as TContainerStylesheet;
+end;
+
+
 { TJavaScriptStack }
 
 function TJavaScriptStack.GetWebController: TWebController;

+ 7 - 1
packages/fcl-web/src/base/fpweb.pp

@@ -449,7 +449,12 @@ begin
   InitSession(AResponse);
   If Assigned(FOnRequest) then
     FOnRequest(Self,ARequest,AResponse,B);
-  If Not B then
+  If B then
+    begin
+    if not AResponse.ContentSent then
+      AResponse.SendContent;
+    end
+  else
     if FTemplate.HasContent then
       GetTemplateContent(ARequest,AResponse)
     else
@@ -460,6 +465,7 @@ begin
       If Not B then
         Raise EFPWebError.Create(SErrRequestNotHandled);
       end;
+      
   DoAfterResponse(AResponse);
   UpdateSession(AResponse);
   FRequest := Nil;

+ 19 - 0
packages/fcl-web/src/base/webpage.pp

@@ -24,9 +24,11 @@ type
   private
     FScriptFileReferences: TStringList;
     FScripts: TFPObjectList;
+    FStyleSheetReferences: TContainerStylesheets;
   protected
     function GetScriptFileReferences: TStringList; override;
     function GetScripts: TFPObjectList; override;
+    function GetStyleSheetReferences: TContainerStylesheets; override;
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
@@ -34,6 +36,7 @@ type
     function GetUrl(ParamNames, ParamValues, KeepParams: array of string; Action: string = ''): string; override;
     procedure BindJavascriptCallstackToElement(AComponent: TComponent; AnElement: THtmlCustomElement; AnEvent: string); override;
     procedure AddScriptFileReference(AScriptFile: String); override;
+    procedure AddStylesheetReference(Ahref, Amedia: String); override;
     function DefaultMessageBoxHandler(Sender: TObject; AText: String; Buttons: TWebButtons; ALoaded: string = ''): string; override;
     function CreateNewScript: TStringList; override;
     procedure FreeScript(var AScript: TStringList); override;
@@ -339,6 +342,11 @@ begin
   Result:=FScripts;
 end;
 
+function TStandardWebController.GetStyleSheetReferences: TContainerStylesheets;
+begin
+  Result:=FStyleSheetReferences;
+end;
+
 function TStandardWebController.CreateNewScript: TStringList;
 begin
   Result:=TStringList.Create;
@@ -382,6 +390,7 @@ end;
 constructor TStandardWebController.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);
+  FStyleSheetReferences := TContainerStylesheets.Create(TContainerStylesheet);
   FScriptFileReferences := TStringList.Create;
   // For some reason the Duplicates property does not work when sorted is true,
   // But we don't want a sorted list so do a manual check in AddScriptFileReference
@@ -393,6 +402,7 @@ destructor TStandardWebController.Destroy;
 begin
   FScriptFileReferences.Free;
   FScripts.Free;
+  FStyleSheetReferences.Free;
   inherited Destroy;
 end;
 
@@ -498,5 +508,14 @@ begin
     FScriptFileReferences.Add(AScriptFile);
 end;
 
+procedure TStandardWebController.AddStylesheetReference(Ahref, Amedia: String);
+begin
+  with FStyleSheetReferences.Add do
+    begin
+    href:=Ahref;
+    media:=Amedia;
+    end;
+end;
+
 end.