![]() |
![]() |
4 Einträge, 1 Seite |
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
my $loadDialog = $mw->FileDialog(-Title => 'Verzeichnis auswaehlen',
-Create => 0,
-SelDir => 1,
-Path => $inputDir,
-FPat => '*.pl *.cgi *.pm *.tmpl',
-DirLBCaption => 'Verzeichnisse:',
-FileLBCaption => 'Dateien: ',
-FileEntryLabel => 'Datei: ',
-PathEntryLabel => 'Pfad: ',
-FltEntryLabel => 'Filter: ',
-ShowAllLabel => 'Alle anzeigen',
);
$inputDir = $loadDialog->Show(-Horiz => 1);
unless (defined($inputDir) and -d $inputDir) {
die sprintf("Fehler: %s\n",
defined($inputDir) ? $inputDir . " ist kein Verzeichnis" :
'kein Verzeichnis ausgewaehlt');
}
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
=head2 $top->chooseDirectory(%args)
=for category Tk
A directory selector. Possible arguments:
* -initialdir
* -title
=cut
if (!Tk::Widget->can("chooseDirectory")) {
*Tk::Widget::chooseDirectory = sub {
my($top, %args) = @_;
my $curr_dir = $args{-initialdir};
if (!defined $curr_dir) {
require Cwd;
$curr_dir = Cwd::cwd();
}
if (defined $args{-mustexist}) {
die "-mustexist is not yet implemented";
}
my $title = $args{-title} || "Choose directory:";
require Tk::DirTree;
my $t = $top->Toplevel;
$t->title($title);
my $ok = 0; # flag: "1" means OK, "-1" means cancelled
# Create Frame widget before the DirTree widget, so it's always visible
# if the window gets resized.
my $f = $t->Frame->pack(-fill => "x", -side => "bottom");
my $d;
$d = $t->Scrolled('DirTree',
-scrollbars => 'osoe',
-width => 35,
-height => 20,
-selectmode => 'browse',
-exportselection => 1,
-browsecmd => sub { $curr_dir = shift;
if ($^O ne 'MSWin32') {
$curr_dir =~ s|^//|/|; # bugfix
}
},
# With this version of -command a double-click will
# select the directory
-command => sub { $ok = 1 },
# With this version of -command a double-click will
# open a directory. Selection is only possible with
# the Ok button.
#-command => sub { $d->opencmd($_[0]) },
)->pack(-fill => "both", -expand => 1);
# Set the initial directory
exists &Tk::DirTree::chdir ? $d->chdir($curr_dir) : $d->set_dir($curr_dir);
$f->Button(-text => 'Ok',
-command => sub { $ok = 1 })->pack(-side => 'left');
$f->Button(-text => 'Cancel',
-command => sub { $ok = -1 })->pack(-side => 'left');
$t->OnDestroy(sub { $ok = -1 });
$f->waitVariable(\$ok);
if ($ok == -1) {
undef $curr_dir;
}
$t->destroy if Tk::Exists($t);
$curr_dir;
};
}
![]() |
![]() |
4 Einträge, 1 Seite |