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

* Added TWebController.onGetURL property

Browse Source 
* Made TWebPage.Module public
 * Fixed handling ajax-calls of components within containers
 * THtmlContentProducer.GetIdentification added
 * Ability to reset the iteration-level

git-svn-id: trunk@17615 -
This commit is contained in:
joost 2011-05-31 08:12:47 +00:00
parent ce8fbf62d4
commit 60ee15200b
2 changed files with 24 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
packages/fcl-web/src/base/fphtml.pp
View File

@ -39,6 +39,7 @@ type
TWebButtons = array of TWebButton;
TMessageBoxHandler = function(Sender: TObject; AText: String; Buttons: TWebButtons; Loaded: string = ''): string of object;
TOnGetUrlProc = procedure(ParamNames, ParamValues, KeepParams: array of string; Action: string; var URL: string) of object;
TWebController = class;
THTMLContentProducer = class;
@ -125,6 +126,7 @@ type
FAddRelURLPrefix: boolean;
FBaseURL: string;
FMessageBoxHandler: TMessageBoxHandler;
FOnGetURL: TOnGetUrlProc;
FScriptName: string;
FScriptStack: TFPObjectList;
FIterationIDs: array of string;
@ -139,6 +141,7 @@ type
function GetStyleSheetReferences: TContainerStylesheets; virtual; abstract;
function GetScripts: TFPObjectList; virtual; abstract;
function GetRequest: TRequest;
property OnGetURL: TOnGetUrlProc read FOnGetURL write FOnGetURL;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
@ -164,6 +167,7 @@ type
procedure ShowRegisteredScript(ScriptID: integer); virtual; abstract;
function IncrementIterationLevel: integer; virtual;
function ResetIterationLevel: integer; virtual;
procedure SetIterationIDSuffix(AIterationLevel: integer; IDSuffix: string); virtual;
function GetIterationIDSuffix: string; virtual;
procedure DecrementIterationLevel; virtual;
@ -247,6 +251,7 @@ type
procedure SetParent(const AValue: TComponent);
Protected
function CreateWriter (Doc : THTMLDocument) : THTMLWriter; virtual;
function GetIdentification: string; virtual;
function GetIDSuffix: string; virtual;
procedure SetIDSuffix(const AValue: string); virtual;
protected
@ -284,6 +289,7 @@ type
function MoveContentProducer(MoveElement, MoveBeforeElement: THTMLContentProducer) : boolean;
procedure HandleAjaxRequest(ARequest: TRequest; AnAjaxResponse: TAjaxResponse); virtual;
procedure ForeachContentProducer(AForeachChildsProc: TForeachContentProducerProc; Recursive: boolean);
property Identification: string read GetIdentification;
property Childs[Index: integer]: THTMLContentProducer read GetContentProducers;
property AcceptChildsAtDesignTime: boolean read FAcceptChildsAtDesignTime;
property parent: TComponent read FParent write SetParent;
@ -676,6 +682,11 @@ begin
Result := FChilds;
end;
function THTMLContentProducer.GetIdentification: string;
begin
result := '';
end;
function THTMLContentProducer.ProduceContent: String;
var WCreated, created : boolean;
el : THtmlCustomElement;
@ -1440,6 +1451,11 @@ begin
SetLength(FIterationIDs,Result);
end;
function TWebController.ResetIterationLevel: integer;
begin
SetLength(FIterationIDs,0);
end;
procedure TWebController.SetIterationIDSuffix(AIterationLevel: integer; IDSuffix: string);
begin
FIterationIDs[AIterationLevel-1]:=IDSuffix;

11
packages/fcl-web/src/base/webpage.pp
View File

@ -61,6 +61,8 @@ type
function CreateNewScript: TStringList; override;
procedure ShowRegisteredScript(ScriptID: integer); override;
procedure FreeScript(var AScript: TStringList); override;
published
property OnGetURL;
end;
{ TWebPage }
@ -89,7 +91,6 @@ type
procedure DoHandleAjaxRequest(ARequest: TRequest; AnAjaxResponse: TAjaxResponse; var Handled: boolean); virtual;
procedure DoBeforeRequest(ARequest: TRequest); virtual;
procedure DoBeforeShowPage(ARequest: TRequest); virtual;
property WebModule: TFPWebModule read FWebModule;
procedure DoCleanupAfterRequest(const AContentProducer: THTMLContentProducer);
procedure SetRequest(ARequest: TRequest); virtual;
procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
@ -114,6 +115,7 @@ type
property ContentProducers[Index: integer]: THTMLContentProducer read GetContentProducer;
property HasWebController: boolean read GetHasWebController;
property WebController: TWebController read GetWebController write FWebController;
property WebModule: TFPWebModule read FWebModule;
published
property BeforeRequest: TRequestEvent read FBeforeRequest write FBeforeRequest;
property BeforeShowPage: TRequestEvent read FBeforeShowPage write FBeforeShowPage;
@ -263,7 +265,7 @@ begin
AComponent:=self;
while (i > 0) and (assigned(AComponent)) do
begin
AComponent := FindComponent(copy(CompName,1,i-1));
AComponent := AComponent.FindComponent(copy(CompName,1,i-1));
CompName := copy(compname,i+1,length(compname)-i);
i := pos('$',CompName);
end;
@ -277,6 +279,7 @@ begin
if ASuffixID<>'' then
begin
SetIdSuffixes(THTMLContentProducer(AComponent));
webcontroller.ResetIterationLevel;
end;
THTMLContentProducer(AComponent).HandleAjaxRequest(ARequest, AnAjaxResponse);
end;
@ -611,7 +614,9 @@ begin
p := copy(qs,1,length(qs)-1);
if p <> '' then
result := result + ConnectChar + p
result := result + ConnectChar + p;
if assigned(OnGetURL) then
OnGetURL(ParamNames, ParamValues, KeepParams, Action, Result);
end;
procedure TStandardWebController.BindJavascriptCallstackToElement(AComponent: TComponent; AnElement: THtmlCustomElement; AnEvent: string);