Added MessageBox/ShowMessage/MessageDlg see messagebox.simba

This commit is contained in:
Raymond 2010-09-11 14:01:56 +02:00
parent f825ea80e6
commit 6c40005b17
6 changed files with 80 additions and 25 deletions

View File

@ -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;

View File

@ -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;

View File

@ -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}

View File

@ -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}

View File

@ -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

View File

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