perl-win32-gui-users Mailing List for Win32::GUI

Peter,

 

Your problem could be caused by the code that you added to the render sub. It would probably add some overhead to resize the viewport every frame. Try moving the code to just before the dialog loop. Also, you could try using the Win32::GUI::OpenGLFrame module created by Robert May. This module basically shortcuts all the code necessary for using OpenGL with Win32::GUI, and uses an XS interface to the required functions, instead of loading them with Win32::API. This may provide a speed increase. The module can be found on CPAN.

 

Hope this helps,

 

Kevin.
 


Date: Sat, 6 Mar 2010 23:08:19 -0800
From: my_...@ya...
To: per...@li...
Subject: [perl-win32-gui-users] child window for opengl






Hi
in 14 Jul 2009 http://www.mail-archive.com/per...@li.../msg05703.html i have posted an opengl example to run from within win32gui , the example depends on kevin Marshall code posted here http://www.mail-archive.com/per...@li.../msg05673.html .
the example show a popup child window in wich the opengl scene rendered.
now i have tried the same example but the opengl scene will be rendered to a child window inside the main window; it is working but with one problem; the launching of the program lasts about 5 seconds before the main window appears. why is this behaviour?, since in the popup child window example the main window appears in one second only.
the only adjustments i have made is :
1- adding the following lines to the render sub since the sticky child window can't be resized so the -onResize => sub {...} is not operative:
  glViewport(0,0,320,240);
  glMatrixMode(GL_PROJECTION);
  glLoadIdentity();
  gluPerspective(45.0, 320 / 240, 0.1, 500.0);
  glMatrixMode(GL_MODELVIEW);
  glLoadIdentity();
2-adding to the child properties:
 -popstyle    => WS_CAPTION | WS_SIZEBOX,
 -pushstyle   => WS_CHILD,
 -pushexstyle => WS_EX_CLIENTEDGE,
and the else of the program is the same as the first example.
for convenience here is the modified program, so you can check the 5 seconds delay before the main window appears:
http://rapidshare.com/files/360063815/win32gui_opengl2.pl
its picture like this:
http://img192.imageshack.us/img192/3226/win32guiopengl.jpg
 
regards
peter
 

 
 		 	   		  
_________________________________________________________________
Get the latest jobs delivered. Sign up for SEEK Jobmail.
http://clk.atdmt.com/NMN/go/157639755/direct/01/

Ken,

Rob May has written a module for creating splash screens that you may find
useful:

http://search.cpan.org/~robertmay/Win32-GUI-SplashScreen-0.04/<http://search.cpan.org/%7Erobertmay/Win32-GUI-SplashScreen-0.04/>

Regards,
Glenn Munroe

On 5 March 2010 23:53, Kevin Marshall <kej...@ho...> wrote:

>  Ken,
>
> Instead of using -pushstyle, you need to use -popstyle. As for the
> constants needed, you will need to use WS_CAPTION to remove the title bar
> and WS_THICKFRAME to remove the window's sizing border. Here is an example:
>
> $splash = Win32::GUI::Window->new(
>   -name => 'splash',
>   -size => [200,200],
>   -popstyle => WS_CAPTION | WS_THICKFRAME,
> );
> __END__
>
> There are a number of other window constants that can be used when creating
> a splash window. If you have the Windows SDK, you can check the
> documentation for a full list.
>
> Hope this helps,
>
> Kevin.
>
> ------------------------------
> Date: Fri, 5 Mar 2010 14:44:24 -0500
> From: kl...@ps...
> To: per...@li...
> Subject: [perl-win32-gui-users] Borderless Main Window
>
>
>  Hello,
>
> Let me preface my question by saying that I haven’t used Win32::GUI very
> much, so I might be missing something obvious.
>
>
>
> I want to create a borderless window (splash screen) and have done so using
> the –style option when creating the new window.
>
> Unfortunately, this option is deprecated, and I get a message informing me
> of that fact whenever I run the application.
>
> Looking at the documentation, it appeared that I could use the –pushstyle
> of –addstyle option when creating the window. However, the window has a
> border when either of these options is used.
>
> Can anyone point out the error of my ways?  Actual code is below.
>
> Thanks, Ken Slater
>
>
>
> use strict;
>
> use warnings;
>
> use File::Basename;
>
> use Getopt::Long;
>
> use Win32::API;
>
> use Win32::GUI();
>
> use Win32::GUI::Constants;
>
>
>
> use Win32::OLE('in');
>
>
>
> my ( $runDir );
>
> BEGIN
>
> {
>
>    $runDir = Win32::GetFullPathName(dirname($0));
>
> }
>
>
>
> my ($help, %options, %overridingOptions);
>
> $options{iniFile} = "$runDir/stayOnTop.ini";
>
>
>
>
>
> my ($execname) = fileparse( "$0", '' );
>
>
>
> sub usage
>
> {
>
>     print STDERR <<USAGE;
>
>
>
> $execname ...
>
>
>
> USAGE
>
>     return 0;
>
> } # end sub usage
>
>
>
>
>
> GetOptions( "ini=s"   => \$options{iniFile},
>
>             "bg=s"    => \$overridingOptions{backgroundFile},
>
>             "t=i"     => \$overridingOptions{timeout},
>
>             "h!"      => \$help,
>
>             "help!"   => \$help);
>
> if ( $help )
>
> {
>
>    usage;
>
>    exit 0;
>
> }
>
>
>
> pullSettings();
>
>
>
> use constant wbemFlagReturnImmediately => 0x10;
>
> use constant wbemFlagForwardOnly => 0x20;
>
>
>
> #------------------------------------------------------------
>
> #  Get height and width of display
>
> #------------------------------------------------------------
>
> my $computer = ".";
>
> my $objWMIService = Win32::OLE->GetObject
>
>     ("winmgmts:\\\\$computer\\root\\CIMV2")
>
>    or die "WMI connection failed.\n";
>
> my $colItems = $objWMIService->ExecQuery
>
>     ("SELECT * FROM Win32_VideoController","WQL",
>
>      wbemFlagReturnImmediately | wbemFlagForwardOnly);
>
>
>
> my ( $screenWidth, $screenHeight );
>
>
>
> foreach my $objItem (in $colItems)
>
> {
>
>       $screenWidth  = $objItem->{CurrentHorizontalResolution};
>
>       $screenHeight = $objItem->{CurrentVerticalResolution};
>
> }
>
>
>
> #------------------------------------------------------------
>
> #  Create GUI Window
>
> #------------------------------------------------------------
>
> my $WS_POPUP = Win32::GUI::Constants::constant('WS_POPUP');
>
> my $mw = Win32::GUI::Window->new(
>
>                 -title => 'NOBORDER (I hope)',
>
>         -bg  => 'black',
>
>                 -pos => [0,0],
>
>                 -size => [$screenWidth,$screenHeight],
>
>         #  The -stype option was added to make borderless
>
>         #  windows. Get a warning that this option is deprecated.
>
>         -style => $WS_POPUP,
>
>         #
>
>         #  Neither addstyle or pushstyle seem to get rid of the border
>
>         #-addstyle  => $WS_POPUP,
>
>         #-pushstyle => $WS_POPUP,
>
> );
>
>
>
> #------------------------------------------------------------
>
> #  Force this window to stay on top of other windows.
>
> #------------------------------------------------------------
>
> my $HWND_TOPMOST = Win32::GUI::Constants::constant('HWND_TOPMOST');
>
> my $SWP_NOSIZE   = Win32::GUI::Constants::constant('SWP_NOSIZE');
>
> my $SWP_NOMOVE   = Win32::GUI::Constants::constant('SWP_NOMOVE');
>
>
>
> $mw->SetWindowPos($HWND_TOPMOST,0,0,$screenWidth,$screenHeight,
>
>                   $SWP_NOSIZE|$SWP_NOMOVE);
>
>
>
> #------------------------------------------------------------
>
> #  Set the timer to exit this application after the specified
>
> #  number of milliseconds.
>
> #------------------------------------------------------------
>
> $options{timeout} = 5000 unless defined($options{timeout});
>
> my $t1 = $mw->AddTimer('T1', $options{timeout});
>
>
>
> #------------------------------------------------------------
>
> #  Set up the image to be displayed on the screen
>
> #------------------------------------------------------------
>
> my $bitmap = Win32::GUI::Bitmap->new($options{backgroundFile},
>
>                                     0,$screenWidth,$screenHeight);
>
>
>
> #create a label in which the bitmap will be placed
>
> my $bitmapLabel = $mw->AddLabel(
>
>     -name     => "Bitmap",
>
>     -left     => 0,
>
>     -top      => 0,
>
>     -width    => $screenWidth,
>
>     -height   => $screenHeight,
>
>     -bitmap   => $bitmap,
>
> );
>
>
>
> #------------------------------------------------------------
>
> #  Display the window
>
> #------------------------------------------------------------
>
> $mw->Show();
>
> Win32::GUI::Dialog();
>
>
>
> #------------------------------------------------------------
>
> # Subroutine called when timer expires
>
> #------------------------------------------------------------
>
> sub T1_Timer
>
> {
>
>    exit;
>
> }
>
>
>
> sub pullSettings
>
> {
>
>    local $/ = undef;
>
>    open my $INIFH, '<', $options{iniFile} or do
>
>    {
>
>       Win32::MsgBox("FATAL: Unable to open $options{iniFile}: $^E",
>
>                     0, "StayOnTop.pl");
>
>       exit;
>
>    };
>
>    my $lines = <$INIFH>;
>
>    close $INIFH;
>
>
>
>    my $re = qr{<([^/][^>]+)>\s*([^<]+)};
>
>    %options = $lines =~ /$re/gs;
>
>
>
>    foreach my $key ( keys %options )
>
>    {
>
>       $options{$key} = $overridingOptions{$key}
>
>          if defined($overridingOptions{$key});
>
>    }
>
> }
>
> ------------------------------
> Find out now. Link all your email accounts and social updates with
> Hotmail. <http://windowslive.ninemsn.com.au/oneinbox?ocid=T162MSN05A0710G>
>
>
> ------------------------------------------------------------------------------
> Download Intel® Parallel Studio Eval
> Try the new software tools for yourself. Speed compiling, find bugs
> proactively, and fine-tune applications for parallel performance.
> See why Intel Parallel Studio got high marks during beta.
> http://p.sf.net/sfu/intel-sw-dev
> _______________________________________________
> Perl-Win32-GUI-Users mailing list
> Per...@li...
> https://lists.sourceforge.net/lists/listinfo/perl-win32-gui-users
> http://perl-win32-gui.sourceforge.net/
>



-- 
Glenn

Kevin,

Thanks for the information. For some reason I had to use both -popstyle
(WS_CAPTION | WS_THICKFRAME) and -pushstyle (WS_POPUP) to get it to work.

Ken

 

From: Kevin Marshall [mailto:kej...@ho...] 
Sent: Friday, March 05, 2010 9:54 PM
To: kl...@ps...; Perl-Win32-GUI-Users List
Subject: RE: [perl-win32-gui-users] Borderless Main Window

 

Ken,
 
Instead of using -pushstyle, you need to use -popstyle. As for the constants
needed, you will need to use WS_CAPTION to remove the title bar and
WS_THICKFRAME to remove the window's sizing border. Here is an example:
 
$splash = Win32::GUI::Window->new(
  -name => 'splash',
  -size => [200,200],
  -popstyle => WS_CAPTION | WS_THICKFRAME,
);
__END__
 
There are a number of other window constants that can be used when creating
a splash window. If you have the Windows SDK, you can check the
documentation for a full list.
 
Hope this helps,
 
Kevin.
 

  _____  

Date: Fri, 5 Mar 2010 14:44:24 -0500
From: kl...@ps...
To: per...@li...
Subject: [perl-win32-gui-users] Borderless Main Window

Hello,

Let me preface my question by saying that I haven't used Win32::GUI very
much, so I might be missing something obvious.

 

I want to create a borderless window (splash screen) and have done so using
the -style option when creating the new window.

Unfortunately, this option is deprecated, and I get a message informing me
of that fact whenever I run the application.

Looking at the documentation, it appeared that I could use the -pushstyle of
-addstyle option when creating the window. However, the window has a border
when either of these options is used.

Can anyone point out the error of my ways?  Actual code is below.

Thanks, Ken Slater

 

use strict;

use warnings;

use File::Basename;

use Getopt::Long;

use Win32::API;

use Win32::GUI();

use Win32::GUI::Constants;

 

use Win32::OLE('in');

 

my ( $runDir );

BEGIN

{

   $runDir = Win32::GetFullPathName(dirname($0));

}

 

my ($help, %options, %overridingOptions);

$options{iniFile} = "$runDir/stayOnTop.ini";

 

 

my ($execname) = fileparse( "$0", '' );

 

sub usage

{

    print STDERR <<USAGE;

 

$execname ...

 

USAGE

    return 0;

} # end sub usage

 

 

GetOptions( "ini=s"   => \$options{iniFile},

            "bg=s"    => \$overridingOptions{backgroundFile},

            "t=i"     => \$overridingOptions{timeout},

            "h!"      => \$help,

            "help!"   => \$help);

if ( $help )

{

   usage;

   exit 0;

}

 

pullSettings();

 

use constant wbemFlagReturnImmediately => 0x10;

use constant wbemFlagForwardOnly => 0x20;

 

#------------------------------------------------------------

#  Get height and width of display

#------------------------------------------------------------

my $computer = ".";

my $objWMIService = Win32::OLE->GetObject

    ("winmgmts:\\\\$computer\\root\\CIMV2")

   or die "WMI connection failed.\n";

my $colItems = $objWMIService->ExecQuery

    ("SELECT * FROM Win32_VideoController","WQL",

     wbemFlagReturnImmediately | wbemFlagForwardOnly);

 

my ( $screenWidth, $screenHeight );

 

foreach my $objItem (in $colItems)

{

      $screenWidth  = $objItem->{CurrentHorizontalResolution};

      $screenHeight = $objItem->{CurrentVerticalResolution};

}

 

#------------------------------------------------------------

#  Create GUI Window

#------------------------------------------------------------

my $WS_POPUP = Win32::GUI::Constants::constant('WS_POPUP');

my $mw = Win32::GUI::Window->new(

                -title => 'NOBORDER (I hope)',

        -bg  => 'black',

                -pos => [0,0],

                -size => [$screenWidth,$screenHeight],

        #  The -stype option was added to make borderless

        #  windows. Get a warning that this option is deprecated.

        -style => $WS_POPUP,

        #

        #  Neither addstyle or pushstyle seem to get rid of the border

        #-addstyle  => $WS_POPUP,

        #-pushstyle => $WS_POPUP,

);

 

#------------------------------------------------------------

#  Force this window to stay on top of other windows.

#------------------------------------------------------------

my $HWND_TOPMOST = Win32::GUI::Constants::constant('HWND_TOPMOST');

my $SWP_NOSIZE   = Win32::GUI::Constants::constant('SWP_NOSIZE');

my $SWP_NOMOVE   = Win32::GUI::Constants::constant('SWP_NOMOVE');

 

$mw->SetWindowPos($HWND_TOPMOST,0,0,$screenWidth,$screenHeight,

                  $SWP_NOSIZE|$SWP_NOMOVE);

 

#------------------------------------------------------------

#  Set the timer to exit this application after the specified

#  number of milliseconds.

#------------------------------------------------------------

$options{timeout} = 5000 unless defined($options{timeout});

my $t1 = $mw->AddTimer('T1', $options{timeout});

 

#------------------------------------------------------------

#  Set up the image to be displayed on the screen

#------------------------------------------------------------

my $bitmap = Win32::GUI::Bitmap->new($options{backgroundFile},

                                    0,$screenWidth,$screenHeight);

 

#create a label in which the bitmap will be placed

my $bitmapLabel = $mw->AddLabel(

    -name     => "Bitmap",

    -left     => 0,

    -top      => 0,

    -width    => $screenWidth,

    -height   => $screenHeight,

    -bitmap   => $bitmap,

);

 

#------------------------------------------------------------

#  Display the window

#------------------------------------------------------------

$mw->Show();

Win32::GUI::Dialog();

 

#------------------------------------------------------------

# Subroutine called when timer expires

#------------------------------------------------------------

sub T1_Timer

{

   exit;

}

 

sub pullSettings

{

   local $/ = undef;

   open my $INIFH, '<', $options{iniFile} or do

   {

      Win32::MsgBox("FATAL: Unable to open $options{iniFile}: $^E",

                    0, "StayOnTop.pl");

      exit;

   };

   my $lines = <$INIFH>;

   close $INIFH;

 

   my $re = qr{<([^/][^>]+)>\s*([^<]+)};

   %options = $lines =~ /$re/gs;

 

   foreach my $key ( keys %options )

   {

      $options{$key} = $overridingOptions{$key}

         if defined($overridingOptions{$key});

   }

}

 

  _____  

Find out now. Link all your email accounts and social updates with Hotmail.
<http://windowslive.ninemsn.com.au/oneinbox?ocid=T162MSN05A0710G> 

Hi
in 14 Jul 2009 http://www.mail-archive.com/per...@li.../msg05703.html i have posted an opengl example to run from within win32gui , the example depends on kevin Marshall code posted here http://www.mail-archive.com/per...@li.../msg05673.html .
the example show a popup child window in wich the opengl scene rendered.
now i have tried the same example but the opengl scene will be rendered to a child window inside the main window; it is working but with one problem; the launching of the program lasts about 5 seconds before the main window appears. why is this behaviour?, since in the popup child window example the main window appears in one second only.
the only adjustments i have made is :
1- adding the following lines to the render sub since the sticky child window can't be resized so the -onResize => sub {...} is not operative:
  glViewport(0,0,320,240);
  glMatrixMode(GL_PROJECTION);
  glLoadIdentity();
  gluPerspective(45.0, 320 / 240, 0.1, 500.0);
  glMatrixMode(GL_MODELVIEW);
  glLoadIdentity();
2-adding to the child properties:
 -popstyle    => WS_CAPTION | WS_SIZEBOX,
 -pushstyle   => WS_CHILD,
 -pushexstyle => WS_EX_CLIENTEDGE,
and the else of the program is the same as the first example.
for convenience here is the modified program, so you can check the 5 seconds delay before the main window appears:
http://rapidshare.com/files/360063815/win32gui_opengl2.pl
its picture like this:
http://img192.imageshack.us/img192/3226/win32guiopengl.jpg
 
regards
peter
 

 


      

Ken,

 

Instead of using -pushstyle, you need to use -popstyle. As for the constants needed, you will need to use WS_CAPTION to remove the title bar and WS_THICKFRAME to remove the window's sizing border. Here is an example:

 

$splash = Win32::GUI::Window->new(
  -name => 'splash',

  -size => [200,200],

  -popstyle => WS_CAPTION | WS_THICKFRAME,

);

__END__

 

There are a number of other window constants that can be used when creating a splash window. If you have the Windows SDK, you can check the documentation for a full list.

 

Hope this helps,

 

Kevin.
 


Date: Fri, 5 Mar 2010 14:44:24 -0500
From: kl...@ps...
To: per...@li...
Subject: [perl-win32-gui-users] Borderless Main Window





Hello,
Let me preface my question by saying that I haven’t used Win32::GUI very much, so I might be missing something obvious.
 
I want to create a borderless window (splash screen) and have done so using the –style option when creating the new window.
Unfortunately, this option is deprecated, and I get a message informing me of that fact whenever I run the application.
Looking at the documentation, it appeared that I could use the –pushstyle of –addstyle option when creating the window. However, the window has a border when either of these options is used.
Can anyone point out the error of my ways?  Actual code is below.
Thanks, Ken Slater
 
use strict;
use warnings;
use File::Basename;
use Getopt::Long;
use Win32::API;
use Win32::GUI();
use Win32::GUI::Constants;
 
use Win32::OLE('in');
 
my ( $runDir );
BEGIN
{
   $runDir = Win32::GetFullPathName(dirname($0));
}
 
my ($help, %options, %overridingOptions);
$options{iniFile} = "$runDir/stayOnTop.ini";
 
 
my ($execname) = fileparse( "$0", '' );
 
sub usage
{
    print STDERR <<USAGE;
 
$execname ...
 
USAGE
    return 0;
} # end sub usage
 
 
GetOptions( "ini=s"   => \$options{iniFile},
            "bg=s"    => \$overridingOptions{backgroundFile},
            "t=i"     => \$overridingOptions{timeout},
            "h!"      => \$help,
            "help!"   => \$help);
if ( $help )
{
   usage;
   exit 0;
}
 
pullSettings();
 
use constant wbemFlagReturnImmediately => 0x10;
use constant wbemFlagForwardOnly => 0x20;
 
#------------------------------------------------------------
#  Get height and width of display
#------------------------------------------------------------
my $computer = ".";
my $objWMIService = Win32::OLE->GetObject
    ("winmgmts:\\\\$computer\\root\\CIMV2")
   or die "WMI connection failed.\n";
my $colItems = $objWMIService->ExecQuery
    ("SELECT * FROM Win32_VideoController","WQL",
     wbemFlagReturnImmediately | wbemFlagForwardOnly);
 
my ( $screenWidth, $screenHeight );
 
foreach my $objItem (in $colItems)
{
      $screenWidth  = $objItem->{CurrentHorizontalResolution};
      $screenHeight = $objItem->{CurrentVerticalResolution};
}
 
#------------------------------------------------------------
#  Create GUI Window
#------------------------------------------------------------
my $WS_POPUP = Win32::GUI::Constants::constant('WS_POPUP');
my $mw = Win32::GUI::Window->new(
                -title => 'NOBORDER (I hope)',
        -bg  => 'black',
                -pos => [0,0],
                -size => [$screenWidth,$screenHeight],
        #  The -stype option was added to make borderless
        #  windows. Get a warning that this option is deprecated.
        -style => $WS_POPUP,
        #
        #  Neither addstyle or pushstyle seem to get rid of the border
        #-addstyle  => $WS_POPUP,
        #-pushstyle => $WS_POPUP,
);
 
#------------------------------------------------------------
#  Force this window to stay on top of other windows.
#------------------------------------------------------------
my $HWND_TOPMOST = Win32::GUI::Constants::constant('HWND_TOPMOST');
my $SWP_NOSIZE   = Win32::GUI::Constants::constant('SWP_NOSIZE');
my $SWP_NOMOVE   = Win32::GUI::Constants::constant('SWP_NOMOVE');
 
$mw->SetWindowPos($HWND_TOPMOST,0,0,$screenWidth,$screenHeight,
                  $SWP_NOSIZE|$SWP_NOMOVE);
 
#------------------------------------------------------------
#  Set the timer to exit this application after the specified
#  number of milliseconds.
#------------------------------------------------------------
$options{timeout} = 5000 unless defined($options{timeout});
my $t1 = $mw->AddTimer('T1', $options{timeout});
 
#------------------------------------------------------------
#  Set up the image to be displayed on the screen
#------------------------------------------------------------
my $bitmap = Win32::GUI::Bitmap->new($options{backgroundFile},
                                    0,$screenWidth,$screenHeight);
 
#create a label in which the bitmap will be placed
my $bitmapLabel = $mw->AddLabel(
    -name     => "Bitmap",
    -left     => 0,
    -top      => 0,
    -width    => $screenWidth,
    -height   => $screenHeight,
    -bitmap   => $bitmap,
);
 
#------------------------------------------------------------
#  Display the window
#------------------------------------------------------------
$mw->Show();
Win32::GUI::Dialog();
 
#------------------------------------------------------------
# Subroutine called when timer expires
#------------------------------------------------------------
sub T1_Timer
{
   exit;
}
 
sub pullSettings
{
   local $/ = undef;
   open my $INIFH, '<', $options{iniFile} or do
   {
      Win32::MsgBox("FATAL: Unable to open $options{iniFile}: $^E",
                    0, "StayOnTop.pl");
      exit;
   };
   my $lines = <$INIFH>;
   close $INIFH;
 
   my $re = qr{<([^/][^>]+)>\s*([^<]+)};
   %options = $lines =~ /$re/gs;
 
   foreach my $key ( keys %options )
   {
      $options{$key} = $overridingOptions{$key}
         if defined($overridingOptions{$key});
   }
} 		 	   		  
_________________________________________________________________
Link all your email accounts and social updates with Hotmail. Find out now.
http://windowslive.ninemsn.com.au/oneinbox?ocid=T162MSN05A0710G

Hello,

Let me preface my question by saying that I haven't used Win32::GUI very
much, so I might be missing something obvious.

 

I want to create a borderless window (splash screen) and have done so using
the -style option when creating the new window.

Unfortunately, this option is deprecated, and I get a message informing me
of that fact whenever I run the application.

Looking at the documentation, it appeared that I could use the -pushstyle of
-addstyle option when creating the window. However, the window has a border
when either of these options is used.

Can anyone point out the error of my ways?  Actual code is below.

Thanks, Ken Slater

 

use strict;

use warnings;

use File::Basename;

use Getopt::Long;

use Win32::API;

use Win32::GUI();

use Win32::GUI::Constants;

 

use Win32::OLE('in');

 

my ( $runDir );

BEGIN

{

   $runDir = Win32::GetFullPathName(dirname($0));

}

 

my ($help, %options, %overridingOptions);

$options{iniFile} = "$runDir/stayOnTop.ini";

 

 

my ($execname) = fileparse( "$0", '' );

 

sub usage

{

    print STDERR <<USAGE;

 

$execname ...

 

USAGE

    return 0;

} # end sub usage

 

 

GetOptions( "ini=s"   => \$options{iniFile},

            "bg=s"    => \$overridingOptions{backgroundFile},

            "t=i"     => \$overridingOptions{timeout},

            "h!"      => \$help,

            "help!"   => \$help);

if ( $help )

{

   usage;

   exit 0;

}

 

pullSettings();

 

use constant wbemFlagReturnImmediately => 0x10;

use constant wbemFlagForwardOnly => 0x20;

 

#------------------------------------------------------------

#  Get height and width of display

#------------------------------------------------------------

my $computer = ".";

my $objWMIService = Win32::OLE->GetObject

    ("winmgmts:\\\\$computer\\root\\CIMV2")

   or die "WMI connection failed.\n";

my $colItems = $objWMIService->ExecQuery

    ("SELECT * FROM Win32_VideoController","WQL",

     wbemFlagReturnImmediately | wbemFlagForwardOnly);

 

my ( $screenWidth, $screenHeight );

 

foreach my $objItem (in $colItems)

{

      $screenWidth  = $objItem->{CurrentHorizontalResolution};

      $screenHeight = $objItem->{CurrentVerticalResolution};

}

 

#------------------------------------------------------------

#  Create GUI Window

#------------------------------------------------------------

my $WS_POPUP = Win32::GUI::Constants::constant('WS_POPUP');

my $mw = Win32::GUI::Window->new(

                -title => 'NOBORDER (I hope)',

        -bg  => 'black',

                -pos => [0,0],

                -size => [$screenWidth,$screenHeight],

        #  The -stype option was added to make borderless

        #  windows. Get a warning that this option is deprecated.

        -style => $WS_POPUP,

        #

        #  Neither addstyle or pushstyle seem to get rid of the border

        #-addstyle  => $WS_POPUP,

        #-pushstyle => $WS_POPUP,

);

 

#------------------------------------------------------------

#  Force this window to stay on top of other windows.

#------------------------------------------------------------

my $HWND_TOPMOST = Win32::GUI::Constants::constant('HWND_TOPMOST');

my $SWP_NOSIZE   = Win32::GUI::Constants::constant('SWP_NOSIZE');

my $SWP_NOMOVE   = Win32::GUI::Constants::constant('SWP_NOMOVE');

 

$mw->SetWindowPos($HWND_TOPMOST,0,0,$screenWidth,$screenHeight,

                  $SWP_NOSIZE|$SWP_NOMOVE);

 

#------------------------------------------------------------

#  Set the timer to exit this application after the specified

#  number of milliseconds.

#------------------------------------------------------------

$options{timeout} = 5000 unless defined($options{timeout});

my $t1 = $mw->AddTimer('T1', $options{timeout});

 

#------------------------------------------------------------

#  Set up the image to be displayed on the screen

#------------------------------------------------------------

my $bitmap = Win32::GUI::Bitmap->new($options{backgroundFile},

                                    0,$screenWidth,$screenHeight);

 

#create a label in which the bitmap will be placed

my $bitmapLabel = $mw->AddLabel(

    -name     => "Bitmap",

    -left     => 0,

    -top      => 0,

    -width    => $screenWidth,

    -height   => $screenHeight,

    -bitmap   => $bitmap,

);

 

#------------------------------------------------------------

#  Display the window

#------------------------------------------------------------

$mw->Show();

Win32::GUI::Dialog();

 

#------------------------------------------------------------

# Subroutine called when timer expires

#------------------------------------------------------------

sub T1_Timer

{

   exit;

}

 

sub pullSettings

{

   local $/ = undef;

   open my $INIFH, '<', $options{iniFile} or do

   {

      Win32::MsgBox("FATAL: Unable to open $options{iniFile}: $^E",

                    0, "StayOnTop.pl");

      exit;

   };

   my $lines = <$INIFH>;

   close $INIFH;

 

   my $re = qr{<([^/][^>]+)>\s*([^<]+)};

   %options = $lines =~ /$re/gs;

 

   foreach my $key ( keys %options )

   {

      $options{$key} = $overridingOptions{$key}

         if defined($overridingOptions{$key});

   }

}