Hi All,
I have been working feverishly on Windows modules to
support a program I have been tasked to write for
a customer.
And after all the wonderful help everyone has given me,
I better show what I have done with it!
So far there are four of them. I have completed the
windows popup module. There are test lines at the
top of the module:
<WinMessageBox>
# unit module WinMessageBox;
# MessageBox.pm6
#`{
This Module provides access to Windows "user32" MessageBox function and
give a WinMsg to substitute for Windows Professional's msg.exe
program, without
the networking.
This module is not able to retrieve information from the user other
than the buttons
Test one liners:
perl6 -e "use lib '.'; use WinMessageBox :MessageBox; say
MessageBox( 'Some Title', 'Something Cleaver', MB_ICONINFORMATION, MB_OK
);"
perl6 -e "use lib '.'; use WinMessageBox :MessageBox; say
MessageBox( 'Some Title', 'Something Cleaver', MB_ICONQUESTION,
MB_YESNOCANCEL );
perl6 -e "use lib '.'; use WinMessageBox :MessageBox; say
MessageBox( 'Some Title', 'Something Cleaver', MB_ICONERROR,
MB_CANCELTRYCONTINUE );"
perl6 -e "use lib '.'; use WinMessageBox :WinMsg; say
WinMsg( 'Some Title', 'Something Cleaver' );"
References:
https://docs.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-messagebox
https://stackoverflow.com/questions/59105696/how-can-i-create-pop-up-windows-for-perl6-in-windows
https://docs.perl6.org/language/nativecall
}
use NativeCall;
constant WCHAR = uint16;
constant INT = int32;
constant UINT = uint32;
constant HANDLE = Pointer[void];
constant LPWCTSTR = CArray[WCHAR];
enum Icons (
MB_ICONEXCLAMATION => 0x00000030,
MB_ICONWARNING => 0x00000030,
MB_ICONINFORMATION => 0x00000040,
MB_ICONASTERISK => 0x00000040,
MB_ICONQUESTION => 0x00000020,
MB_ICONSTOP => 0x00000010,
MB_ICONERROR => 0x00000010,
MB_ICONHAND => 0x00000010
);
enum Buttons (
MB_ABORTRETRYIGNORE => 0x00000002,
MB_CANCELTRYCONTINUE => 0x00000006,
MB_HELP => 0x00004000,
MB_OK => 0x00000000,
MB_OKCANCEL => 0x00000001,
MB_RETRYCANCEL => 0x00000005,
MB_YESNO => 0x00000004,
MB_YESNOCANCEL => 0x00000003
);
enum MessageBoxReturn (
ABORT => 3,
CANCEL => 2,
CONTINUE => 11,
IGNORE => 5,
NO => 7,
OK => 1,
RETRY => 4,
TRYAGAIN => 10,
YES => 6
);
sub MessageBoxW(
HANDLE,
LPWCTSTR,
LPWCTSTR,
UINT
)
is native("user32")
is symbol("MessageBoxW")
returns INT
{ * };
sub MessageBox(
Str $Title,
Str $Message,
Icons $Icon = Icons::MB_ICONINFORMATION,
Buttons $Button = Buttons::MB_OK
)
returns MessageBoxReturn is export( :MessageBox )
{
#`{
Pop up a message box to the user.
Windows only.
Return what button was pressed
See top for test one liners
}
my Str $SubName = &?ROUTINE.name;
my Str $OS = $*KERNEL.name;
if not $OS eq "win32" {
say "Sorry, $SubName only work in Windows.";
exit;
}
my $lpText = CArray[uint16].new( $Message.encode.list );
$lpText[$lpText.elems] = 0;
my $lpCaption = CArray[uint16].new( $Title.encode.list );
$lpCaption[$lpCaption.elems] = 0;
my $uType = $Icon +| $Button; # bitwise OR them together
return MessageBoxReturn( MessageBoxW( my $Handle, $lpText,
$lpCaption, $uType ));
}
sub WinMsg( Str $TitleStr, Str $MessageStr ) is export( :WinMsg ) {
#`{
Simple "Ok" pop up with no return value. Thjis as a subsitute for
Windows `msg.exe` program
that only runs in the Professinal version and without the netowrking.
See top for test one liners
}
my Str $SubName = &?ROUTINE.name;
my Str $OS = $*KERNEL.name;
if not $OS eq "win32" {
say "Sorry, $SubName only work in Windows.";
exit;
}
return MessageBox( $TitleStr, $MessageStr, MB_ICONINFORMATION, MB_OK );
}
</WinMessageBox>
