eType/de
From Free Pascal wiki
Jump to navigationJump to search
│
Deutsch (de) │
Zurück zur Konsolenseite.
Zeigt Textdateien in der Console an
Dieser Artikel gehört zur Konsolenprogrammierung unter Windows.
Beispiel für ein einfaches Dateianzeige-Programm mit eigenem Menü:
program eType;
{$mode objfpc}{$H+}
{$IMPLICITEXCEPTIONS OFF}
uses
Crt, Windows;
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.'));
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;
// Schliesst die Datei
Close(datQuellDatei);
subTastaturEingabe;
until blnProgrammEnde;
// Setzt den Rückgabewert des Programms
// OK
ExitCode := 0;
end.
--Olaf 08:54, 12 April 2014 (CEST)