Sign in Join
Wiki copytemporary

eType/de: what changed

Revision 1 to 2. Removed lines have a minus sign; added lines have a plus sign.

OldNewLine
1-│ **Deutsch (de)** │
2-****
3-
41## Zeigt Textdateien in der Console an
52
6-Dieser Artikel gehört zur Konsolenprogrammierung unter **Windows** und zeigt das die IDE Problem mit äöü Umlauten hat, außer bei der Ausgabe.
3+Dieser Artikel gehört zur Konsolenprogrammierung unter **Windows** und zeigt das die IDE Problem mit äöü Umlauten hat, außer bei der Ausgabe.
74
8-Beispiel für ein einfaches Dateianzeige-Programm mit eigenem Menü:
9-```
5+Beispiel für ein einfaches Dateianzeige-Programm mit eigenem Menü:
6+
7+``` pascal
108program eType;
11-
12- {$mode objFPC}
13- {$longStrings on}
14- {$implicitExceptions off}
15-
16- uses
17- Crt ; // , Windows; // so läuft's auch unter Linux
18-
19- var
20- blnTasteGedrueckt: boolean = False;
21- blnProgrammEnde: boolean = False;
22- blnDateiZuEnde: boolean = False;
23- intGeleseneZeilen: integer = 0;
24- intP: integer = 0;
25- intS: integer = 0;
26- chrTastatur: char;
27- datQuellDatei: Textfile;
28- strZeile: string;
29- strEingabe: string;
30- wrdParameter: word = 0;
31-
32-
33- function funAnsiZuOEM(strUebergabe: string): string;
34- begin
35- funAnsiZuOEM := '';
36- strUebergabe := Utf8ToAnsi(strUebergabe);
37- strUebergabe := strUebergabe + #0;
38- CharToOEM(PChar(strUebergabe), @strUebergabe[1]);
39- Delete(strUebergabe, Length(strUebergabe), 1);
40- Result := strUebergabe;
41- end;
42-
43-
44- procedure subHilfe;
45- begin
46- WriteLn(' Folgende Parameter rufen die Hilfe auf:');
47- WriteLn('  ? oder /? oder -? oder --? oder -h oder --h');
48- WriteLn('');
49- // WriteLn(funAnsiZuOEM(' Dem Programm muss ein Parameter übergeben werden.')); // wegen Win / Linux
50- WriteLn(' Diese Datei muss eine Textdatei sein.');
51- WriteLn(' Beispiel:');
52- WriteLn(' eType test.txt');
53- WriteLn('');
9+
10+{$mode objFPC}
11+{$longStrings on}
12+{$implicitExceptions off}
13+
14+uses
15+ Crt ; // , Windows; // so läuft's auch unter Linux
16+
17+var
18+ blnTasteGedrueckt: boolean = False;
19+ blnProgrammEnde: boolean = False;
20+ blnDateiZuEnde: boolean = False;
21+ intGeleseneZeilen: integer = 0;
22+ intP: integer = 0;
23+ intS: integer = 0;
24+ chrTastatur: char;
25+ datQuellDatei: Textfile;
26+ strZeile: string;
27+ strEingabe: string;
28+ wrdParameter: word = 0;
29+
30+ function funAnsiZuOEM(strUebergabe: string): string;
31+ begin
32+ funAnsiZuOEM := '';
33+ strUebergabe := Utf8ToAnsi(strUebergabe);
34+ strUebergabe := strUebergabe + #0;
35+ CharToOEM(PChar(strUebergabe), @strUebergabe[1]);
36+ Delete(strUebergabe, Length(strUebergabe), 1);
37+ Result := strUebergabe;
38+ end;
39+
40+ procedure subHilfe;
41+ begin
42+ WriteLn(' Folgende Parameter rufen die Hilfe auf:');
43+ WriteLn(' ? oder /? oder -? oder --? oder -h oder --h');
44+ WriteLn('');
45+ // WriteLn(funAnsiZuOEM(' Dem Programm muss ein Parameter übergeben werden.')); // wegen Win / Linux
46+ WriteLn(' Diese Datei muss eine Textdatei sein.');
47+ WriteLn(' Beispiel:');
48+ WriteLn(' eType test.txt');
49+ WriteLn('');
50+ end;
51+
52+ procedure subFehlermeldung;
53+ begin
54+ if wrdParameter = 0 then
55+ begin
56+ textcolor(lightred);
57+ writeln(funAnsiZuOEM(' Es wurde kein Parameter übergeben!'));
58+ WriteLn('');
59+ textcolor(lightgray);
60+ Exit;
61+ end;
62+
63+ if wrdParameter > 1 then
64+ begin
65+ textcolor(lightred);
66+ WriteLn(funAnsiZuOEM(' Es wurden zuviele Parameter übergeben!'));
67+ WriteLn('');
68+ textcolor(lightgray);
69+ subHilfe;
70+ end;
71+ end;
72+
73+ function funParametertest: boolean;
74+ begin
75+ Result := False;
76+
77+ // Prüft, ob die Hilfe aufgerufen wurde
78+ if (wrdParameter = 1) then
79+ begin
80+ case strEingabe of
81+ '?', '/?', '-?', '--?', '-h', '--h':
82+ subHilfe
83+ else
84+ Result := True;
5485 end;
55-
56-
57- procedure subFehlermeldung;
86+ end;
87+ end;
88+
89+ procedure subTastaturEingabe;
90+ begin
91+ repeat
92+ chrTastatur := readkey;
93+
94+ // erhöht die Zähler um 21
95+ if (chrTastatur = #81) then
5896 begin
59- if wrdParameter = 0 then
60- begin
61- textcolor(lightred);
62- writeln(funAnsiZuOEM(' Es wurde kein Parameter übergeben!'));
63- WriteLn('');
64- textcolor(lightgray);
65- Exit;
66- end;
67-
68- if wrdParameter > 1 then
97+ if blnDateiZuEnde = False then
6998 begin
70- textcolor(lightred);
71- WriteLn(funAnsiZuOEM(' Es wurden zuviele Parameter übergeben!'));
72- WriteLn('');
73- textcolor(lightgray);
74- subHilfe;
99+ Inc(intP, 21);
100+ Inc(intS, 21);
101+ blnTasteGedrueckt := True;
75102 end;
76103 end;
77-
78-
79- function funParametertest: boolean;
104+
105+ // verringert die Zähler um 21
106+ if (chrTastatur = #73) and (intP >= 21) then
80107 begin
81- Result := False;
82-
83- // Prüft, ob die Hilfe aufgerufen wurde
84- if (wrdParameter = 1) then
85- begin
86- case strEingabe of
87- '?', '/?', '-?', '--?', '-h', '--h':
88- subHilfe
89- else
90- Result := True;
91- end;
92- end;
108+ Dec(intP, 21);
109+ Dec(intS, 21);
110+ blnTasteGedrueckt := True;
93111 end;
94-
95-
96- procedure subTastaturEingabe;
112+
113+ if (chrTastatur = #79) or (chrTastatur = #27) then
97114 begin
98- repeat
99- chrTastatur := readkey;
100-
101- // erhöht die Zähler um 21
102- if (chrTastatur = #81) then
103- begin
104- if blnDateiZuEnde = False then
105- begin
106- Inc(intP, 21);
107- Inc(intS, 21);
108- blnTasteGedrueckt := True;
109- end;
110- end;
111-
112- // verringert die Zähler um 21
113- if (chrTastatur = #73) and (intP >= 21) then
114- begin
115- Dec(intP, 21);
116- Dec(intS, 21);
117- blnTasteGedrueckt := True;
118- end;
119-
120- if (chrTastatur = #79) or (chrTastatur = #27) then
121- begin
122- blnProgrammEnde := True;
123- blnTasteGedrueckt := True;
124- end;
125- until blnTasteGedrueckt;
115+ blnProgrammEnde := True;
116+ blnTasteGedrueckt := True;
126117 end;
127-
128-
129- procedure subUeberschrift;
118+ until blnTasteGedrueckt;
119+ end;
120+
121+ procedure subUeberschrift;
122+ begin
123+ // leert den Bildschirm
124+ clrscr;
125+
126+ // legt die Farbe der Überschrift fest
127+ textcolor(yellow);
128+ writeln(funAnsiZuOEM(
129+ 'PGUP --> Zurückblättern | PGDN --> Vorblättern | END --> beenden'));
130+ // legt die Textfarbe fest
131+ textcolor(lightgray);
132+ end;
133+
134+ procedure subDateiAusgeben;
135+ begin
136+ repeat
137+ // liest eine Zeile aus der Datei
138+ readln(datQuellDatei, strZeile);
139+ Inc(intGeleseneZeilen, 1);
140+ // gibt die Zeile aus der Datei am Bildschirm aus
141+ if intGeleseneZeilen >= intP then
142+ writeln(strZeile);
143+
144+ blnDateiZuEnde := False;
145+ // prüft auf Dateiende
146+ if EOF(datQuellDatei) then
130147 begin
131- // leert den Bildschirm
132- clrscr;
133-
134- // legt die Farbe der Überschrift fest
148+ blnDateiZuEnde := True;
135149 textcolor(yellow);
136- writeln(funAnsiZuOEM(
137- 'PGUP --> Zurückblättern | PGDN --> Vorblättern | END --> beenden'));
138- // legt die Textfarbe fest
150+ writeln('EOF');
139151 textcolor(lightgray);
140152 end;
141-
142-
143- procedure subDateiAusgeben;
144- begin
145- repeat
146- // liest eine Zeile aus der Datei
147- readln(datQuellDatei, strZeile);
148- Inc(intGeleseneZeilen, 1);
149- // gibt die Zeile aus der Datei am Bildschirm aus
150- if intGeleseneZeilen >= intP then
151- writeln(strZeile);
152-
153- blnDateiZuEnde := False;
154- // prüft auf Dateiende
155- if EOF(datQuellDatei) then
156- begin
157- blnDateiZuEnde := True;
158- textcolor(yellow);
159- writeln('EOF');
160- textcolor(lightgray);
161- end;
162-
163- until ((intGeleseneZeilen mod intS) = 0) or (EOF(datQuellDatei));
164- end;
165-
166-
167- procedure subParameterPruefen;
153+
154+ until ((intGeleseneZeilen mod intS) = 0) or (EOF(datQuellDatei));
155+ end;
156+
157+ procedure subParameterPruefen;
158+ begin
159+ wrdParameter := ParamCount;
160+
161+ // Prüft auf die korrekte Parameteranzahl
162+ if wrdParameter = 1 then
163+ begin
164+ strEingabe := ParamStr(1);
165+ if funParametertest = False then
168166 begin
169- wrdParameter := ParamCount;
170-
171- // Prüft auf die korrekte Parameteranzahl
172- if wrdParameter = 1 then
173- begin
174- strEingabe := ParamStr(1);
175- if funParametertest = False then
176- begin
177- ExitCode := 0;
178- Halt;
179- end;
180- end
181- else
182- begin
183- subFehlermeldung;
184- Halt;
185- end;
167+ ExitCode := 0;
168+ Halt;
186169 end;
187-
188-
189-
170+ end
171+ else
190172 begin
191- // Setzt den Rückgabewert des Programms vorsorglich auf Fehler
192- ExitCode := -1;
193-
194- subParameterPruefen;
195-
196- //Leert den Bildschirm
197- ClrScr;
198-
199- // Initialisierung der Zähler
200- intP := 0;
201- intS := 21;
202-
203- // öffnet die Datei
204- Assign(datQuellDatei, ParamStr(1));
205-
206- // Hauptschleife
207- repeat
208- // setzt den Dateizeiger auf den Dateianfang
209- reset(datQuellDatei);
210- intGeleseneZeilen := 0;
211-
212- subUeberschrift;
213- subDateiAusgeben;
214-
215- // Schließt die Datei
216- Close(datQuellDatei);
217-
218- subTastaturEingabe;
219- until blnProgrammEnde;
220-
221- // Setzt den Rückgabewert des Programms auf OK
222- ExitCode := 0;
223-
224- end.
173+ subFehlermeldung;
174+ Halt;
175+ end;
176+ end;
177+
178+begin
179+ // Setzt den Rückgabewert des Programms vorsorglich auf Fehler
180+ ExitCode := -1;
181+
182+ subParameterPruefen;
183+
184+ //Leert den Bildschirm
185+ ClrScr;
186+
187+ // Initialisierung der Zähler
188+ intP := 0;
189+ intS := 21;
190+
191+ // öffnet die Datei
192+ Assign(datQuellDatei, ParamStr(1));
193+
194+ // Hauptschleife
195+ repeat
196+ // setzt den Dateizeiger auf den Dateianfang
197+ reset(datQuellDatei);
198+ intGeleseneZeilen := 0;
199+
200+ subUeberschrift;
201+ subDateiAusgeben;
202+
203+ // Schließt die Datei
204+ Close(datQuellDatei);
205+
206+ subTastaturEingabe;
207+ until blnProgrammEnde;
208+
209+ // Setzt den Rückgabewert des Programms auf OK
210+ ExitCode := 0;
211+
212+end.
225213```
226214
227215---
228-*From the Free Pascal wiki, page "eType/de", as the Internet Archive kept it on 2025-03-27. Copyright stays with the author who wrote it, according to the old wiki's [[Licensing]] page. If you have concerns about this material, [message the admin](/wiki-contact).*
216+*From the Free Pascal wiki, page "eType/de", as it stood on 2022-08-06 after a change by Kai Burghardt, out of the wiki's dump of 2024-05-26. Copyright stays with the author who wrote it, according to the old wiki's [[Licensing]] page. If you have concerns about this material, [message the admin](/wiki-contact).*

Back to history