eType/de

From Lazarus wiki
Revision as of 13:18, 14 February 2020 by Trev (talk | contribs) (Fixed syntax highlighting; deleted category included in page template)
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.