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

* Added ALoaded parameter to MessageBox

Browse Source 
git-svn-id: trunk@15528 -
This commit is contained in:
joost 2010-07-05 13:59:20 +00:00
parent e5b9d690b9
commit 9f071282b3
2 changed files with 13 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -38,7 +38,7 @@ type
end; end;
TWebButtons = array of TWebButton; TWebButtons = array of TWebButton;
TMessageBoxHandler = function(Sender: TObject; AText: String; Buttons: TWebButtons): string of object; TMessageBoxHandler = function(Sender: TObject; AText: String; Buttons: TWebButtons; Loaded: string = ''): string of object;
TWebController = class; TWebController = class;
THTMLContentProducer = class; THTMLContentProducer = class;
@ -53,7 +53,7 @@ type
constructor Create(const AWebController: TWebController); virtual; constructor Create(const AWebController: TWebController); virtual;
destructor Destroy; override; destructor Destroy; override;
procedure AddScriptLine(ALine: String); virtual; procedure AddScriptLine(ALine: String); virtual;
procedure MessageBox(AText: String; Buttons: TWebButtons); virtual; procedure MessageBox(AText: String; Buttons: TWebButtons; Loaded: string = ''); virtual;
procedure RedrawContentProducer(AContentProducer: THTMLContentProducer); virtual; procedure RedrawContentProducer(AContentProducer: THTMLContentProducer); virtual;
procedure CallServerEvent(AHTMLContentProducer: THTMLContentProducer; AEvent: Integer; APostVariable: string = ''); virtual; procedure CallServerEvent(AHTMLContentProducer: THTMLContentProducer; AEvent: Integer; APostVariable: string = ''); virtual;
procedure Clear; virtual; procedure Clear; virtual;
@ -92,8 +92,8 @@ type
procedure CleanupAfterRequest; virtual; procedure CleanupAfterRequest; virtual;
procedure BeforeGenerateHead; virtual; procedure BeforeGenerateHead; virtual;
procedure BindJavascriptCallstackToElement(AComponent: TComponent; AnElement: THtmlCustomElement; AnEvent: string); virtual; abstract; procedure BindJavascriptCallstackToElement(AComponent: TComponent; AnElement: THtmlCustomElement; AnEvent: string); virtual; abstract;
function MessageBox(AText: String; Buttons: TWebButtons): string; virtual; function MessageBox(AText: String; Buttons: TWebButtons; ALoaded: string = ''): string; virtual;
function DefaultMessageBoxHandler(Sender: TObject; AText: String; Buttons: TWebButtons): string; virtual; abstract; function DefaultMessageBoxHandler(Sender: TObject; AText: String; Buttons: TWebButtons; ALoaded: string = ''): string; virtual; abstract;
function CreateNewScript: TStringList; virtual; abstract; function CreateNewScript: TStringList; virtual; abstract;
procedure FreeScript(var AScript: TStringList); virtual; abstract; procedure FreeScript(var AScript: TStringList); virtual; abstract;
property ScriptFileReferences: TStringList read GetScriptFileReferences; property ScriptFileReferences: TStringList read GetScriptFileReferences;
@ -433,6 +433,8 @@ const SimpleOkButton: array[0..0] of TWebButton = ((buttontype: btok;caption: 'O
const jseButtonClick = 1000; const jseButtonClick = 1000;
jseInputChange = 1001; jseInputChange = 1001;
jseFormReset = 1002;
jseFormSubmit = 1003;
implementation implementation
Uses Uses
@ -469,9 +471,9 @@ begin
FScript.Add(ALine); FScript.Add(ALine);
end; end;
procedure TJavaScriptStack.MessageBox(AText: String; Buttons: TWebButtons); procedure TJavaScriptStack.MessageBox(AText: String; Buttons: TWebButtons; Loaded: string = '');
begin begin
AddScriptLine(WebController.MessageBox(AText,Buttons)); AddScriptLine(WebController.MessageBox(AText,Buttons,Loaded));
end; end;
procedure TJavaScriptStack.RedrawContentProducer(AContentProducer: THTMLContentProducer); procedure TJavaScriptStack.RedrawContentProducer(AContentProducer: THTMLContentProducer);
@ -1231,12 +1233,12 @@ begin
// do nothing // do nothing
end; end;
function TWebController.MessageBox(AText: String; Buttons: TWebButtons): string; function TWebController.MessageBox(AText: String; Buttons: TWebButtons; ALoaded: string = ''): string;
begin begin
if assigned(MessageBoxHandler) then if assigned(MessageBoxHandler) then
result := MessageBoxHandler(self,AText,Buttons) result := MessageBoxHandler(self,AText,Buttons,ALoaded)
else else
result := DefaultMessageBoxHandler(self,AText,Buttons); result := DefaultMessageBoxHandler(self,AText,Buttons,ALoaded);
end; end;
function TWebController.GetRequest: TRequest; function TWebController.GetRequest: TRequest;

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

@ -34,7 +34,7 @@ type
function GetUrl(ParamNames, ParamValues, KeepParams: array of string; Action: string = ''): string; override; function GetUrl(ParamNames, ParamValues, KeepParams: array of string; Action: string = ''): string; override;
procedure BindJavascriptCallstackToElement(AComponent: TComponent; AnElement: THtmlCustomElement; AnEvent: string); override; procedure BindJavascriptCallstackToElement(AComponent: TComponent; AnElement: THtmlCustomElement; AnEvent: string); override;
procedure AddScriptFileReference(AScriptFile: String); override; procedure AddScriptFileReference(AScriptFile: String); override;
function DefaultMessageBoxHandler(Sender: TObject; AText: String; Buttons: TWebButtons): string; override; function DefaultMessageBoxHandler(Sender: TObject; AText: String; Buttons: TWebButtons; ALoaded: string = ''): string; override;
function CreateNewScript: TStringList; override; function CreateNewScript: TStringList; override;
procedure FreeScript(var AScript: TStringList); override; procedure FreeScript(var AScript: TStringList); override;
end; end;
@ -345,7 +345,7 @@ begin
end; end;
function TStandardWebController.DefaultMessageBoxHandler(Sender: TObject; function TStandardWebController.DefaultMessageBoxHandler(Sender: TObject;
AText: String; Buttons: TWebButtons): string; AText: String; Buttons: TWebButtons; ALoaded: string = ''): string;
var i : integer; var i : integer;
HasCancel: boolean; HasCancel: boolean;
OnOk: string; OnOk: string;