Sign in Join
Wiki copytemporary

eType/de: what changed

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

Title: eType/de

OldNewLine
1+│ **Deutsch (de)** │
2+****
3+
4+## Zeigt Textdateien in der Console an
5+
6+Dieser Artikel gehört zur Konsolenprogrammierung unter **Windows** und zeigt das die IDE Problem mit äöü Umlauten hat, außer bei der Ausgabe.
7+
8+Beispiel für ein einfaches Dateianzeige-Programm mit eigenem Menü:
9+```
10+program 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('');
54+ end;
55+
56+
57+ procedure subFehlermeldung;
58+ 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
69+ begin
70+ textcolor(lightred);
71+ WriteLn(funAnsiZuOEM(' Es wurden zuviele Parameter übergeben!'));
72+ WriteLn('');
73+ textcolor(lightgray);
74+ subHilfe;
75+ end;
76+ end;
77+
78+
79+ function funParametertest: boolean;
80+ 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;
93+ end;
94+
95+
96+ procedure subTastaturEingabe;
97+ 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;
126+ end;
127+
128+
129+ procedure subUeberschrift;
130+ begin
131+ // leert den Bildschirm
132+ clrscr;
133+
134+ // legt die Farbe der Überschrift fest
135+ textcolor(yellow);
136+ writeln(funAnsiZuOEM(
137+ 'PGUP --> Zurückblättern | PGDN --> Vorblättern | END --> beenden'));
138+ // legt die Textfarbe fest
139+ textcolor(lightgray);
140+ 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;
168+ 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;
186+ end;
187+
188+
189+
190+ 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.
225+```
226+
227+---
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).*

Back to history