use strict;
use Win32::Clipboard;
use Win32::API;
use Tk;

# Windows constants
my ($OnTop, $NoTop, $Top) = (-1, -2, 0);
my ($SWP_NOMOVE, $SWP_NOSIZE) = (2, 1);

# 'always on top' state
my $isOnTop = $NoTop;

# Create a Win32::API object for SetWindowPos
my $SetWindowPos = new Win32::API("user32", "SetWindowPos", ['N','N','
+N','N','N','N','N'], 'N');
# and one for FindWindow
my $FindWindow = new Win32::API("user32", "FindWindow", ['P','P'], 'N'
+);




my $mode = 0;
my $old_contents;
my $clip = Win32::Clipboard();
my $button_pressed;
my $toggle_mode = 0;

my $main = new MainWindow;
my $toggle_button = $main->Checkbutton(-text => "Turn on toggle mode",
    -onvalue => 1,
    -offvalue => 0,
    -variable => \$toggle_mode,
    -command => sub { !($toggle_mode) } )
    ->pack(-side => "bottom", expand => "yes", -fill => "x");
    
my $aotCBut = $main->Checkbutton(-text => "Always on top",
    -onvalue => $OnTop,
    -offvalue => $NoTop,
    -variable => \$isOnTop,
    -command => sub {
        # get a handle to the toplevel window containing our Perl/Tk a
+pp
        my $class = "TkTopLevel";
        my $name = $main->title;
        my $NULL = 0;
        my $topHwnd = $FindWindow->Call($class, $name);
        if ($topHwnd != $NULL) {
            # change 'always on top' state
            $SetWindowPos->Call($topHwnd, $isOnTop, 0, 0, 0, 0, $SWP_N
+OMOVE | $SWP_NOSIZE);
        };
    })
    ->pack(-side => "bottom", expand => "yes", -fill => "x");

$main->Label(-text => 'Clipboard Case Changer'
             )->pack;
$main->Button(-text => 'To Uppercase',
              -command => sub { &change_mode(1) }
              )->pack;
$main->Button(-text => 'To Lowercase',
              -command => sub { &change_mode(2) }
              )->pack;
$main->Button(-text => 'To Sentence Case',
              -command => sub { &change_mode(3) }
              )->pack;
$main->Button(-text => 'To Mixed Case',
              -command => sub { &change_mode(4) }
              )->pack;
$main->Button(-text => 'Off',
              -command => sub { &change_mode(0) }
              )->pack;
              
$main->repeat(50 => \&run);                         
MainLoop;

sub change_mode {
    print @_;
    $button_pressed = 1;
    $mode = shift;
}

sub run {
    my $new_contents = $clip->Get();
    if ((($new_contents ne $old_contents) && $mode) || $button_pressed
+) {
        if ($mode == 1) {
            $new_contents = uc($new_contents);
        } elsif ($mode == 2) {
            $new_contents = lc($new_contents);
        } elsif ($mode == 3) {
            $new_contents =~ tr/A-Z/a-z/;
            $new_contents =~ s/(\.\s+\b|^\s*\b)(.)/$1 . uc($2)/xge;
        } elsif ($mode == 4) {
            $new_contents =~ tr/A-Z/a-z/;
            $new_contents =~ s/\b(.)/uc($1)/ge;            
        }
        $clip->Set($new_contents);            
        $old_contents = $new_contents;
        $button_pressed = 0;
        $mode = 0 if !($toggle_mode);    
    }
}
[download]