Thread TK-Modul Ein und Aulsesen: Anfänger verzweifelt (31 answers)
Opened by satanica1976 at 2004-08-16 17:43

Crian
 2004-08-18 15:59
#42437 #42437
User since
2003-08-04
5873 Artikel
ModeratorIn
[Homepage]
user image
So, ich habe mal eine Lösung erstellt, wobei ich die Ausgabe in einem Textfeld vorgenommen habe. Aber das sollte Dir schonmal eine ganze Ecke weiterhelfen, hoffe ich. Sonst (und bei anderen Problemen): Nachfragen =)

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
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
#!/usr/bin/perl
use strict;
use warnings;

=pod

=head AUFGABE

Erstellen Sie mithilfe des Moduls "Tk" ein PERL-Skript mit grafischer
Oberfläche, welches die Möglichkeit bietet, eine Ausgangsdatei im
Textformat (.txt) zu spezifizieren. Der User muss außerdem den Namen
einer Ausgabedatei selbst festlegen können. Durch das Anklicken eines
Buttons soll das Skript die bestehnde Datei einlesen und jeweils an
der ersten Stelle einer Zeile eine fortlaufende Zeilennummerierung
einfügen. Außerdem müssen die festgelegte Ausgabedatei generiert und
der Ergebnistext in die Datei ausgegeben werden, wobei über die
grafische Oberfläche (Listbox) die erfolgreiche Ausführung angezeigt
werden soll.

=cut

use Tk;
use Tk::LabFrame;
use Tk::ErrorDialog;


#
# MainWindow
#
my $mw = new MainWindow;
$mw->title("Komische Aufgabe von Satanica");

#
# Eingabedatei auswaehlen:
#
my $f1 = $mw->LabFrame(-label => 'Eingabedatei',
-labelside => 'acrosstop',
)
->pack(-side => 'top',
-expand => 1,
-fill => 'x',
);
my $ein_entry = $f1->Entry(-width => 50,
)
->pack(-side => 'left',
-expand => 1,
-fill => 'x',
);
my $ein_btn = $f1->Button(-text => 'Durchsuchen',
-command =>
sub {
my $typen = [
['Textdateien', '.txt' ],
['Alle Dateien', '*' ],
];
my $dn = $mw->getOpenFile(-filetypes => $typen,
);
if (defined $dn and $dn ne '') {
$ein_entry->delete(0, 'end');
$ein_entry->insert('end', $dn);
}
},
)
->pack(-side => 'left',
-expand => 0,
-fill => 'none',
);

#
# Ausgabedatei auswaehlen:
#
my $f2 = $mw->LabFrame(-label => 'Ausgabedatei',
-labelside => 'acrosstop',
)
->pack(-side => 'top',
-expand => 1,
-fill => 'x',
);
my $aus_entry = $f2->Entry(-width => 50,
)
->pack(-side => 'left',
-expand => 1,
-fill => 'x',
);
my $aus_btn = $f2->Button(-text => 'Durchsuchen',
-command =>
sub {
my $typen = [
['Textdateien', '.txt' ],
['Alle Dateien', '*' ],
];
my $dn = $mw->getSaveFile(-filetypes => $typen,
-defaultextension => 'txt',
);

if (defined $dn and $dn ne '') {
$aus_entry->delete(0, 'end');
$aus_entry->insert('end', $dn);
}
},
)
->pack(-side => 'left',
-expand => 0,
-fill => 'none',
);

#
# DoIt-Button:
#
my $doit_btn = $mw->Button(-text => 'do it',
-command => sub {do_it( $ein_entry->get(), $aus_entry->get())},
)
->pack(-side => 'top',
-expand => 1,
-fill => 'x',
);

#
# Beweisausgabe:
#
my $anzeige = $mw->Scrolled("Text",
-scrollbars => 'osoe',
-background => '#d7d7d7',
-foreground => 'blue',
-width => 80,
-height => 25,
-relief => 'flat',
-font => '{Courier New} 10 {normal}',
-wrap => 'none',
)
->pack(-side => 'top',
-expand => 1,
-fill => 'both',
);

#
# Exit-Button:
#
my $exit_btn = $mw->Button(-text => 'Ende',
-command => sub { $mw->destroy() },
)
->pack(-side => 'top',
-expand => 1,
-fill => 'x',
);

#
# Bindungen:
#
$mw->bind ('<Return>', sub{$doit_btn->invoke()});
$mw->bind ('<Escape>', sub{$exit_btn->invoke()});


MainLoop();

sub do_it {
my ($ein, $aus) = @_;

die "Fehlende Parameter in do_it"
unless defined $ein
and defined $aus;
die "Eingabedatei '$ein' nicht vorhanden in do_it"
unless -f $ein;

open (IN, $ein ) or die "Kann '$ein' nicht zum Lesen oeffen: $!";
open (OUT, ">$aus") or die "Kann '$aus' nicht zum Schreiben oeffen: $!";
while (<IN>) {
print OUT $. . ':' . $_;
}
close OUT or die "Kann '$aus' nicht schliessen: $!";
close IN or warn "Kann '$ein' nicht schliessen: $!";

open (IN, $aus ) or die "Kann '$aus' nicht zum Lesen oeffen: $!";
while (<IN>) {
$anzeige->insert('end', $_);
}
close IN or warn "Kann '$aus' nicht schliessen: $!";
}


(Kann ich Dir sonst auch nochmal schicken, der CODE-Tag klaut leider immer das erste Whitespace-Zeichen.)

[getestet an einer Datei mit 100000 Zeilken :-)\n\n

<!--EDIT|Crian|1092830685-->
s--Pevna-;s.([a-z]).chr((ord($1)-84)%26+97).gee; s^([A-Z])^chr((ord($1)-52)%26+65)^gee;print;

use strict; use warnings; Link zu meiner Perlseite

View full thread TK-Modul Ein und Aulsesen: Anfänger verzweifelt