diff --git a/packages/fcl-web/src/base/fphtml.pp b/packages/fcl-web/src/base/fphtml.pp index a6645732c1..6ceedb84bf 100644 --- a/packages/fcl-web/src/base/fphtml.pp +++ b/packages/fcl-web/src/base/fphtml.pp @@ -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; diff --git a/packages/fcl-web/src/base/webpage.pp b/packages/fcl-web/src/base/webpage.pp index c644c57bf8..65ce24ad2d 100644 --- a/packages/fcl-web/src/base/webpage.pp +++ b/packages/fcl-web/src/base/webpage.pp @@ -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);