eType/de

From Lazarus wiki

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ü:

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.



--Olaf 08:54, 12 April 2014 (CEST)