1000 Monkeys

bm4.pl [bmpfile]

Posted in perl scripts
#download and rename to .pl or .txt if this does not display correctly.
#
http://www.sqablogs.com/uploads/t/thepthial/59.bmp


   use Win32::GuiTest qw(:ALL);
 
#usage perl bm4.pl [bmpfile]
#note do not use an extention to the file name.
#this program brings up the custome zoom screen
 
#check to make sure that paint is not already loaded.
#or a similarly titled window that might get in the way.
    @check = FindWindowLike(0, "- Paint", "");
    if (@check != 0)
        {
        die "Paint is already open or some other application has paint in the title bar ";
        }
  
#load paint with our cmdline file
    ($file) = @ARGV;
    system("start mspaint c:mp$file.bmp"); #min
    open(OUT, "> $file.ui");
#wait for it to load.
    #sleep 1;
   
    select(undef, undef, undef, 0.20);
   
#find the paint window, the window always starts with a -
#symbol
   
    @windows = FindWindowLike(0, "- Paint", ""); #maybe this should be an ARGV
    die "Could not find Paint " if not @windows;
       
    $parent_id = $windows[0];
    SetFocus($parent_id);
   
    #print "Found Paint $parent_id ";


    $title = "Paint"; #maybe later we can set this off ARGV

    chk_alert();
    SendKeys ( "%v", 10 );
    SendKeys ( "z", 10 );
    SendKeys ( "u", 10 );
    chk_alert();
    SendKeys ( "%{F4}", 10);
    #chk_alert();
    SendKeys ( "%{F4}", 10);
    #chk_alert();
   
    close OUT;
    $del = unlink ("$file.ui");
    print "program exited normally - $file.bmp ";
    #print $del;
   
################################################
# subs under here
################################################
    sub chk_alert()
        {
        find_child($parent_id, $title);

        if ($er_no_child ne '1')
            {
            find_buttons ($child_id);
            dump_buttons($box_caption, $file, $z, @btn_text);
            SetActiveWindow( $child_id );
            PushButton( /ok/i );
            }

        #if ($er_no_child eq '1')
            #{   
            #print "error no child ";
            #}

        if ($er_close eq '1')
            {
            print "File generated - $file.ui ";
            close(OUT);
            exit;
            }
        }

    sub dump_buttons($box_caption, $file, $z, @btn_text)
        {
        print OUT "Title: $box_caption ";
            for $i (0..$z)
            {
            print OUT "btn_text$i: $btn_text[$i] ";
            }
        print OUT "================== ";
        }
   
    sub find_child ($parent_id, $title)
        {
       
            my @window = FindWindowLike(0, "$title", "");
            $zest = @window;
            if ($zest < 2 )
                {
                $er_no_child = 1;
                return $er_no_child;
                }
           
            if (($window[0] ne $parent_id) && ($parent_id eq $window[1]))
                {
                $child_id = $window[0];
                }
           
            if (($window[1] ne $parent_id) && ($parent_id eq $window[0]))
                {
                $child_id = $window[1];
                }
           
            if ($child_id ne '')
                {
                $box_caption = WMGetText( $child_id );
                }
            return $child_id, $box_caption, $er_no_child;
        }
   
   
    sub find_buttons ($child_id)
        {
           
        my @hwnds = GetChildWindows( $child_id );
            $zestz = @hwnds;
            if ($zestz < 2)
                {
                $er_no_child = 1;
                return $er_no_child;
                }
       
        $z = @hwnds - 1;
        for $i (0..$z)
            {
            @btn_text[$i] = WMGetText( @hwnds[$i] );
            if ( @btn_text[$i] =~ 'Click on OK to terminate the program')
                {
            $er_close = 1;
                }
            }
       
        return $z, @btn_text,$er_close;
        }

12:06 - 27/3/2006 - comments {2}

Last Page Next Page

Description
Just a place for me to write down all the stuff I am doing. Its all getting a bit much to keep it all in my head. This could end up as a stream of conciousness ..... and bad spelling.....


Home
User Profile
Archives
links

Recent Entries
- SQABugs - I guess they should have done some testing....

categories
- BMP
- perl scripts
- qa
- bugs