Schrift
[thread]5014[/thread]

Dialog zum Verzeichnis auswaehlen: unter Windows



<< >> 4 Einträge, 1 Seite
coax
 2005-05-15 22:53
#44051 #44051
User since
2003-08-11
457 Artikel
BenutzerIn
[default_avatar]
Ich hatte kuerzlich auf die Schnelle unter Linux ein Tk-Script geschrieben in dem ich ein Verzeichnis ueber einen Dialog, der durch $widget->chooseDirectory() aufgerufen wird, auswaehlen wollte.
Am gleichen Tag noch wollte ich das Script auf 'ner Windows-Kiste weiter schreiben, da ist mir aufgefallen, dass es da diese chooseDirectory()-Methode ueberhaupt nicht gab.
Moeglicherweise lag es an der Tk-Version, auf den Windowsrechner war ActivePerl 5.6.x installiert, auf den Linuxrechner Perl 5.8.4.

Mit welchen standardmaeszig mitgelieferten Tk-Module kann ich sonst ein Verzeichnis auswaehlen ?
Es war zwar mit Tk::FileSelect moeglich Verzeichnisse auszuwaehlen, dafuer bestimmt es aber nicht, oder doch ?

Grusz Christian.
,,Das perlt aber heute wieder...'' -- Dittsche
Strat
 2005-05-16 14:03
#44052 #44052
User since
2003-08-04
5246 Artikel
ModeratorIn
[Homepage] [default_avatar]
ich habe dafuer bisher Tk::FileDialog verwendet, z.B.
Code: (dl )
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');
}


Tk::DirSelect ist vielleicht besser geeignet, wenn man keine Dateiinfos braucht\n\n

<!--EDIT|Strat|1116238004-->
perl -le "s::*erlco'unaty.'.dk':e,y;*kn:ai;penmic;;print"
http://www.fabiani.net/
ptk
 2005-05-17 15:34
#44053 #44053
User since
2003-11-28
3645 Artikel
ModeratorIn
[default_avatar]
Hier ist ein chooseDirectory lite. Das Gute an dieser Funktion: wenn ein neueres Tk vorhanden ist, wird automatisch auch das neue chooseDirectory verwendet.
Code: (dl )
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;
};
}
coax
 2005-05-17 15:57
#44054 #44054
User since
2003-08-11
457 Artikel
BenutzerIn
[default_avatar]
[quote=ptk,17.05.2005, 13:34]Hier ist ein chooseDirectory lite. Das Gute an dieser Funktion: wenn ein neueres Tk vorhanden ist, wird automatisch auch das neue chooseDirectory verwendet.[/quote]
Sehr gut.. also lag es doch an der Tk-Version und nicht am OS.

Ich danke euch beiden :) .

Grusz Christian.
,,Das perlt aber heute wieder...'' -- Dittsche
<< >> 4 Einträge, 1 Seite



View all threads created 2005-05-15 22:53.