On Sat, Dec 7, 2019 at 05:41 ToddAndMargo via perl6-users <
perl6-users@perl.org> wrote:
> Hi All,
>
> I wrote and extensive module for pop up in Windows.
Todd, you need to publish your module to the Raku module ecosystem. Many
people, including myself, want to see an easily-installable module with at
least some basic tests to give strangers confidence that it will not blow
up. Instructions are in the docs, and there are helper modules to get you
started.
I'll send you specific doc references later when I get a chance, but it's
probably better for you to dig around the doc site a bit more on your own.
Hint: in the search box, enter 'module'.
-Tom
>
> It does not contain a time out option. Maybe some day I
> will work on the timer function.
>
> Thank you all for helping me with various parts of this!
>
> There are basically two subs to import
> WinMsg and WinPopUp
>
> Here are some one liners to test it with:
>
> perl6 -e "use lib '.'; use WinPopUps :WinPopUp; say WinPopUp( 'Super
> Duper Title', 'What? You were expecting something witty?',
> 'Information', 'Ok' );"
>
> perl6 -e "use lib '.'; use WinPopUps :WinPopUp; say WinPopUp( 'Super
> Duper Title', 'What? You were expecting something witty?', 'Question',
> 'YesNoCancel' );
>
> perl6 -e "use lib '.'; use WinPopUps :WinPopUp, :WinMsg; WinMsg( 'Super
> Duper Title', 'What? You were expecting something witty?' );"
>
> Let me know if you find any booboo's.
>
> -T
>
>
> <WinPopUps.pm6>
> # unit module WinPopUps;
> # WinMsg.pm6
>
> #`{
> Reference:
>
>
> 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
> }
>
> use NativeCall;
>
> sub WinPopUp( Str $TitleStr,
> Str $MessageStr,
> Str $Icons where * ~~ "Exclamation" |
> "Warning" |
> "Information" |
> "Asterisk" |
> "Question" |
> "Stop" |
> "Error" |
> "Hand",
> Str $Buttons where * ~~ "AbortRetryIgnore" |
> "CancelTryAgainContinue" |
> "Help" |
> "Ok" |
> "OkCancel" |
> "RetryCancel" |
> "YesNo" |
> "YesNoCancel" )
> is export( :WinPopUp ) {
>
> #`{
>
> Pop up a message box to the user. Windows only.
> Return what button was pressed
>
> Note: you are constrainedthe the Icon and Button values shown in
> the sub declaration.
>
> Test one liners:
> perl6 -e "use lib '.'; use WinPopUps :WinPopUp; say WinPopUp(
> 'Super Duper Title', 'What? You were expecting something witty?',
> 'Information', 'Ok' );"
> perl6 -e "use lib '.'; use WinPopUps :WinPopUp; say WinPopUp(
> 'Super Duper Title', 'What? You were expecting something witty?',
> 'Question', 'YesNoCancel' );
>
> }
>
> my Str $SubName = &?ROUTINE.name;
> my Str $OS = $*KERNEL.name;
>
> if not $OS eq "win32" { say "Sorry, $SubName only work in Windows.";
> exit; }
> my int32 $RtnInt = 0;
> my Str $RtnStr = "";
> my int32 $IconInt;
> my int32 $ButtonInt;
> my int32 $UINT;
>
> # Note: these constants are 32 bit
> constant WCHAR = uint16;
> constant INT = int32;
> constant UINT = uint32;
> constant HANDLE = Pointer[void];
> constant LPWCTSTR = CArray[WCHAR];
>
>
> constant MB_ICONEXCLAMATION = 0x00000030;
> constant MB_ICONWARNING = 0x00000030;
> constant MB_ICONINFORMATION = 0x00000040;
> constant MB_ICONASTERISK = 0x00000040;
> constant MB_ICONQUESTION = 0x00000020;
> constant MB_ICONSTOP = 0x00000010;
> constant MB_ICONERROR = 0x00000010;
> constant MB_ICONHAND = 0x00000010;
>
>
> constant MB_ABORTRETRYIGNORE = 0x00000002;
> constant MB_CANCELTRYCONTINUE = 0x00000006;
> constant MB_HELP = 0x00004000;
> constant MB_OK = 0x00000000;
> constant MB_OKCANCEL = 0x00000001;
> constant MB_RETRYCANCEL = 0x00000005;
> constant MB_YESNO = 0x00000004;
> constant MB_YESNOCANCEL = 0x00000003;
>
> constant DABORT = 3;
> constant IDCANCEL = 2;
> constant IDCONTINUE = 11;
> constant IDIGNORE = 5;
> constant IDNO = 7;
> constant IDOK = 1;
> constant IDRETRY = 4;
> constant IDTRYAGAIN = 10;
> constant IDYES = 6;
>
>
> # Note: the following two subs have to be embedded
>
> sub MessageBoxW( HANDLE, LPWCTSTR, LPWCTSTR, UINT ) is
> native('user32') returns INT { * };
>
> sub to-c-str( Str $str ) returns CArray[WCHAR] {
> my @str := CArray[WCHAR].new;
> for ( $str.comb ).kv -> $i, $char { @str[$i] = $char.ord; }
> @str[ $str.chars ] = 0;
> @str;
> }
>
>
> if $Icons eq "Exclamation" { $IconInt = MB_ICONEXCLAMATION; }
> elsif $Icons eq "Warning" { $IconInt = MB_ICONWARNING; }
> elsif $Icons eq "Information" { $IconInt = MB_ICONINFORMATION; }
> elsif $Icons eq "Asterisk" { $IconInt = MB_ICONASTERISK; }
> elsif $Icons eq "Question" { $IconInt = MB_ICONQUESTION; }
> elsif $Icons eq "Stop" { $IconInt = MB_ICONSTOP; }
> elsif $Icons eq "Error" { $IconInt = MB_ICONERROR; }
> elsif $Icons eq "Hand" { $IconInt = MB_ICONHAND; }
>
> if $Buttons eq "AbortRetryIgnore" { $ButtonInt =
> MB_ABORTRETRYIGNORE; }
> elsif $Buttons eq "CancelTryAgainContinue" { $ButtonInt =
> MB_CANCELTRYCONTINUE; }
> elsif $Buttons eq "Help" { $ButtonInt = MB_HELP; }
> elsif $Buttons eq "Ok" { $ButtonInt = MB_OK; }
> elsif $Buttons eq "OkCancel" { $ButtonInt =
> MB_OKCANCEL; }
> elsif $Buttons eq "RetryCancel" { $ButtonInt =
> MB_RETRYCANCEL; }
> elsif $Buttons eq "YesNo" { $ButtonInt = MB_YESNO; }
> elsif $Buttons eq "YesNoCancel" { $ButtonInt =
> MB_YESNOCANCEL; }
>
> $UINT = $IconInt +| $ButtonInt; # Bitwise OR them together
>
> $RtnInt = MessageBoxW( my $handle, to-c-str( $MessageStr ),
> to-c-str( $TitleStr ), $UINT );
>
> # say $RtnInt;
> if $RtnInt == DABORT { $RtnStr = "Abort"; }
> elsif $RtnInt == IDCANCEL { $RtnStr = "Cancel"; }
> elsif $RtnInt == IDCONTINUE { $RtnStr = "Continue"; }
> elsif $RtnInt == IDIGNORE { $RtnStr = "Ignore"; }
> elsif $RtnInt == IDNO { $RtnStr = "No"; }
> elsif $RtnInt == IDOK { $RtnStr = "Ok"; }
> elsif $RtnInt == IDRETRY { $RtnStr = "Retry"; }
> elsif $RtnInt == IDTRYAGAIN { $RtnStr = "Try Again"; }
> elsif $RtnInt == IDYES { $RtnStr = "Yes"; }
>
> return $RtnStr;
> }
>
>
> sub WinMsg( Str $TitleStr, Str $MessageStr ) is export( :WinMsg ) {
>
> #`{
> Simple "Ok" pop up with no return value
>
> Test one liner:
> perl6 -e "use lib '.'; use WinPopUps :WinPopUp, :WinMsg;
> WinMsg( 'Super Duper Title', 'What? You were expecting something witty?'
> );"
>
> }
>
> WinPopUp( $TitleStr, $MessageStr, "Information", "Ok" );
>
> }
> </WinpopUps.pm6>
>
