in reply to Re^2: unswitchable windows in perl-tk
in thread unswitchable windows in perl-tk

You can change the size and geometry of an overrideredirected window, but you must do it manually. See below for a drag example.

FWIW, GTK2/GTK3 has a better override than Tk, check out the second example.

#!/usr/bin/perl use warnings; use strict; use Tk; my $top = MainWindow->new; $top->geometry('200x200+200+200'); $top->overrideredirect(1); $top->Label( -text => 'Click and Drag' )->pack( -expand => 1, -fill => 'both' ); $top->Button( -text => 'Exit', -command => sub { $top->destroy } )->pack; my @deltaxy; $top->bind( '<1>' => \&getdelta ); $top->bind( '<B1-Motion>' => \&mousemove ); MainLoop; sub mousemove { my ( $width, $height, $x, $y ) = split /[+x]/, $top->geometry; $x = $top->pointerx - $deltaxy[0]; $y = $top->pointery - $deltaxy[1]; $top->geometry( $width . 'x' . $height . "+$x+$y" ); } sub getdelta { @deltaxy = ( $top->pointerx - $top->x, $top->pointery - $top->y ); }
Gtk's better approach.
#!/usr/bin/perl use warnings; use strict; use Glib qw/TRUE FALSE/; use Gtk2::Gdk::Keysyms; use Gtk2 '-init'; $|++; my $window = Gtk2::Window->new('toplevel'); $window->set_title('Z'); $window ->signal_connect( 'destroy' => \&delete_event ); $window->set_border_width(10); $window->set_size_request(300,200); my $vbox = Gtk2::VBox->new( FALSE, 6 ); $window->add($vbox); $vbox->set_border_width(2); my $hbox= Gtk2::HBox->new( FALSE, 6 ); $vbox->pack_end($hbox,FALSE,FALSE,0); $hbox->set_border_width(2); my $button = Gtk2::Button->new_from_stock('gtk-quit'); $hbox->pack_end( $button, FALSE, FALSE, 0 ); $button->signal_connect( clicked => \&delete_event ); my $button1 = Gtk2::Button->new('Global Grab'); $hbox->pack_end( $button1, FALSE, FALSE, 0 ); $button1->signal_connect( clicked => sub{ my $rc; $rc = Gtk2::Gdk->pointer_grab($window->window,1,['button-press-mask' +,'button-release-mask','pointer-motion-mask'],undef,undef,Gtk2->get_c +urrent_event_time); print "$rc\n"; $rc = Gtk2::Gdk->keyboard_grab($window->window,0,Gtk2->get_current_e +vent_time); print "$rc\n"; } ); $window->set_position('center'); $window->show_all(); $window->signal_connect( 'key_release_event' => \&keyrelease ); $window->signal_connect (event => sub { my ($item, $event) = @_; warn "event ".$event->type."\n"; # print chr(07); #beep return 0; #return 1 prevents window from closing # return 0 lets the signal thru }); Gtk2->main; ##################################### sub delete_event { Gtk2->main_quit; return FALSE; } sub keyrelease { my ( $widget, $event ) = @_; print $event->keyval,"\n"; print chr(07); #beep if ( $event->keyval == $Gtk2::Gdk::Keysyms{q} ) { Gtk2->main_quit; } else { print "key was ", chr( $event->keyval ), "\n"; } }

I'm not really a human, but I play one on earth.
Old Perl Programmer Haiku ................... flash japh