Thursday, February 08, 2007

Progress GUI in perl using Win32::GUI

Did you ever need a progress GUI injected in your program? I did, and I still do. A progress GUI is something that is nice to have to show how a long running program is progressing. You don't want a user to think that your program is stuck. Last thing you want to happen is the user doing Ctrl+Alt+Delete then End Task. And so my solution is to display something like this:

Here's how my module is used:

use SamTools::ProgressGUI;

my $GUI = SamTools::ProgressGUI->new({
           Title       => 'Organization Name - Install Status',
           ProgressBar => 1,
       });

$GUI->show("Installing Software...");

foreach (1..10) {
    $GUI->step();
    sleep 1;
}

$GUI->hide();

Here's the module. I will probably contribute this to CPAN, just need to find time to prepare it, but here you go, enjoy...

#!/usr/bin/perl -w
#
#   This is module for displaying progress GUI
#   Written By: Sam Dela Cruz
#   Date      : 05/18/2006
#   Version   : 1.00
#

package SamTools::ProgressGUI;

use strict;
use Win32::GUI;
use Win32::GUI::BitmapInline;

#   Constructor
sub new {
    my $proto  = shift;
    my $class  = ref($proto) || $proto;

    my $self = {};
    bless($self, $class);

    #initialize object
    return $self->_init(@_);
}

#   Initialize object
sub _init {
    my $self = shift;

    # default values
    $self->{'title'}        = 'Install Progress';
    $self->{'progressbar'}  = 0;

    # Have we been passed anything
    if (@_ != 0){
        # We are expecting our configuration to come as an anonymous hash
        if (ref $_[0] eq 'HASH'){
            my $hash=$_[0];
            foreach my $key (keys %$hash){
                $self->{lc($key)}=$hash->{$key};
            }
        }
        else {
            ( $self->{'title'}, $self->{'progressbar'} ) = @_;
        }
    }
    #create the GUI
    return $self->_createGUI;
}

#   Create the GUI
sub _createGUI {
    my $self = shift;

    # Program Icon
    $self->{'icon'} = newIcon Win32::GUI::BitmapInline( q(
    AAABAAEAICAAAAAAAACoCAAAFgAAACgAAAAgAAAAQAAAAAEACAAAAAAAgAQAAAAAAAAAAAAAAAEA
    AAAAAAAAAAAAAACAAACAAAAAgIAAgAAAAIAAgACAgAAAwMDAAMDcwADwyqYA8PDwAJn//wCZ1JkA
    /9SZAP/M/wCZmf8AMCIiABEAAAAiAAAARAAAAFUAAAB3AAAAiAAAAKoAAADdAAAA7gAAAAARAAAA
    IgAAAEQAAABVAAAAdwAAAIgAAACqAAAA3QAAAO4AAAAAEQAAACIAAABEAAAAVQAAAHcAAACQAAAA
    qgAAAN0AAADuADMAAABmAAAAmQAAAMwAAAAAMwAAMzMAAGYzAAChMwAAzDMAAP8zAAAAZgAAM2YA
    AGZmAACZZgAAzGYAAP9mAAAAmQAAM5kAAGaZAACZmQAAzJkAAP+ZAAAAzAAAM8wAAGbMAACZzAAA
    zMwAAP/MAAAz/wAAZv8AAJn/AADM/wAAAAAzADMAMwBmADMAmQAzAMwAMwD/ADMAADMzADszMwBm
    MzMAmTMzAMwzMwD/MzMAAGYzADNuMwBmZjMAmWYzAMxmMwD/ZjMAAJkzADOZMwBmmTMAmZkzAMyZ
    MwD/mTMAAMwzADPMMwBmzDMAmcwzAMzMMwD/zDMAAP8zADP/MwBm/zMAmf8zAMz/MwD//zMAAABm
    ADMAZgBmAGYAmQBmAMwAZgD/AGYAADNmADMzZgBmM2YAmTNmAMwzZgD/M2YAAGZmADNmZgBmZmYA
    mWZmAMxmZgD/ZmYAAJlmADOZZgBmmWYAmZlmAMyZZgD/mWYAAMxmADPMZgBmzGYAmcxmAMzMZgD/
    zGYAAP9mADP/ZgBm/2YAmf9mAMz/ZgD//2YAAACZADMAmQBmAJkAmQCZAMwAmQD/AJkAADOZADMz
    mQBmM5kAmTOZAMwzmQD/M5kAAGahADNmmQBmZpkAmWaZAMxmmQD/ZpkAAJmZADOZmQBmmZkAmZmZ
    AMyZmQD/mZkAAMyZADPMmQBmzJkAmcyZAMzMmQD/zJkAAP+ZADP/mQBm/5kAmf+ZAMz/mQD//5kA
    AADMADMAzABmAMwAmQDMAMwAzAD/CNQAADPMADMzzABmM8wAmTPMAMwzzAD/M8wAAGbMADNmzABm
    ZswAmWbMAMxmzAD/ZswAAJnMADOZzABmmcwAmZnMAMyZzAD/mcwAAMzMADPMzABmzMwAmczMAMzM
    zAD/zMwAAP/MADP/zABm/8wAmf/MAMz/zAD//8wAMwD/AGYA/wCZAP8AzAD/AAAz/wAzM/8AZjP/
    AJkz/wDMM/8A/zP/AABm/wAzZv8AZmb/AJlm/wDMZv8A/2b/AACZ/wDd3d0AzJn/AGbM/wAAAIgA
    /wDMAJkzAAAzZjMAAGaZADMzMwDw+/8ApKCgAICAgAAAAP8AAP8AAAD//wD/AAAA/wD/AP//AAD/
    //8A//////////8KgVdXXVdXXXtXXXtXXXsJ///////////////2//b/9lcZ/Bn8GRkZGRkZGRkZ
    GVHV9v/29v/2//v7+/v7+/v7+/v7+/v7+/v7+/v7+/v7+/v7+/v7+/v7+/v7+/v7+/v7+/v7+/v7
    +/v7+/v7+/v7+/v7+/v7+/v7+/v7+/v7+/v7+/v7+/v7+/v7+/v7+/v7+/v7+/v7++0LCu2AXFZW
    elZWelZWVlZWVlZWVVZWVlZWVlYHCwoL///VGRn8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pyr///2
    1Rn8/Pz8/Pz8Gfz8Gfz8Gfz8/Pz8/Pz8/Pz8/Pyr/85zUPz8/PwFUBkZ/HvOD8/VD87IGfz8UAUF
    BQVQGfyrK/m5/Pz8T/mWGRmBD/n5D//5+fnP/AX5+fn5+fm5UPzc+fn8/Py6+fkZgf/h+fkK9vn5
    +f/Pc/n5K9zc+fkqGZX5+VD8Gfn5+Z3//+H5+f//+fn5//8OuXMZGRm6+flzBfn5c/xz+fn54Qr/
    +fnh///5+fn///8OGRkZ/HT5+bpQ+fkFGbn5+fn5Cg/5+ej///n5+f////97Gfz8lvn5BRj5+bkY
    +fm5+fkPD/n5D///+fn5/////3sZ/AUr+flQ/Nz5+QX5+VDc+dzo+fkKCv/5+fn///8Ke1AqK/n5
    lvz8lfn5+fkq/Mb5+Ssr+f////n5+f///wrd+fn5KwX8/PwF+fn5+QX8zvkrKyvi////+fkr//8K
    4fn5+blRGfz8/FD5+fn5UPzVKysrK+j///8rKyv//w/5+flP/Pz8/Pz8Gfn5+Sv8/IHoKyv5D///
    /ysrK///6Pn5Bfz8/Pz8/Pz83Pn5lvz8/J0rK/kK////Kysr///i+fl0/Pz8GRn8/PyW+flz/Pz8
    /Csr3P////8rKyv/q3P5+blzUJcqc/wZGQUr3Pz8/Pz8livh/wr///n5K8/8/Lr5+fn5+fm5/NUZ
    dCuW/Pz8/PxzK8HVCc/V3PkrGfz8GZcrK/kr3HOr/9UZGfz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/PwZ
    Ufz8q////9X8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8GQn//////wpX/Pz8GRkZGRkZGRkZGRkZ
    GRkZGRkZGfyr////a2trkGtIRENIQ0NJQ0NJQ0NJQ0NJQ0NJQ0NJa2uQa2v6+vr6IiIiIiIiIiIi
    IiIiIiIiIiIiIiIiIiIiIiIiIvr6IiIiIiIiIiIiIiIiIiIiIiIiIiIiIiIiIiIiIiIia2tra2tr
    a2tEQ0NDQ0NDQ0NDQ0NDQ0NDa2tra2tra2v//////////wpXV1dXV1dXV1dXV1dXV9X/////////
    /wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
    AAAAAAAAAAAAAAAAAAAA
    ) );

    # Start Pop-Up Window GUI
    $self->{'screen_width'}  = Win32::GUI::GetSystemMetrics(0);
    $self->{'screen_height'} = Win32::GUI::GetSystemMetrics(1);
    $self->{'font1'}         = new GUI::Font(-name=>"Tahoma",
                                             -height=>8,
                                             );
    $self->{'font2'}         = new GUI::Font(-name=>"Tahoma",
                                             -height=>14,
                                             -bold=>1,
                                             );
    $self->{'font3'}         = new GUI::Font(-name=>"Tahoma",
                                             -height=>9,
                                             -bold=>1,
                                             );
    $self->{'font4'}         = new GUI::Font(-name=>"Tahoma",
                                             -height=>11,
                                             -bold=>1,
                                             );

    $self->{'Popup'} = new GUI::DialogBox(
                       -name   => "Popup",
                       -text   => $self->{'title'},
                       -size   => [400, 150],
                       -pos    => [(($self->{'screen_width'}/2)-200),
                                   (($self->{'screen_height'}/2)-125)],
                       -font   => $self->{'font1'},
                       -helpbutton => 0,
                       );

    my $wc = $self->{'Popup'}->Width();

    $self->{'Popup'}->SetIcon($self->{'icon'});

    $self->{'Popup'}->AddLabel( -name    => "PopupLabel",
                                -text    => "",
                                -top     => 20,
                                -left    => 20,
                                -height  => 80,
                                -width   => $wc-40,
                                -font    => $self->{'font1'},
                                );

    #display progress bar if specified in object creation
    if ($self->{'progressbar'}) {
        $self->{'Popup'}->AddProgressBar( -name   => "ProgressBar",
                                          -width  => $wc-40,
                                          -height => 10,
                                          -top    => 80,
                                          -left   => 20,
                                          -smooth => 1,
                                          );

        $self->{'Popup'}->ProgressBar->SetPos (0);
        $self->{'Popup'}->ProgressBar->SetRange(0,50);
        $self->{'Popup'}->ProgressBar->SetStep (1);
    }

    $self->{'Popup'}->SetForegroundWindow();

    return $self;
}

#   Methods
sub show {
    my $self = shift;
    my $message = shift;
    $self->{'Popup'}->PopupLabel->Text($message);
    $self->{'Popup'}->Show();
    Win32::GUI::DoEvents();
}

sub step {
    my $self = shift;
    $self->{'Popup'}->ProgressBar->StepIt() if ($self->{'progressbar'});
    Win32::GUI::DoEvents();
}

sub hide {
    my $self = shift;
    if ($self->{'progressbar'}){
        $self->{'Popup'}->ProgressBar->SetPos(50);
        sleep 1; # give chance to show completion of progress bar
    }
    $self->{'Popup'}->Hide();
    Win32::GUI::DoEvents();
}

1;

__END__


=head1 NAME

 SamTools::ProgressGUI - Sam's Simple Progress GUI

=head1 SYNOPSIS

 use SamTools::ProgressGUI;

 # Pretty format, all the parameters
 my $GUI = SamTools::ProgressGUI->new({
            Title       => 'Organization Name - Install Status',   # define the window title
            ProgressBar => 1,                                      # display progress bar
        });

 # Typical usage
 my $GUI = SamTools::ProgressGUI->new({
            Title       => 'Organization Name - Install Status',
            ProgressBar => 1,
        });

 # Display status window with the message
 $GUI->show("Installing Software...");

 # Move the progress bar
 $GUI->step();

 # Hide the status GUI
 $GUI->hide();


=head1 DESCRIPTION

I is a class providing methods to display a progress GUI.  There are a number
of parameters that can be passed to allow configuration of the GUI.

=head1 REQUIRED MODULES

Win32::GUI;
Win32::GUI::BitmapInline;

=head1 METHODS

There are no class methods, the object methods are described below.
Private class method start with the underscore character '_' and
should be treated as I.

=head2 new

Called to create a I object.  The following optional named parameters can be
passed to the constructor via an anonymous hash:

=over 4

=item Title

Defines the window title.  If not defined in the
constructor then it will use the default "Philips NA IT - Install Progress".

=item ProgressBar

Used to determine if a progress bar is needed.
Default is none.

=back

=head2 _init & Private methods

I method to initialise the object on construction.  Called by C.
All I methods start with B<_> and should be treated as PRIVATE.  No other
private methods are documented (since they are private).

=head2 show

The C method is used to show the Progress GUI with message specified.

eg.  $GUI->show("Installing Software...");

=head2 step

C is used to step the progress bar if progress bar is turned on.

=head2 hide

C is used to hide the GUI.

=head1 KNOWN ISSUES

none

=head1 AUTHOR

Sam Dela Cruz, sammydc at gmail dot com

=head1 LICENSE

Copyright (c) 2006 - Sam Dela Cruz. All rights reserved. This
program is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.

=cut

3 comments:

Anonymous said...

Below is my PERL Scritps
How to display progress bar in
message box...

use Win32::GUI;

$Win = new Win32::GUI::Window(
-left => 341,
-top => 218,
-width => 300,
-height => 300,
-name => "Win",
-text => "Open File Read and Display Popup"
);

$Win->Show();

$Win->AddTextfield(
-text => "Load Your File TXT Here",
-name => "Textfield_1",
-left => 4,
-top => 24,
-width => 278,
-height => 20,
-prompt => "Input birthday:",
);
$Win->Textfield_1->SetFocus();

$Win->AddButton(
-text => "Click Here To Load",
-name => "Button_1",
-left => 6,
-top => 48,
-width => 275,
-height => 21,
-foreground => 0,
-onClick => \&Load1,

);

$Win->AddRichEdit(
-text => "",
-name => "RichEdit_1",
-left => 5,
-top => 72,
-width => 275,
-height => 169,
);

$Win->AddStatusBar(
-text => "",
-name => "StatusBar_1",
-left => 0,
-top => 248,
-width => 290,
-height => 17,
);

Win32::GUI::Dialog();

sub Win_Terminate {
return -1;
}

sub Load1 {

my $file1 = Win32::GUI::GetOpenFileName(
-owner => $Win, # Main window for modal dialog
-title => "Load Name List ...",

# Dialog title
-filter => [ # Filter file
'Name List(*.txt)' => '*.txt',
'All files' => '*.*',
],
-directory => ".", # Use current directory
);

# Have select a file ?
if ($file1) {

# Load file to animation control
$Win->Textfield_1->Text($file1);
my $data = do {
local $/;
open my $in, "<", $file1 or die "$file1: $!";
<$in>
};
$Win->RichEdit_1->Text($data);
Win32::GUI::MessageBox($Win, "A message", "App Title", MB_ICONINFORMATION);
}

# Or an error messagebox with error.
elsif (Win32::GUI::CommDlgExtendedError()) {
Win32::GUI::MessageBox(0, "ERROR : " . Win32::GUI::CommDlgExtendedError(), "GetOpenFileName Error");
}
$Win->{Button_1}->Text('Edit');
$file1 = 1;

}

Clear Choice Dental Implants said...

Yo you may read here
http://stackoverflow.com/questions/5468626/what-are-examples-for-win32-gui-multi-threaded-programming-in-perl

Apple Iphone 5 said...

Hey What is that? i not understand