develooper Front page | perl.perl6.users | Postings from December 2019

My pop ups for windows module

Thread Next
From:
ToddAndMargo via perl6-users
Date:
December 7, 2019 11:39
Subject:
My pop ups for windows module
Message ID:
795b043d-9d76-925b-8795-7570283b7d30@zoho.com
Hi All,

I wrote and extensive module for pop up in Windows.

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>

Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About