From 6c40005b17b5ade19189a7c1296515d91009cfab Mon Sep 17 00:00:00 2001 From: Raymond Date: Sat, 11 Sep 2010 14:01:56 +0200 Subject: [PATCH] Added MessageBox/ShowMessage/MessageDlg see messagebox.simba --- Projects/Simba/psextension.pas | 3 -- Projects/Simba/simbaunit.pas | 4 ++ Units/MMLAddon/PSInc/Wrappers/other.inc | 63 +++++++++++++++++----- Units/MMLAddon/PSInc/psexportedmethods.inc | 3 ++ Units/MMLAddon/mmlpsthread.pas | 29 ++++++---- Units/PascalScript/uPSI_Dialogs.pas | 3 ++ 6 files changed, 80 insertions(+), 25 deletions(-) diff --git a/Projects/Simba/psextension.pas b/Projects/Simba/psextension.pas index ffbf0e4..0600c8e 100644 --- a/Projects/Simba/psextension.pas +++ b/Projects/Simba/psextension.pas @@ -249,9 +249,6 @@ begin {$I ../../Units/MMLAddon/PSInc/pscompile.inc} AddTypes('TStringArray','Array of String'); AddConstantN('ExtPath','string').SetString(ExtPath); - AddTypeS('TMsgDlgType', '( mtWarning, mtError, mtInformation, mtConfirmation, mtCustom )'); - AddTypeS('TMsgDlgBtn', '( mbYes, mbNo, mbOK, mbCancel, mbAbort, mbRetry, mbIgnore, mbAll, mbNoToAll, mbYesToAll, mbHelp )'); - AddTypeS('TMsgDlgButtons', 'set of TMsgDlgBtn'); for i := 0 to high(VirtualKeys) do AddConstantN(Format('VK_%S',[VirtualKeys[i].Str]),'Byte').SetInt(VirtualKeys[i].Key); end; diff --git a/Projects/Simba/simbaunit.pas b/Projects/Simba/simbaunit.pas index f55831b..bdff7e0 100644 --- a/Projects/Simba/simbaunit.pas +++ b/Projects/Simba/simbaunit.pas @@ -2959,6 +2959,10 @@ begin m_GetDebugBitmap : DebugImgForm.GetDebugImage(TMufasaBitmap(data)); m_ClearDebugImg : DebugImgForm.BlackDebugImage; m_ClearDebug : Self.memo1.clear; + m_InputQuery : with PInputQueryData(data)^ do Res := InputQuery(ACaption,APrompt,Value); + m_ShowMessage : ShowMessage(PChar(data)); + m_MessageBox : with PMessageBoxData(data)^ do res := Application.MessageBox(AText,ACaption,AFlags); + m_MessageDlg : with PMessageDlgData(data)^ do res := MessageDlg(ACaption,AMsg,ADlgType,AButtons,0); end; end; diff --git a/Units/MMLAddon/PSInc/Wrappers/other.inc b/Units/MMLAddon/PSInc/Wrappers/other.inc index bacbde7..547b75a 100644 --- a/Units/MMLAddon/PSInc/Wrappers/other.inc +++ b/Units/MMLAddon/PSInc/Wrappers/other.inc @@ -194,6 +194,57 @@ begin CurrThread.FormCallBack(m_Disguise,PCaption); end; +procedure ps_ShowMessage(msg : string); extdecl; +var + PMsg : Pchar; +begin + PMsg := PChar(msg); + CurrThread.FormCallBack(m_ShowMessage,PMsg); +end; + + +function ps_MessageBox(Text, Caption: string; Flags: LongInt): Integer; +var + MessageBoxData : TMessageBoxdata; +begin + with MessageBoxData do + begin + AText := PChar(text); + ACaption := PChar(Caption); + AFlags := Flags; + CurrThread.FormCallBack(m_MessageBox,@MessageBoxData); + Result := res; + end; +end; + +function ps_MessageDlg(const Caption, Msg: string; DlgType: TMsgDlgType; + Buttons: TMsgDlgButtons) : integer; +var + MessageDlgData : TMessageDlgData; +begin + with MessageDlgData do + begin + ACaption := Caption; + AMsg := Msg; + ADlgType := DlgType; + Abuttons := Buttons; + CurrThread.FormCallBack(m_MessageDlg,@MessageDlgData); + Result := res; + end; +end; + +function ps_InputQuery(const ACaption, APrompt : String; var Value : String) : Boolean;extdecl; +var + InputQueryData : TInputQueryData; +begin + InputQueryData.ACaption:= ACaption; + InputQueryData.APrompt:= APrompt; + InputQueryData.Value:= Value; + CurrThread.FormCallBack(m_InputQuery,@InputQueryData); + Result := InputQueryData.Res; + Value := InputQueryData.Value; +end; + procedure ps_TerminateScript; extdecl; begin; CurrThread.Terminate; @@ -260,15 +311,3 @@ function ps_Random(Int: integer): integer; extdecl; begin result := Random(int); end; - -{$IFNDEF MML_EXPORT_THREADSAFE} -function ps_InputQuery(const ACaption, APrompt : String; var Value : String) : Boolean;extdecl; -begin - CurrThread.InputQueryData.ACaption:= ACaption; - CurrThread.InputQueryData.APrompt:= APrompt; - CurrThread.InputQueryData.Value:= Value; - CurrThread.Synchronize(@CurrThread.mInputQuery); - Value := CurrThread.InputQueryData.Value; - result := CurrThread.InputQueryData.Res; -end; -{$ENDIF} diff --git a/Units/MMLAddon/PSInc/psexportedmethods.inc b/Units/MMLAddon/PSInc/psexportedmethods.inc index 14e3fde..66b5c98 100644 --- a/Units/MMLAddon/PSInc/psexportedmethods.inc +++ b/Units/MMLAddon/PSInc/psexportedmethods.inc @@ -189,6 +189,9 @@ AddFunction(@ps_Disguise,'procedure Disguise(Caption : string);'); AddFunction(@ps_SetScriptProp, 'function SetScriptProp(Prop : TSP_Property; Value: TVariantArray): boolean;'); AddFunction(@ps_GetScriptProp, 'function GetScriptProp(Prop : TSP_Property;var Value: TVariantArray): boolean;'); AddFunction(@ps_InputQuery,'function InputQuery(const ACaption, APrompt : String; var Value : String) : Boolean;'); +AddFunction(@ps_ShowMessage,'procedure ShowMessage(msg : string);'); +AddFunction(@ps_messageBox,'function MessageBox(Text, Caption: string; Flags: LongInt): Integer;'); +AddFunction(@ps_MessageDlg,'function MessageDlg(const Caption, Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons) : integer;'); {$ENDIF} {string} diff --git a/Units/MMLAddon/mmlpsthread.pas b/Units/MMLAddon/mmlpsthread.pas index c235f7c..565243c 100644 --- a/Units/MMLAddon/mmlpsthread.pas +++ b/Units/MMLAddon/mmlpsthread.pas @@ -33,7 +33,7 @@ uses Classes, SysUtils, client, uPSComponent,uPSCompiler, uPSRuntime,stdCtrls, uPSPreProcessor,MufasaTypes,MufasaBase, web, bitmaps, plugins, libloader, dynlibs,internets,scriptproperties, - settings,settingssandbox, Rutis_Engine,Rutis_Defs; + settings,settingssandbox, Rutis_Engine,Rutis_Defs,lcltype, dialogs; const m_Status = 0; //Data = PChar to new status @@ -43,6 +43,10 @@ const m_GetDebugBitmap = 4; //Data = TMufasaBitmap m_ClearDebugImg = 5; //Data = nil m_ClearDebug = 6; //Data = nil + m_InputQuery = 7; //Data = PInputQueryData + m_ShowMessage = 8; //Data = PChar + m_MessageBox = 9; //Data = PMessageBoxData + m_MessageDlg = 10; //Data = PMessageDlg type { TMMLPSThread } TCallBackData = record @@ -80,6 +84,20 @@ type ACaption, APrompt,Value : String; Res : boolean; end; + PInputQueryData = ^TInputQueryData; + TMessageBoxData = record + AText, ACaption : PChar; + AFlags, res : integer; + end; + PMessageBoxData = ^TMessageBoxdata; + TMessageDlgData = record + ACaption, AMsg : string; + ADlgType : TMsgDlgType; + AButtons : TMsgDlgButtons; + Res : integer; + end; + PMessageDlgData = ^TMessageDlgData; + { TMThread } TMThread = class(TThread) @@ -107,7 +125,6 @@ type Sett: TMMLSettingsSandbox; CallBackData : PCallBackData; //Handles general callback functions for threadsafety - InputQueryData : TInputQueryData;//We need this for InputQuery SyncInfo : PSyncInfo; //We need this for callthreadsafe ErrorData : PErrorData; //We need this for thread-safety etc OnError : TOnError; //Error handeler @@ -116,7 +133,6 @@ type procedure FormCallBackEx(cmd : integer; var data : pointer); procedure FormCallBack(cmd : integer; data : pointer); - procedure mInputQuery; procedure HandleError(ErrorRow,ErrorCol,ErrorPosition : integer; ErrorStr : string; ErrorType : TErrorType; ErrorModule : string); function ProcessDirective(DirectiveName, DirectiveArgs: string): boolean; function LoadFile(ParentFile : string; var filename, contents: string): boolean; @@ -235,7 +251,6 @@ uses uPSR_std, uPSR_controls,uPSR_classes,uPSR_graphics,uPSR_stdctrls,uPSR_forms, uPSR_mml, uPSR_menus, uPSI_ComCtrls, uPSI_Dialogs, uPSR_dll, files, - dialogs, dtm, //Dtms! uPSR_extctrls, //Runtime-libs Graphics, //For Graphics types @@ -354,12 +369,6 @@ begin Synchronize(CallBackData^.FormCallBack); end; -procedure TMThread.mInputQuery; -begin - InputQueryData.Res:= InputQuery(InputQueryData.ACaption,InputQueryData.APrompt, - InputQueryData.Value); -end; - procedure TMThread.HandleError(ErrorRow,ErrorCol, ErrorPosition: integer; ErrorStr: string; ErrorType: TErrorType; ErrorModule : string); begin if OnError = nil then diff --git a/Units/PascalScript/uPSI_Dialogs.pas b/Units/PascalScript/uPSI_Dialogs.pas index cf1219c..d291c56 100644 --- a/Units/PascalScript/uPSI_Dialogs.pas +++ b/Units/PascalScript/uPSI_Dialogs.pas @@ -206,6 +206,9 @@ begin CL.AddConstantN('mbYesNoCancel','LongInt').SetInt(ord(mbYes) or ord(mbNo) or ord(mbCancel)); CL.AddConstantN('mbOKCancel','LongInt').SetInt(ord(mbOK) or ord(mbCancel)); CL.AddConstantN('mbAbortRetryIgnore','LongInt').SetInt(ord(mbAbort) or ord(mbRetry) or ord(mbIgnore)); + CL.AddTypeS('TMsgDlgType', '( mtWarning, mtError, mtInformation, mtConfirmation, mtCustom )'); + CL.AddTypeS('TMsgDlgBtn', '( mbYes, mbNo, mbOK, mbCancel, mbAbort, mbRetry, mbIgnore, mbAll, mbNoToAll, mbYesToAll, mbHelp )'); + CL.AddTypeS('TMsgDlgButtons', 'set of TMsgDlgBtn'); { CL.AddDelphiFunction('Function CreateMessageDialog( const Msg : string; DlgType : TMsgDlgType; Buttons : TMsgDlgButtons) : TForm'); CL.AddDelphiFunction('Function MessageDlg( const Msg : string; DlgType : TMsgDlgType; Buttons : TMsgDlgButtons; HelpCtx : Longint) : Integer'); CL.AddDelphiFunction('Function MessageDlgPos( const Msg : string; DlgType : TMsgDlgType; Buttons : TMsgDlgButtons; HelpCtx : Longint; X, Y : Integer) : Integer');