ADD: DialogAPI - MsgChoiceBox and DialogBoxParam functions

This commit is contained in:
Alexander Koblov 2023-10-31 19:02:00 +03:00
commit 566b1b75e4
5 changed files with 98 additions and 24 deletions

View file

@ -91,6 +91,10 @@
#define ID_NO 7
#define ID_CLOSE 8
#define ID_HELP 9
// DialogBoxParam: Flags
#define DB_LFM 0 // Data contains a form in the LFM format
#define DB_LRS 1 // Data contains a form in the LRS format
#define DB_FILENAME 2 // Data contains a form file name (*.lfm)
/* other */
#define EXT_MAX_PATH 16384 /* 16 Kb */
@ -100,9 +104,11 @@ typedef intptr_t (DCPCALL *tDlgProc)(uintptr_t pDlg, char* DlgItemName, intptr_t
/* Definition of callback functions called by the DLL */
typedef BOOL (DCPCALL *tInputBoxProc)(char* Caption, char* Prompt, BOOL MaskInput, char* Value, int ValueMaxLen);
typedef int (DCPCALL *tMessageBoxProc)(char* Text, char* Caption, long Flags);
typedef int (DCPCALL *tMsgChoiceBoxProc)(char* Text, char* Caption, char** Buttons);
typedef BOOL (DCPCALL *tDialogBoxLFMProc)(intptr_t LFMData, unsigned long DataSize, tDlgProc DlgProc);
typedef BOOL (DCPCALL *tDialogBoxLRSProc)(intptr_t LRSData, unsigned long DataSize, tDlgProc DlgProc);
typedef BOOL (DCPCALL *tDialogBoxLFMFileProc)(char* LFMFileName, tDlgProc DlgProc);
typedef BOOL (DCPCALL *tDialogBoxParamProc)(void* Data, uint32_t DataSize, tDlgProc DlgProc, uint32_t Flags, void *UserData, void* Reserved);
typedef int (DCPCALL *tTranslateStringProc)(void *Translation, const char *Identifier, const char *Original, char *Output, int OutLen);
#pragma pack(push)
@ -119,7 +125,10 @@ typedef struct {
tDlgProc SendDlgMsg;
void *Translation;
tTranslateStringProc TranslateString;
unsigned char Reserved[4094 * sizeof(void *)];
uintptr_t VersionAPI;
tMsgChoiceBoxProc MsgChoiceBox;
tDialogBoxParamProc DialogBoxParam;
unsigned char Reserved[4091 * sizeof(void *)];
} tExtensionStartupInfo;
#pragma pack(pop)

View file

@ -95,6 +95,10 @@ const
ID_NO = 7;
ID_CLOSE = 8;
ID_HELP = 9;
// DialogBoxParam: Flags
DB_LFM = 0; // Data contains a form in the LFM format
DB_LRS = 1; // Data contains a form in the LRS format
DB_FILENAME = 2; // Data contains a form file name (*.lfm)
const
EXT_MAX_PATH = 16384; // 16 Kb
@ -107,9 +111,11 @@ type
{ Definition of callback functions called by the DLL }
TInputBoxProc = function(Caption, Prompt: PAnsiChar; MaskInput: LongBool; Value: PAnsiChar; ValueMaxLen: Integer): LongBool; {$IFDEF MSWINDOWS}stdcall{$ELSE}cdecl{$ENDIF};
TMessageBoxProc = function(Text, Caption: PAnsiChar; Flags: Longint): Integer; {$IFDEF MSWINDOWS}stdcall{$ELSE}cdecl{$ENDIF};
TMsgChoiceBoxProc = function(Text, Caption: PAnsiChar; Buttons: PPAnsiChar): Integer; {$IFDEF MSWINDOWS}stdcall{$ELSE}cdecl{$ENDIF};
TDialogBoxLFMProc = function(LFMData: Pointer; DataSize: LongWord; DlgProc: TDlgProc): LongBool; {$IFDEF MSWINDOWS}stdcall{$ELSE}cdecl{$ENDIF};
TDialogBoxLRSProc = function(LRSData: Pointer; DataSize: LongWord; DlgProc: TDlgProc): LongBool; {$IFDEF MSWINDOWS}stdcall{$ELSE}cdecl{$ENDIF};
TDialogBoxLFMFileProc = function(lfmFileName: PAnsiChar; DlgProc: TDlgProc): LongBool; {$IFDEF MSWINDOWS}stdcall{$ELSE}cdecl{$ENDIF};
TDialogBoxParamProc = function(Data: Pointer; DataSize: LongWord; DlgProc: TDlgProc; Flags: LongWord; UserData, Reserved: Pointer): LongBool; {$IFDEF MSWINDOWS}stdcall{$ELSE}cdecl{$ENDIF};
TTranslateStringProc = function(Translation: Pointer; Identifier, Original: PAnsiChar; Output: PAnsiChar; OutLen: Integer): Integer {$IFDEF MSWINDOWS}stdcall{$ELSE}cdecl{$ENDIF};
type
@ -130,8 +136,11 @@ type
SendDlgMsg: TDlgProc;
Translation: Pointer;
TranslateString: TTranslateStringProc;
VersionAPI: UIntPtr;
MsgChoiceBox: TMsgChoiceBoxProc;
DialogBoxParam: TDialogBoxParamProc;
// Reserved for future API extension
Reserved: packed array [0..Pred(4094 * SizeOf(Pointer))] of Byte;
Reserved: packed array [0..Pred(4091 * SizeOf(Pointer))] of Byte;
end;
type

View file

@ -111,16 +111,18 @@ type
function InputBox(Caption, Prompt: PAnsiChar; MaskInput: LongBool; Value: PAnsiChar; ValueMaxLen: Integer): LongBool; dcpcall;
function MessageBox(Text, Caption: PAnsiChar; Flags: Longint): Integer; dcpcall;
function MsgChoiceBox(Text, Caption: PAnsiChar; Buttons: PPAnsiChar): Integer; dcpcall;
function DialogBoxLFM(LFMData: Pointer; DataSize: LongWord; DlgProc: TDlgProc): LongBool; dcpcall;
function DialogBoxLRS(LRSData: Pointer; DataSize: LongWord; DlgProc: TDlgProc): LongBool; dcpcall;
function DialogBoxLFMFile(lfmFileName: PAnsiChar; DlgProc: TDlgProc): LongBool; dcpcall;
function DialogBoxParam(Data: Pointer; DataSize: LongWord; DlgProc: TDlgProc; Flags: UInt32; UserData, Reserved: Pointer): LongBool; dcpcall;
function SendDlgMsg(pDlg: PtrUInt; DlgItemName: PAnsiChar; Msg, wParam, lParam: PtrInt): PtrInt; dcpcall;
implementation
uses
LCLStrConsts, LazFileUtils, DCClassesUtf8, DCOSUtils, uShowMsg, uDebug,
uTranslator, uGlobs;
LCLStrConsts, LazFileUtils, DCClassesUtf8, DCOSUtils, DCStrUtils, uShowMsg,
uDebug, uTranslator, uGlobs, uFileProcs;
type
TControlProtected = class(TControl);
@ -139,6 +141,19 @@ begin
Result:= ShowMessageBox(Text, Caption, Flags);
end;
function MsgChoiceBox(Text, Caption: PAnsiChar; Buttons: PPAnsiChar): Integer; dcpcall;
var
AButtons: TStringArray;
begin
AButtons:= Default(TStringArray);
while (Buttons^ <> nil) do
begin
AddString(AButtons, Buttons^);
Inc(Buttons);
end;
Result:= uShowMsg.MsgChoiceBox(nil, Text, Caption, AButtons);
end;
function LFMToLRS(const LFMData: String): String;
var
LFMStream: TStringStream = nil;
@ -155,14 +170,16 @@ begin
end;
end;
function DialogBox(const LRSData: String; DlgProc: TDlgProc): LongBool;
function DialogBox(const LRSData: String; DlgProc: TDlgProc; UserData: Pointer): LongBool;
var
Dialog: TDialogBox;
Data: PtrInt absolute UserData;
begin
Dialog:= TDialogBox.Create(LRSData, DlgProc);
try
with Dialog do
begin
Tag:= Data;
TThread.Synchronize(nil, @ShowDialogBox);
Result:= FResult;
end;
@ -178,7 +195,7 @@ begin
if Assigned(LFMData) and (DataSize > 0) then
begin
SetString(DataString, LFMData, DataSize);
Result := DialogBox(LFMToLRS(DataString), DlgProc);
Result := DialogBox(LFMToLRS(DataString), DlgProc, nil);
end
else
Result := False;
@ -191,7 +208,7 @@ begin
if Assigned(LRSData) and (DataSize > 0) then
begin
SetString(DataString, LRSData, DataSize);
Result := DialogBox(DataString, DlgProc);
Result := DialogBox(DataString, DlgProc, nil);
end
else
Result := False;
@ -199,20 +216,35 @@ end;
function DialogBoxLFMFile(lfmFileName: PAnsiChar; DlgProc: TDlgProc): LongBool; dcpcall;
var
lfmStringList: TStringListEx;
DataString: String;
begin
if Assigned(lfmFileName) then
if (lfmFileName = nil) then
Result := False
else begin
DataString := mbReadFileToString(lfmFileName);
Result := DialogBox(LFMToLRS(DataString), DlgProc, nil);
end;
end;
function DialogBoxParam(Data: Pointer; DataSize: LongWord;
DlgProc: TDlgProc; Flags: UInt32; UserData, Reserved: Pointer): LongBool; dcpcall;
var
DataString: String;
begin
if (Data = nil) then Exit(False);
if (DataSize = 0) then Exit(False);
SetString(DataString, Data, DataSize);
if (Flags and DB_LRS = 0) then
begin
lfmStringList:= TStringListEx.Create;
try
lfmStringList.LoadFromFile(lfmFileName);
Result := DialogBox(LFMToLRS(lfmStringList.Text), DlgProc);
finally
FreeAndNil(lfmStringList);
end;
DataString:= LFMToLRS(DataString);
end
else
Result := False;
else if (Flags and DB_FILENAME <> 0) then
begin
DataString:= LFMToLRS(mbReadFileToString(DataString));
end;
Result:= DialogBox(DataString, DlgProc, UserData);
end;
function SendDlgMsg(pDlg: PtrUInt; DlgItemName: PAnsiChar; Msg, wParam, lParam: PtrInt): PtrInt; dcpcall;

View file

@ -90,7 +90,7 @@ type
destructor Destroy;override;
function ShowMsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape:TMyMsgButton) : TMyMsgResult;
function ShowMessageBox(const AText, ACaption: String; Flags: LongInt): LongInt;
function ShowMessageChoiceBox(const Message: String; Buttons: TDynamicStringArray): Integer;
function ShowMessageChoiceBox(const Message, ACaption: String; Buttons: TDynamicStringArray): Integer;
function ShowInputQuery(const ACaption, APrompt: String; MaskInput: Boolean; var Value: String) : Boolean;
end;
@ -115,7 +115,9 @@ function MsgBox(Thread: TThread; const sMsg: String; const Buttons: array of TMy
function MsgTest:TMyMsgResult;
function MsgChoiceBox(const Message: String; Buttons: TDynamicStringArray): Integer; overload;
function MsgChoiceBox(const Message, ACaption: String; Buttons: TDynamicStringArray): Integer; overload;
function MsgChoiceBox(Thread: TThread; const Message: String; Buttons: TDynamicStringArray): Integer; overload;
function MsgChoiceBox(Thread: TThread; const Message, ACaption: String; Buttons: TDynamicStringArray): Integer; overload;
function ShowMessageBox(const AText, ACaption: String; Flags: LongInt): LongInt; overload;
function ShowMessageBox(Thread: TThread; const AText, ACaption: String; Flags: LongInt): LongInt; overload;
@ -163,7 +165,7 @@ end;
procedure TDialogMainThread.SyncMessageChoiceBox;
begin
FMessageBoxResult:= MsgChoiceBox(FMessage, FChoices);
FMessageBoxResult:= MsgChoiceBox(FMessage, FCaption, FChoices);
end;
constructor TDialogMainThread.Create(AThread : TThread);
@ -208,11 +210,12 @@ begin
Result:= FMessageBoxResult;
end;
function TDialogMainThread.ShowMessageChoiceBox(const Message: String;
Buttons: TDynamicStringArray): Integer;
function TDialogMainThread.ShowMessageChoiceBox(const Message,
ACaption: String; Buttons: TDynamicStringArray): Integer;
begin
FMessage:= Message;
FChoices:= Buttons;
FCaption:= ACaption;
TThread.Synchronize(FThread, SyncMessageChoiceBox);
@ -772,6 +775,11 @@ begin
end;
function MsgChoiceBox(const Message: String; Buttons: TDynamicStringArray): Integer;
begin
Result:= MsgChoiceBox(Message, EmptyStr, Buttons);
end;
function MsgChoiceBox(const Message, ACaption: String; Buttons: TDynamicStringArray): Integer;
const
cButtonSpace = 8;
var
@ -785,7 +793,12 @@ begin
frmMsg.BorderStyle:= bsSingle;
frmMsg.Position:= poScreenCenter;
frmMsg.BorderIcons:= [biSystemMenu];
frmMsg.Caption:= Application.Title;
if Length(ACaption) > 0 then
frmMsg.Caption:= ACaption
else begin
frmMsg.Caption:= Application.Title;
end;
frmMsg.lblMsg.WordWrap:= True;
frmMsg.lblMsg.Caption:= Message;
@ -830,13 +843,19 @@ end;
function MsgChoiceBox(Thread: TThread; const Message: String;
Buttons: TDynamicStringArray): Integer;
begin
Result:= MsgChoiceBox(Thread, Message, EmptyStr, Buttons);
end;
function MsgChoiceBox(Thread: TThread; const Message, ACaption: String;
Buttons: TDynamicStringArray): Integer;
var
DialogMainThread : TDialogMainThread;
begin
Result := -1;
DialogMainThread:= TDialogMainThread.Create(Thread);
try
Result:= DialogMainThread.ShowMessageChoiceBox(Message, Buttons);
Result:= DialogMainThread.ShowMessageChoiceBox(Message, ACaption, Buttons);
finally
DialogMainThread.Free;
end;

View file

@ -74,6 +74,8 @@ begin
end;
procedure TDcxModule.InitializeExtension(StartupInfo: PExtensionStartupInfo);
const
VERSION_API = 1;
var
Language: String;
AFileName, APath: String;
@ -99,6 +101,9 @@ begin
SendDlgMsg:= @fDialogBox.SendDlgMsg;
Translation:= FPOFile;
TranslateString:= @Translate;
VersionAPI:= VERSION_API;
MsgChoiceBox:= @fDialogBox.MsgChoiceBox;
DialogBoxParam:= @fDialogBox.DialogBoxParam;
end;
end;