Pascal: Spickzettel

Klare, streng strukturierte Lehrsprache mit Object Pascal

Ausführen: Datei hallo.pas speichern, mit fpc hallo.pas übersetzen und ./hallo starten (Free Pascal von freepascal.org).

fpc hallo.pas            # übersetzen, erzeugt die ausführbare Datei hallo
./hallo                  # starten
fpc -Mobjfpc -Sh hallo.pas   # Object-Pascal-Modus, lange Strings
fpc -O2 hallo.pas        # optimiert
lazarus-ide              # Entwicklungsumgebung mit Formular-Designer

program Bedingungen;
var
  n: Integer;
  note: Integer;
begin
  n := 15;
  if n mod 15 = 0 then
    writeln('FizzBuzz')
  else if n mod 3 = 0 then
    writeln('Fizz')
  else
    writeln(n);

  note := 2;
  case note of
    1: writeln('sehr gut');
    2, 3: writeln('gut bis befriedigend');
    4..5: writeln('ausreichend bis mangelhaft');
  else
    writeln('ungültig');
  end;

  if (n > 10) and (n < 20) then
  begin
    writeln('zwischen 10 und 20');
    writeln('zweite Zeile');
  end;
end.

program Texte;
{$mode objfpc}{$H+}
uses SysUtils, StrUtils;
var
  s: String;
  i: Integer;
begin
  s := 'Hallo Pascal';
  writeln(Length(s), ' ', UpperCase(s), ' ', LowerCase(s));
  writeln(s[1], ' ', Copy(s, 7, 6), ' ', Pos('Pascal', s));
  writeln(s + '!', ' ', StringOfChar('*', 5));
  s := Trim('   x   ');
  writeln('[', s, ']');
  writeln(StringReplace('a-b-c', '-', '+', [rfReplaceAll]));
  writeln(IntToStr(42) + StrToIntDef('x', -1).ToString);
  writeln(StrToInt('17') + 1, ' ', FloatToStr(2.5), ' ', StrToFloat('3.5') * 2:0:1);
  writeln(Format('%d: %s (%5.2f)', [7, 'Wert', 3.14159]));
  writeln(Format('%-6s|%6s|%.3d|%x', ['li', 're', 5, 255]));
  writeln(ReverseString('Pascal'), ' ', DupeString('ab', 3));
  writeln(SameText('ABC', 'abc'), ' ', CompareStr('a', 'b'));
  writeln(Chr(Ord('A') + 1), ' ', UpCase('q'));
  for i := 1 to Length('abc') do write(Ord('abc'[i]), ' ');
  writeln;
  writeln(WordCount('ein kleiner Satz hier', [' ']));
  writeln(ExtractWord(2, 'ein kleiner Satz', [' ']));
end.

program Tiere;
{$mode objfpc}{$H+}

type
  TTier = class
  private
    FName: String;
  public
    constructor Create(AName: String);
    function Laut: String; virtual;
    function Vorstellen: String;
    property Name: String read FName write FName;
  end;

  THund = class(TTier)
  public
    function Laut: String; override;
  end;

  TKatze = class(TTier)
  public
    function Laut: String; override;
  end;

constructor TTier.Create(AName: String);
begin
  inherited Create;
  FName := AName;
end;

function TTier.Laut: String;
begin
  Result := '...';
end;

function TTier.Vorstellen: String;
begin
  Result := Name + ' sagt ' + Laut;
end;

function THund.Laut: String;
begin
  Result := 'Wau';
end;

function TKatze.Laut: String;
begin
  Result := 'Miau';
end;

var
  zoo: array[0..1] of TTier;
  t: TTier;
begin
  zoo[0] := THund.Create('Rex');
  zoo[1] := TKatze.Create('Mimi');
  for t in zoo do writeln(t.Vorstellen);
  writeln(zoo[0] is THund, ' ', zoo[1] is THund, ' ', zoo[0].ClassName);
  for t in zoo do t.Free;
end.

program Dateien;
{$mode objfpc}{$H+}
uses SysUtils;
var
  f: TextFile;
  zeile: String;
  pfad: String;
  n: Integer;
begin
  pfad := GetTempDir + 'pascal-demo.txt';
  AssignFile(f, pfad);
  Rewrite(f);
  writeln(f, 'eins');
  writeln(f, 'zwei');
  writeln(f, 'drei ', 42);
  CloseFile(f);

  AssignFile(f, pfad);
  Reset(f);
  n := 0;
  while not Eof(f) do
  begin
    ReadLn(f, zeile);
    Inc(n);
    writeln(n, ': ', zeile);
  end;
  CloseFile(f);

  AssignFile(f, pfad);
  Append(f);
  writeln(f, 'vier');
  CloseFile(f);

  writeln(FileExists(pfad));
  DeleteFile(pfad);
  writeln(FileExists(pfad));
end.

program Algorithmen;
{$mode objfpc}{$H+}

procedure Hanoi(n: Integer; von, nach, hilf: Char);
begin
  if n = 0 then Exit;
  Hanoi(n - 1, von, hilf, nach);
  writeln('Scheibe ', n, ': ', von, ' -> ', nach);
  Hanoi(n - 1, hilf, nach, von);
end;

function GGT(a, b: Integer): Integer;
begin
  if b = 0 then Result := a else Result := GGT(b, a mod b);
end;

procedure BubbleSort(var a: array of Integer);
var
  i, j, t: Integer;
begin
  for i := High(a) downto 1 do
    for j := 0 to i - 1 do
      if a[j] > a[j + 1] then
      begin
        t := a[j]; a[j] := a[j + 1]; a[j + 1] := t;
      end;
end;

function BinaereSuche(const a: array of Integer; x: Integer): Integer;
var
  lo, hi, mitte: Integer;
begin
  lo := 0; hi := High(a); Result := -1;
  while lo <= hi do
  begin
    mitte := (lo + hi) div 2;
    if a[mitte] = x then begin Result := mitte; Exit; end
    else if a[mitte] < x then lo := mitte + 1
    else hi := mitte - 1;
  end;
end;

var
  feld: array[0..5] of Integer = (42, 7, 19, 3, 88, 25);
  i: Integer;
begin
  Hanoi(3, 'A', 'C', 'B');
  writeln(GGT(48, 18));
  BubbleSort(feld);
  for i := 0 to High(feld) do write(feld[i], ' ');
  writeln;
  writeln(BinaereSuche(feld, 25), ' ', BinaereSuche(feld, 5));
end.

program Sieb;
{$mode objfpc}{$H+}
const
  N = 50;
var
  prim: array[2..N] of Boolean;
  i, j, anzahl: Integer;
begin
  for i := 2 to N do prim[i] := True;
  for i := 2 to N do
    if prim[i] then
      for j := i * i to N do
        if j mod i = 0 then prim[j] := False;
  anzahl := 0;
  for i := 2 to N do
    if prim[i] then
    begin
      write(i, ' ');
      Inc(anzahl);
    end;
  writeln;
  writeln(anzahl, ' Primzahlen bis ', N);
end.

program Referenz;
{$mode objfpc}{$H+}
uses SysUtils, StrUtils, Math;
var
  a: array[1..3] of Integer = (3, 1, 2);
  i: Integer;
begin
  writeln(Odd(3), ' ', Ord('a'), ' ', Chr(97), ' ', Abs(-2), ' ', Sqr(4));
  writeln(Trunc(2.7), ' ', Round(2.5), ' ', Frac(2.75):0:2, ' ', Int(2.75):0:1);
  writeln(Length('Pascal'), ' ', Copy('Pascal', 1, 3), ' ', Pos('s', 'Pascal'));
  writeln(UpperCase('x'), LowerCase('Y'), ' ', IntToStr(5), ' ', BoolToStr(True, True));
  writeln(IfThen(3 > 2, 'ja', 'nein'), ' ', Sign(-9), ' ', Random(1) = 0);
  for i := Low(a) to High(a) do write(a[i], ';');
  writeln;
  writeln(SizeOf(Integer), ' ', SizeOf(Double), ' ', SizeOf(Char));
  writeln(MaxInt, ' ', High(Int64));
end.