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

My Windows Modules

Thread Next
From:
ToddAndMargo via perl6-users
Date:
December 30, 2019 01:40
Subject:
My Windows Modules
Message ID:
27209305-2840-6d33-456d-d7043bf78ad0@zoho.com
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>

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