eType/de
From Lazarus wiki
Jump to navigationJump to search
│
Deutsch (de) │
Zeigt Textdateien in der Console an
Dieser Artikel gehört zur Konsolenprogrammierung unter Windows und zeigt das die IDE Problem mit äöü Umlauten hat, außer bei der Ausgabe.
Beispiel für ein einfaches Dateianzeige-Programm mit eigenem Menü:
program eType;
{$mode objFPC}
{$longStrings on}
{$implicitExceptions off}
uses
Crt ; // , Windows; // so läuft's auch unter Linux
var
blnTasteGedrueckt: boolean = False;
blnProgrammEnde: boolean = False;
blnDateiZuEnde: boolean = False;
intGeleseneZeilen: integer = 0;
intP: integer = 0;
intS: integer = 0;
chrTastatur: char;
datQuellDatei: Textfile;
strZeile: string;
strEingabe: string;
wrdParameter: word = 0;
function funAnsiZuOEM(strUebergabe: string): string;
begin
funAnsiZuOEM := '';
strUebergabe := Utf8ToAnsi(strUebergabe);
strUebergabe := strUebergabe + #0;
CharToOEM(PChar(strUebergabe), @strUebergabe[1]);
Delete(strUebergabe, Length(strUebergabe), 1);
Result := strUebergabe;
end;
procedure subHilfe;
begin
WriteLn(' Folgende Parameter rufen die Hilfe auf:');
WriteLn(' ? oder /? oder -? oder --? oder -h oder --h');
WriteLn('');
// WriteLn(funAnsiZuOEM(' Dem Programm muss ein Parameter übergeben werden.')); // wegen Win / Linux
WriteLn(' Diese Datei muss eine Textdatei sein.');
WriteLn(' Beispiel:');
WriteLn(' eType test.txt');
WriteLn('');
end;
procedure subFehlermeldung;
begin
if wrdParameter = 0 then
begin
textcolor(lightred);
writeln(funAnsiZuOEM(' Es wurde kein Parameter übergeben!'));
WriteLn('');
textcolor(lightgray);
Exit;
end;
if wrdParameter > 1 then
begin
textcolor(lightred);
WriteLn(funAnsiZuOEM(' Es wurden zuviele Parameter übergeben!'));
WriteLn('');
textcolor(lightgray);
subHilfe;
end;
end;
function funParametertest: boolean;
begin
Result := False;
// Prüft, ob die Hilfe aufgerufen wurde
if (wrdParameter = 1) then
begin
case strEingabe of
'?', '/?', '-?', '--?', '-h', '--h':
subHilfe
else
Result := True;
end;
end;
end;
procedure subTastaturEingabe;
begin
repeat
chrTastatur := readkey;
// erhöht die Zähler um 21
if (chrTastatur = #81) then
begin
if blnDateiZuEnde = False then
begin
Inc(intP, 21);
Inc(intS, 21);
blnTasteGedrueckt := True;
end;
end;
// verringert die Zähler um 21
if (chrTastatur = #73) and (intP >= 21) then
begin
Dec(intP, 21);
Dec(intS, 21);
blnTasteGedrueckt := True;
end;
if (chrTastatur = #79) or (chrTastatur = #27) then
begin
blnProgrammEnde := True;
blnTasteGedrueckt := True;
end;
until blnTasteGedrueckt;
end;
procedure subUeberschrift;
begin
// leert den Bildschirm
clrscr;
// legt die Farbe der Überschrift fest
textcolor(yellow);
writeln(funAnsiZuOEM(
'PGUP --> Zurückblättern | PGDN --> Vorblättern | END --> beenden'));
// legt die Textfarbe fest
textcolor(lightgray);
end;
procedure subDateiAusgeben;
begin
repeat
// liest eine Zeile aus der Datei
readln(datQuellDatei, strZeile);
Inc(intGeleseneZeilen, 1);
// gibt die Zeile aus der Datei am Bildschirm aus
if intGeleseneZeilen >= intP then
writeln(strZeile);
blnDateiZuEnde := False;
// prüft auf Dateiende
if EOF(datQuellDatei) then
begin
blnDateiZuEnde := True;
textcolor(yellow);
writeln('EOF');
textcolor(lightgray);
end;
until ((intGeleseneZeilen mod intS) = 0) or (EOF(datQuellDatei));
end;
procedure subParameterPruefen;
begin
wrdParameter := ParamCount;
// Prüft auf die korrekte Parameteranzahl
if wrdParameter = 1 then
begin
strEingabe := ParamStr(1);
if funParametertest = False then
begin
ExitCode := 0;
Halt;
end;
end
else
begin
subFehlermeldung;
Halt;
end;
end;
begin
// Setzt den Rückgabewert des Programms vorsorglich auf Fehler
ExitCode := -1;
subParameterPruefen;
//Leert den Bildschirm
ClrScr;
// Initialisierung der Zähler
intP := 0;
intS := 21;
// öffnet die Datei
Assign(datQuellDatei, ParamStr(1));
// Hauptschleife
repeat
// setzt den Dateizeiger auf den Dateianfang
reset(datQuellDatei);
intGeleseneZeilen := 0;
subUeberschrift;
subDateiAusgeben;
// Schließt die Datei
Close(datQuellDatei);
subTastaturEingabe;
until blnProgrammEnde;
// Setzt den Rückgabewert des Programms auf OK
ExitCode := 0;
end.