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 und zeigt das die IDE Problem mit äöü Umlauten hat, außer bei der Ausgabe.
Beispiel für ein einfaches Dateianzeige-Programm mit eigenem Menü:
<syntaxhighlight lang=pascal>
program eType;
{$mode objfpc}{$H+} {$IMPLICITEXCEPTIONS OFF}
uses
Crt ; // , Windows; // so loifts 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;
// Schliesst die Datei Close(datQuellDatei);
subTastaturEingabe;
until blnProgrammEnde;
// Setzt den Rückgabewert des Programms // OK ExitCode := 0;
end.