GUI mit Perl/Tk

Vergleich von Perl/Tk und Tkx

Inhaltsverzeichnis

Wer den Umstieg von Tk auf Tkx wagen möchte, der findet auf dieser Seite eine kleine Hilfestellung. Einige Widgets / Befehle werden im Vergleich von Perl/Tk zu Tkx gezeigt. Ziel ist es, sich schnell in Tkx einzufinden.

Perl/Tk Tkx 
#!perl

use strict;
use warnings;
use Tk;

my $mw = Tk::MainWindow->new();
$mw->title ("Perl/Tk - Erste Schritte");
$mw->minsize(200, 200);

my $btn = $mw->Button(
	-text => 'Klick mich',
);
$btn->pack(
	-fill => 'x',
);

$mw->MainLoop();
exit(0);
 
#!perl

use strict;
use warnings;
use Tkx;

my $mw = Tkx::widget->new(".");
$mw->g_wm_title("Perl/Tk - Erste Schritte");
$mw->g_wm_minsize(200, 200);

my $btn = $mw->new_ttk__button(
	-text => 'Klick mich',
);
$btn->g_pack(
	-fill => 'x',
);

Tkx::MainLoop();
exit(0);
MainWindow mit Button in Perl/Tk MainWindow mit Button in Perl/Tkx

Button mit Bild und Text

Dieses Beispiel stammt von hier: Buttons mit Bild in Perl/Tk und Tkx.

Perl/Tk Tkx 
#!perl

use strict;
use warnings;
use Tk;
use Tk::PNG;

my $png_image_file = 'media-playback-start-7.png';

my $mw = Tk::MainWindow->new();

my $pic = $mw->Photo(-file => $png_image_file);

my $btn = $mw->Button(
    -text => "Button mit PNG-Datei als Bild",
    -compound => 'top',
    -image => $pic,
);
$btn->pack(-padx => 10, -pady => 10,);

$mw->MainLoop();
exit(0);
 
#!perl

use strict;
use warnings;
use Tkx;
Tkx::package_require('img::png');

my $png_image_file = 'media-playback-start-7.png';

my $mw = Tkx::widget->new(".");

Tkx::image_create_photo('pic', 
	-file => $png_image_file);
my $btn = $mw->new_ttk__button(
    -text => "Button mit PNG-Datei als Bild",
    -compound => 'top',
    -image => 'pic',
);
$btn->g_pack(-padx => 10, -pady => 10,);

Tkx::MainLoop();
exit(0);
Bildbutton in Perl/Tk Bildbutton in Perl/Tkx

TFrame / Frames mit Label und Rahmen

Nicht für jedes Perl/Tk-Widget gibt es eine exakte Tkx-Entsprechung. Das TFrame gibt es beispielsweise nicht, in Tkx steht dafür das Labelframe zur Verfügung.

Perl/Tk Tkx 
#!perl

use strict;
use warnings;
use Tk;
use Tk::TFrame;

my $mw = Tk::MainWindow->new();

my $frame1 = $mw->TFrame(
    -label => [ -text => 'Title1' ],
    -borderwidth => 2,
    -relief => 'raise',
);

my $frame2 = $mw->TFrame(
   -label => 'Title2',
);
$frame2->Label(
	-bg => '#FFE773',
	-fg => '#A68900',
	-text => 'Text im TFrame'
)->pack();
$frame1->pack();
$frame2->pack();

$mw->MainLoop();
 
#!perl

use strict;
use warnings;
use Tkx;

my $mw = Tkx::widget->new(".");

my $lf = $mw->new_ttk__labelframe(
	-text => "Hello",
	-labelanchor => 'nw',
    -relief      => 'groove',
    -borderwidth => '5'
);

# -- Without content, the TFrame is not visible.
$lf->new_label(-text => "Das Labelframe wird erst sichtbar,\n"
	. "wenn ein Widget hineingepackt wird.")->g_pack();

$lf->g_pack(-padx => 10,-pady => 10,);

Tkx::MainLoop;
TFrame in Perl/Tk Labelframe in Perl/Tkx

MainWindow / Fenster aktualisieren

Manchmal möchte man zwischendurch das Fenster aktualisieren. Die Widgets werden dabei aktualisiert. Das ist insbesondere dann praktisch, wenn die GUI durch lang dauernde Operationen kurzzeitig einfriert. Der Nutzer erhält so gelegentlich ein Lebenszeichen von der Applikation.

Perl/Tk Tkx 
my $mw = Tk::MainWindow->new();
$mw->update();
 
my $mw = Tkx::widget->new(".");
Tkx::update();
 
my $mw = tkinit();
 
my $mw = Tkx::widget->new(".");

Drag'n'Drop mit tkdnd

Drag&Drop außerhalb der Tk-Anwendung kann für bestimmte Betriebssysteme mit der Tcl-Erweiterung tkdnd realisiert werden. Das Beispiel zeigt Drag and Drop zwischen Windows Explorer und einem Eingabefeld in der Perl-GUI.

Quelle: die Quellcodes stammen aus einer Mailing-Liste.

Perl/Tk scheint seine eigene, aktuelle Implementierung für Drag&Drop auf Windows mitzubringen. Es ist nicht notwendig, noch etwas nachzuinstallieren.

Bei Tkx ist das nicht so einfach. Man braucht das Programm tkdnd, welches in Tcl installiert werden muss.

Schritt-für-Schritt auf Windows 8 x64:

Die Tcl-Verzeichnisse müssen im Tkx-Quelltext per Tkx::lappend verfügbar gemacht werden.

Perl/Tk Tkx

Drag&Drop mit Perl/Tk

Drag&Drop mit Tkx

 
#!perl

use strict;
use Tk;
use Tk::DropSite;
use Tk::Pane;

my $textVariable = "drag here";

my $mw = MainWindow->new;

my $frame = $mw->Frame(
)->pack(-side => 'top', -expand => 1, -fill => 'x');

$frame->Label(
    -text => "My Label",
    -anchor => 'w',
    -width => 10,
)->pack(-ipady => 1, -side => 'left');

my $entry = $frame->Entry(
    -textvariable => \$textVariable,
    -width => 40,
)->pack(-side => 'left');

$frame->DropSite(
    -dropcommand => [\&AcceptDrop, $frame],
    -droptypes => ('Win32'),
);

$mw->MainLoop;


sub AcceptDrop {
    my ($widget, $selection) = @_;
    my $filename;

    $filename = $widget->SelectionGet(
    	-selection => $selection, 
        'STRING'
    );
    $textVariable = $filename;
} # /AcceptDrop
 
#!perl

use strict;
use Tkx;

Tkx::lappend('::auto_path', 'C:/Tcl/lib/');
Tkx::lappend(
	'::auto_path', 
	'C:/Tcl/lib/teapot/package/win32-ix86/lib'
);
Tkx::lappend(
	'::auto_path', 
	'C:/Tcl/lib/teapot/package/tcl/lib'
);

Tkx::package_require('tkdnd');

my $textVar = "drag here";

my $mw = Tkx::widget->new(".");

my $entry = $mw->new_entry(
	-name => ".current_dir", 
    -textvariable => \$textVar,
);

$entry->g_pack(qw '-fill both -expand true');

Tkx::tkdnd__drop___target_register($entry,'*');
Tkx::bind(
	$entry, 
    '<<Drop:DND_Files>>',
    [ sub { AcceptDrop(shift); }, Tkx::Ev("%D")]
);

Tkx::MainLoop;

sub AcceptDrop {
    $textVar = shift;
    print "in AcceptDrop with '$textVar'\n";
} # /AcceptDrop

Diverse andere Funktionen

Gesammelte Übersetzungen von Perl/Tk in Perl/Tkx:

Perl/Tk Tkx 
$mw->geometry('640x480');
 
$mw->g_wm_geometry('640x480');
 
$mw->optionAdd('*tearOff','false');
 
Tkx::option_add('*tearOff',0);
 
$mw->protocol('WM_DELETE_WINDOW', \&shutdown);
 
$mw->g_wm_protocol('WM_DELETE_WINDOW', \&shutdown);
 
$toplevel->withdraw;
 
$toplevel->g_wm_state("withdrawn");
 
$text->tagConfigure(…);
 
$text->tag_configure(…);
 
$mw->Menu(…);
 
$mw->new_menu(…);
 
$mw->destroy;
 
$mw->g_destroy;
 
$mw->Dialog(…);
 
$mw->Tkx::tk___dialog(…);
Top