Added MessageBox/ShowMessage/MessageDlg see messagebox.simba

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;

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;
 

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}

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}

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

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');