Cer
Upgraded Agent
Joined: 03 Feb 2004
Posts: 3776
Location: Michigan
  
votes: 4
|
 Posted: Wed Aug 02, 2006 6:39 pm Post subject: Skin Perl/Tk (someone might find this interesting) |
 |
|
I've been playing with Perl/Tk and figured out a way to "skin" your windows.
Screenshot:
I found out how to drag a chromeless Perl/Tk window to reposition it like you could a normal window.
A chromeless window is a window that doesn't have a title bar or borders. I don't think they have menu bars either.
So anyway, this test script first started out as a simple 400x400 pixel window, solid orange. It looked like somebody took a screenshot of their computer and put an orange rectangle in the middle of it. This rectangle was programmed to allow the window to be repositioned by clicking and dragging anywhere in the rectangle.
Once I had that all sorted out, I turned that rectangle into a smaller rectangle and put it towards the top of the window as a title bar. I also gave it a child window, which is a *normal* window (not chromeless). Chromeless windows don't get entries on the task bar like normal windows do, so this normal window would put an entry down there. So, when this child window gets the focus (i.e. by clicking it on the task bar), it sends the focus back to the chromeless window.
Then I made a light blue frame for the window's body, then made a white frame inside of that for the window's content.
The "Tk" icon in the upper left is a built-in bitmap, since I wanted this test script to be fully portable. When clicked, it shows a menu with things like Maximize, Minimize, Restore, and Close. If you double-click the title bar, it maximizes or restores the window. The three buttons aren't actually buttons, they just look like it. They behave exactly like their counterparts on normal windows do.
And finally, when the window loses the focus, the title bar changes colors.
edit
Added a capability to click and drag the window border to resize it.
| Code: | #!/usr/bin/perl -w
use strict;
use warnings;
use Tk;
my $main = MainWindow->new;
$main->overrideredirect(1);
$main->geometry ('400x400+10+20');
$main->optionAdd ('*tearOff','false');
my $isMin = 0; # is Minimized
my $isMax = 0; # is Maximized
my $dragger = $main->Frame (
-background => 'orange',
-relief => 'raised',
-border => 3,
-height => 25,
)->pack (-side => 'top', -fill => 'x');
my $taskbar = $main->Toplevel (
-title => 'WindowSkinned',
);
$taskbar->geometry ('10x10');
$taskbar->MoveToplevelWindow (-50,-50);
$taskbar->bind ('<FocusIn>', sub {
# If minimized...
if ($isMin) {
&min;
}
$dragger->focusForce;
});
$taskbar->bind ('<Destroy>', sub {
$main->destroy;
});
my $titleFrame = $dragger->Frame (
-background => 'orange',
)->pack (-side => 'left');
my $titleIcon = $titleFrame->Label (
-bitmap => 'Tk',
-width => 16,
-height => 16,
-background => 'orange',
-foreground => 'black',
)->pack (-side => 'left');
my $titleText = $titleFrame->Label (
-text => 'WindowSkinned',
-background => 'orange',
-foreground => 'black',
-font => [
-family => 'Verdana',
-size => 9,
-weight => 'bold',
],
)->pack (-side => 'left');
my $bttnFrame = $dragger->Frame (
-background => 'orange',
)->pack (-side => 'right');
my $xBttn = $bttnFrame->Label (
-text => 'r',
-width => 2,
-height => 1,
-relief => 'raised',
-border => 2,
-foreground => 'white',
-activeforeground => 'white',
-background => 'red',
-activebackground => 'red',
-font => [
-family => 'Webdings',
-size => 8,
-weight => 'bold',
],
)->pack (-side => 'right', -padx => 1);
my $maxBttn = $bttnFrame->Label (
-text => '1',
-width => 2,
-height => 1,
-relief => 'raised',
-border => 2,
-foreground => 'black',
-activeforeground => 'black',
-background => 'orange',
-activebackground => 'orange',
-font => [
-family => 'Webdings',
-size => 8,
-weight => 'bold',
],
)->pack (-side => 'right', -padx => 1);
my $minBttn = $bttnFrame->Label (
-text => '0',
-width => 2,
-height => 1,
-relief => 'raised',
-border => 2,
-foreground => 'black',
-activeforeground => 'black',
-background => 'orange',
-activebackground => 'orange',
-font => [
-family => 'Webdings',
-size => 8,
-weight => 'bold',
],
)->pack (-side => 'right', -padx => 1);
$minBttn->bind ('<ButtonRelease-1>', \&min);
$maxBttn->bind ('<ButtonRelease-1>', \&max);
$xBttn->bind ('<ButtonRelease-1>', sub { exit(0); });
my $body = $main->Frame (
-background => 'lightblue',
-relief => 'raised',
-border => 2,
-cursor => ($^O =~ /^(MSWin32|DOS)$/ ? 'size_nw_se' : 'bottom_right_corner'),
)->pack (-fill => 'both', -expand => 1);
my $content = $body->Frame (
-background => 'white',
-relief => 'sunken',
-borderwidth => 2,
-cursor => 'arrow',
)->pack (-fill => 'both', -expand => 1, -padx => 5, -pady => 5);
my $text = $content->Scrolled ('ROText',
-scrollbars => 'ose',
-background => 'white',
-foreground => 'black',
-wrap => 'word',
-font => [
-family => 'Arial',
-size => 10,
],
-border => 0,
)->pack (-fill => 'both', -expand => 1);
$text->tagConfigure ('header', -font => [ -size => 26, -family => 'Arial', -weight => 'bold' ]);
$text->tagConfigure ('bold', -font => [ -size => 10, -family => 'Arial', -weight => 'bold' ]);
$text->insert ('end',"Skinning Perl/Tk",'header');
$text->insert ('end',"\n\n"
. "This window is an experiment for skinning Perl/Tk windows. What you see is a ");
$text->insert ('end',"overrideredirect(1)",'bold');
$text->insert ('end'," window, which doesn't have the normal window chrome. Everything else "
. "on this window is a result of frames and other normal widgets.\n\n"
. "The skinned window spawns a normal child window. Clicking this window puts the focus "
. "back on the skinned window, and will also restore it only if it is currently in "
. "'minimized' mode.\n\n");
$text->insert ('end',"Tag Bindings",'header');
$text->insert ('end',"\n\n"
. "Clicking and dragging anywhere on the title bar frame can reposition the window. "
. "Double-click the title bar to maximize or restore the window. Click the Tk icon "
. "to get a (standard-looking) popup menu. The buttons in the top right corner can "
. "minimize, maximize, and close the window. When focus is lost, the title bar turns gray "
. "instead of orange.\n\n");
$text->insert ('end',"Author",'header');
$text->insert ('end',"\n\n"
. "Cerone Kirsle ~ Aug 2 2006");
my $winX = 10;
my $winY = 20;
my $dragFromX = 0;
my $dragFromY = 0;
my $isDragging = 0;
# Add some fun active window things.
$main->bind ('<FocusOut>', sub {
$dragger->configure (-background => 'gray');
$titleFrame->configure (-background => 'gray');
$titleIcon->configure (-background => 'gray');
$titleText->configure (-background => 'gray');
$bttnFrame->configure (-background => 'gray');
$minBttn->configure (-background => 'gray');
$maxBttn->configure (-background => 'gray');
});
$main->bind ('<FocusIn>', sub {
$dragger->configure (-background => 'orange');
$titleFrame->configure (-background => 'orange');
$titleIcon->configure (-background => 'orange');
$titleText->configure (-background => 'orange');
$bttnFrame->configure (-background => 'orange');
$minBttn->configure (-background => 'orange');
$maxBttn->configure (-background => 'orange');
});
$dragger->bind ('<Double-Button-1>', \&max);
$dragger->bind ('<ButtonPress-1>', \&buttonPress);
$dragger->bind ('<ButtonRelease-1>', \&buttonRelease);
$dragger->bind ('<Motion>', \&motion);
$titleFrame->bind ('<Double-Button-1>', \&max);
$titleFrame->bind ('<ButtonPress-1>', \&buttonPress);
$titleFrame->bind ('<ButtonRelease-1>', \&buttonRelease);
$titleFrame->bind ('<Motion>', \&motion);
$titleIcon->bind ('<Double-Button-1>', sub { exit(0); });
$titleIcon->bind ('<ButtonPress-1>', \&showMenu);
$titleText->bind ('<Double-Button-1>', \&max);
$titleText->bind ('<ButtonPress-1>', \&buttonPress);
$titleText->bind ('<ButtonRelease-1>', \&buttonRelease);
$titleText->bind ('<Motion>', \&motion);
$body->bind ('<ButtonPress-1>', \&startResize);
$body->bind ('<ButtonRelease-1>', \&endResize);
$body->bind ('<Motion>', \&doResize);
my $isResizing = 0;
my $sizeX = 400;
my $sizeY = 400;
MainLoop;
sub buttonPress {
$isDragging = 1;
# dragFrom vars should be the offset from 0,0 to the current position.
$dragFromX = $Tk::event->X - $winX;
$dragFromY = $Tk::event->Y - $winY;
print "Drag from: $dragFromX,$dragFromY\n";
}
sub buttonRelease {
$isDragging = 0;
}
sub motion {
return unless $isDragging;
return if $isMax; # no dragging when maximized
# Get the new position.
my $curX = $Tk::event->X;
my $curY = $Tk::event->Y;
$curX -= $dragFromX;
$curY -= $dragFromY;
$winX = $curX;
$winY = $curY;
print "Cur: $curX,$curY; MoveTo: $winX,$winY (dragFrom: $dragFromX,$dragFromY)\n";
$main->MoveToplevelWindow ($winX,$winY);
}
sub startResize {
$isResizing = 1;
}
sub endResize {
$isResizing = 0;
}
sub doResize {
return unless $isResizing;
return if $isMax;
my $curX = $Tk::event->X - $winX;
my $curY = $Tk::event->Y - $winY;
$sizeX = $curX;
$sizeY = $curY;
$main->geometry ($sizeX . "x" . $sizeY);
}
sub showMenu {
my $ct = $main->Menu;
$ct->command (-label => '~Maximize', -command => \&max);
$ct->command (-label => '~Minimize', -command => \&min);
$ct->command (-label => '~Restore', -command => \&restore);
$ct->separator;
$ct->command (-label => '~Exit', -command => sub {
exit(0);
});
$ct->Popup (-popanchor => 'nw', -popover => 'cursor');
}
sub max {
if ($isMax) {
# Restore.
$main->geometry ($sizeX . "x" . $sizeY);
$main->MoveToplevelWindow ($winX,$winY);
$maxBttn->configure (-text => '1');
$isMax = 0;
}
else {
# Maximize.
$main->geometry ($main->screenwidth . 'x' . $main->screenheight);
$main->MoveToplevelWindow (0,0);
$maxBttn->configure (-text => '2');
$isMax = 1;
}
}
sub min {
if ($isMin) {
# Restore.
if ($isMax) {
$main->geometry ($main->screenwidth . 'x' . $main->screenheight);
$main->MoveToplevelWindow (0,0);
}
else {
$main->geometry ($sizeX . "x" . $sizeY);
$main->MoveToplevelWindow ($winX,$winY);
}
$isMin = 0;
}
else {
# Minimize
$main->geometry ('5x5');
$main->MoveToplevelWindow (-50,-50);
$isMin = 1;
}
}
sub restore {
if ($isMax) {
# Restore.
$main->geometry ($sizeX . "x" . $sizeY);
$main->MoveToplevelWindow ($winX,$winY);
$maxBttn->configure (-text => '1');
$isMax = 0;
}
if ($isMin) {
$main->geometry ($sizeX . "x" . $sizeY);
$main->MoveToplevelWindow ($winX,$winY);
}
} |
_________________
Current Site (2008) http://www.cuvou.com/ |
|
User Control Panel
