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

* Implemented IHTMLDesignable

Browse Source 
* Fixed moving an element forward, so that it is inserted before the given element

git-svn-id: trunk@16768 -
This commit is contained in:
joost 2011-01-15 17:55:08 +00:00
parent 8a389c16d7
commit 319c2da797
2 changed files with 32 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -145,6 +145,8 @@ type
TForeachContentProducerProc = procedure(const AContentProducer: THTMLContentProducer) of object;
{ IHTMLContentProducerContainer }
IHTMLContentProducerContainer = interface
['{8B4D8AE0-4873-49BF-B677-D03C8A02CDA5}']
procedure AddContentProducer(AContentProducer: THTMLContentProducer);
@ -152,6 +154,8 @@ type
function ExchangeContentProducers(Child1, Child2: THTMLContentProducer) : boolean;
function MoveContentProducer(MoveElement, MoveBeforeElement: THTMLContentProducer) : boolean;
procedure ForeachContentProducer(AForeachChildsProc: TForeachContentProducerProc; Recursive: boolean);
function ProduceContent : string;
end;
{ THTMLContentProducer }
@ -739,6 +743,7 @@ begin
ChildIndex2:=GetContentProducerList.IndexOf(MoveBeforeElement);
if (ChildIndex2=-1) then
Exit;
if ChildIndex2>ChildIndex1 then dec(ChildIndex2);
GetContentProducerList.Move(ChildIndex1,ChildIndex2);
result := true;
end;

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

@ -14,10 +14,23 @@ type
TAjaxRequestResponseEvent = procedure(Sender: TObject; ARequest: TRequest; AResponse: TAjaxResponse) of object;
type
{ IWebPageDesigner }
IWebPageDesigner = interface(IUnknown)
['{25629DEA-79D5-4165-A0A3-BE6E2BA74442}']
procedure Invalidate;
end;
{ IHTMLDesignable }
IHTMLDesignable = interface(IUnknown)
['{C75546D6-9C93-49F0-809F-D29C52CD306D}']
function GetDesigner: IWebPageDesigner;
procedure SetDesigner(const AValue: IWebPageDesigner);
property Designer: IWebPageDesigner read GetDesigner write SetDesigner;
end;
{ TStandardWebController }
TStandardWebController = class(TWebController)
@ -41,7 +54,7 @@ type
{ TWebPage }
TWebPage = class(TDataModule, IHTMLContentProducerContainer)
TWebPage = class(TDataModule, IHTMLContentProducerContainer, IHTMLDesignable)
private
FAfterAjaxRequest: TAjaxRequestResponseEvent;
FBaseURL: string;
@ -56,8 +69,10 @@ type
function GetContentProducer(Index: integer): THTMLContentProducer;
function GetContentProducerList: TFPList;
function GetContentProducers(Index: integer): THTMLContentProducer;
function GetDesigner: IWebPageDesigner;
function GetHasWebController: boolean;
function GetWebController: TWebController;
procedure SetDesigner(const AValue: IWebPageDesigner);
protected
procedure DoAfterAjaxRequest(ARequest: TRequest; AnAjaxResponse: TAjaxResponse); virtual;
procedure DoHandleAjaxRequest(ARequest: TRequest; AnAjaxResponse: TAjaxResponse; var Handled: boolean); virtual;
@ -82,7 +97,7 @@ type
procedure HandlePage(ARequest: TRequest; AResponse: TResponse; AWriter: THTMLwriter; AWebModule: TFPWebModule = nil); virtual;
procedure DoBeforeGenerateXML; virtual;
procedure CleanupAfterRequest; virtual;
property Designer: IWebPageDesigner read FDesigner write FDesigner;
property Designer: IWebPageDesigner read GetDesigner write SetDesigner;
property Request: TRequest read FRequest;
property ContentProducers[Index: integer]: THTMLContentProducer read GetContentProducer;
property HasWebController: boolean read GetHasWebController;
@ -259,6 +274,11 @@ begin
Result:=THTMLContentProducer(ContentProducerList[Index]);
end;
function TWebPage.GetDesigner: IWebPageDesigner;
begin
result := FDesigner;
end;
function TWebPage.GetHasWebController: boolean;
begin
result := assigned(FWebController);
@ -271,6 +291,11 @@ begin
result := FWebController;
end;
procedure TWebPage.SetDesigner(const AValue: IWebPageDesigner);
begin
FDesigner := AValue;
end;
function TWebPage.GetContentProducerList: TFPList;
begin
if not assigned(FContentProducers) then