On 2019-12-29 18:47, ToddAndMargo via perl6-users wrote:
On 2019-12-29 17:39, ToddAndMargo via perl6-users wrote:
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>
Oops, I have to move constant around to they do not conflict with my
other modules. So, ignore this for now.
Three more to follow in a few days
This what I came up with with all the shared Native
Call constants.
Two modules to follow: NativeConstants.pm6 and MessageBox.pm6
<NativeConstants.pm6>
# unit module NativeConstants;
# NativeConstants.pm6
#`{
Constants used across Windows libraries that use Native Call
Reference to types and values:
http://dsource.org/projects/tango/ticket/820
https://docs.microsoft.com/en-us/windows/win32/sysinfo/registry-key-security-and-access-rights
https://docs.microsoft.com/en-us/windows/win32/intl/language-identifiers
https://docs.microsoft.com/en-us/windows/win32/debug/system-error-codes--0-499-
perl6 -I. -c NativeConstants.pm6
Test one liner:
perl6 -I. -e "use NativeConstants; say
FORMAT_MESSAGE_ALLOCATE_BUFFER.base(16);"
}
use NativeCall;
constant BYTE := uint8;
constant WCHAR := uint16;
constant DWORD := int32;
constant REGSAM := int32;
constant WCHARS := CArray[WCHAR];
constant BYTES := CArray[BYTE];
constant CPOINTER := int32;
constant INT = int32;
constant UINT = uint32;
constant HANDLE = Pointer[void];
constant LPWCTSTR = CArray[WCHAR];
constant FORMAT_MESSAGE_ALLOCATE_BUFFER = 0x00000100;
constant FORMAT_MESSAGE_FROM_SYSTEM = 0x00001000;
constant FORMAT_MESSAGE_IGNORE_INSERTS = 0x00000200;
constant KEY_QUERY_VALUE = 1;
constant ERROR_SUCCESS = 0; # Win-Api 0 = success
constant KEY_READ = 0x20019;
constant KEY_SET_VALUE = 0x0002;
constant REG_NONE = 0; # No value type
constant REG_SZ = 1; # Unicode nul terminated
string
constant REG_EXPAND_SZ = 2; # Unicode nul terminated
string = (with environment variable references)
constant REG_BINARY = 3; # Free form binary
constant REG_DWORD = 4; # 32-bit number
constant REG_DWORD_LITTLE_ENDIAN = 4; # 32-bit number = (same
as REG_DWORD)
constant REG_DWORD_BIG_ENDIAN = 5; # 32-bit number
constant REG_LINK = 6; # Symbolic Link = (unicode)
constant REG_MULTI_SZ = 7; # Multiple Unicode strings
constant REG_RESOURCE_LIST = 8; # Resource list in the
resource map
constant REG_FULL_RESOURCE_DESCRIPTOR = 9; # Resource list in the
hardware description
constant REG_RESOURCE_REQUIREMENTS_LIST = 10;
constant REG_QWORD = 11; # 64-bit number
constant REG_QWORD_LITTLE_ENDIAN = 11; # same as REG_QWORD
<NativeConstants.pm6>
And this is MessageBox.pm6
<MessageBox.pm6>
# 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;
use NativeConstants;
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 );
}
</MessageBox.pm6>
