Source Code der Datei "HANDY.PAS":

{$G+}
program handy2;
uses crt,dos;
{globale variablen}
var frz,ant,vormenue,musikend,bildnr,einst:char;
    fop1,fop2,erg:real;
    d:integer;
    bildpfad:string;
    label sprung;

var name : array [1..50] of string;
    nummer : array [1..50] of string;
    u : longint;
    i,j : char;

type pcxheader_rec = record
       manufacturer   : byte;
       version        : byte;
       encoding       : byte;
       bits_per_pixel : byte;
       xmin, ymin     : word;
       xmax, ymax     : word;
       hres           : word;
       vres           : word;
       palette        : array [0..47] of byte;
       reserved       : byte;
       colour_planes  : byte;
       bytes_per_line : word;
       palette_type   : word;
       filler         : array [0..57] of byte;
     end;
     ScrArr           = Array[0..320*200] of Byte;
     ScrArrPtr        = ^ScrArr;
     PcxPalette       = array [0..767] of byte;

var header       : pcxheader_rec;
    width, depth : word;
    bytes        : word;
    f            : file;
    c            : byte;
    crstyp       : word;
    Bt           : Byte;
    crs,csr,
    scr,rsc      : ScrArrPtr;
    ww           : Word;
    palette      : PcxPalette;

    taste, zeichen, mnu    : char;
    x, y, a, b             : byte;
    modepuffer, numint, hz : integer;
    punkte, punkteold      : longint;
    kachel                 : array[1..49,1..80] of char;
    labdat                 : text;
    zeile, datei, numstr   : string;
    tot                    : boolean;
    pause                  : word;


procedure grundstruktur;
 begin
                   { 0        10        20        30        }
      {z ,sp}      { 123456789012345678901234567890123456789}
gotoxy(01,01);write('ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»');
gotoxy(01,02);write('º                                     º');
gotoxy(01,03);write('º                                     º');
gotoxy(01,04);write('º    ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»     º');
gotoxy(01,05);write('º    º                          º     º');
gotoxy(01,06);write('º    º                          º     º');
gotoxy(01,07);write('º    º                          º     º');
gotoxy(01,08);write('º    º                          º     º');
gotoxy(01,09);write('º    º                          º     º');
gotoxy(01,10);write('º    º                          º     º');
gotoxy(01,11);write('º    º                          º     º');
gotoxy(01,12);write('º    º                          º     º');
gotoxy(01,13);write('º    º                          º     º');
gotoxy(01,14);write('º    º                          º     º');
gotoxy(01,15);write('º    º                          º     º');
gotoxy(01,16);write('º    º                          º     º');
gotoxy(01,17);write('º    º                          º     º');
gotoxy(01,18);write('º    ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ     º');
gotoxy(01,19);write('º                                     º');
gotoxy(01,20);write('º                                     º');
gotoxy(01,21);write('º    ÚÄÄÄÄÄ¿    ÚÄÄÄÄÄ¿    ÚÄÄÄÄÄ¿    º');
gotoxy(01,22);write('º    ³     ³    ³     ³    ³     ³    º');
gotoxy(01,23);write('º    ³  1  ³    ³  2  ³    ³  3  ³    º');
gotoxy(01,24);write('º    ³  _  ³    ³ abc ³    ³ def ³    º');
gotoxy(01,25);write('º    ÀÄÄÄÄÄÙ    ÀÄÄÄÄÄÙ    ÀÄÄÄÄÄÙ    º');
gotoxy(01,26);write('º                                     º');
gotoxy(01,27);write('º                                     º');
gotoxy(01,28);write('º    ÚÄÄÄÄÄ¿    ÚÄÄÄÄÄ¿    ÚÄÄÄÄÄ¿    º');
gotoxy(01,29);write('º    ³     ³    ³     ³    ³     ³    º');
gotoxy(01,30);write('º    ³  4  ³    ³  5  ³    ³  6  ³    º');
gotoxy(01,31);write('º    ³ ghi ³    ³ jkl ³    ³ mno ³    º');
gotoxy(01,32);write('º    ÀÄÄÄÄÄÙ    ÀÄÄÄÄÄÙ    ÀÄÄÄÄÄÙ    º');
gotoxy(01,33);write('º                                     º');
gotoxy(01,34);write('º                                     º');
gotoxy(01,35);write('º    ÚÄÄÄÄÄ¿    ÚÄÄÄÄÄ¿    ÚÄÄÄÄÄ¿    º');
gotoxy(01,36);write('º    ³     ³    ³     ³    ³     ³    º');
gotoxy(01,37);write('º    ³  7  ³    ³  8  ³    ³  9  ³    º');
gotoxy(01,38);write('º    ³pqrs ³    ³ tuv ³    ³ wxyz³    º');
gotoxy(01,39);write('º    ÀÄÄÄÄÄÙ    ÀÄÄÄÄÄÙ    ÀÄÄÄÄÄÙ    º');
gotoxy(01,40);write('º                                     º');
gotoxy(01,41);write('º                                     º');
gotoxy(01,42);write('º    ÚÄÄÄÄÄ¿    ÚÄÄÄÄÄ¿    ÚÄÄÄÄÄ¿    º');
gotoxy(01,43);write('º    ³     ³    ³     ³    ³     ³    º');
gotoxy(01,44);write('º    ³  *  ³    ³  0  ³    ³  #  ³    º');
gotoxy(01,45);write('º    ³     ³    ³     ³    ³     ³    º');
gotoxy(01,46);write('º    ÀÄÄÄÄÄÙ    ÀÄÄÄÄÄÙ    ÀÄÄÄÄÄÙ    º');
gotoxy(01,47);write('º                                     º');
gotoxy(01,48);write('ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ');
 end;


procedure menu;
begin                   {---Begin Procedure menu---}
  textcolor(white);
  clrscr;
  grundstruktur;
  gotoxy(08,07); write('1. Spielen   ');
  gotoxy(08,08); write('2. Anleitung ');
  gotoxy(08,09); write('3. Hauptmen ');
  repeat
    gotoxy(58,15); mnu:=readkey;
  until (mnu='1') or (mnu='2') or (mnu='3');
end;                    {---End Procedure menu---}

procedure ende;
begin                   {---Begin Procedure ende---}
  clrscr;
  grundstruktur;
  textmode(modepuffer);
end;                    {---End Procedure ende---}

procedure anleitung;
begin                   {---Begin Procedure anleitung---}

  clrscr;
  grundstruktur;
  textcolor(white);
  gotoxy(08,05); write('Spielregeln:');
  gotoxy(08,06); write('Bewegen Sie den Cursor');
  gotoxy(08,07); write('mit den Pfeiltasten durch');
  gotoxy(08,08); write('das Labyrinth. Sammeln');
  gotoxy(08,09); write('Sie die Symbole ein und');
  gotoxy(08,10); write('kassieren Sie Punkte.');
  gotoxy(08,11); write('Aber vorsicht: nicht alle');
  gotoxy(08,12); write('Symbole bringen Punkte!');
  gotoxy(08,14); write('weiter...  -> EINGABE');
  readkey;
  clrscr;
  grundstruktur;
  gotoxy(08,05); textcolor(red);write('Û');textcolor(white); write(' 1.Berhrung: -25 Punkte');
  gotoxy(08,06); textcolor(red);write('Û');textcolor(white); write(' 2.Ber. : letztes Leben');
  gotoxy(08,07); textcolor(blue);write('²');textcolor(white);write(' 25 Punkte');
  gotoxy(08,08); textcolor(yellow); write('±'); textcolor(white); write(' 15 Punkte');
  gotoxy(08,09); textcolor(green); write('°'); textcolor(white); write('  5 Punkte');
  gotoxy(08,10); write('Danach mssen Sie durch');
  gotoxy(08,11); write('den Ausgang (eine Lcke');
  gotoxy(08,12); write('im Rahmen) gehen, um in');
  gotoxy(08,13); write('das n„chste Level zu');
  gotoxy(08,14); write('gelangen.');
  gotoxy(08,16); write('Spiel unterbrechen:"ESC"');
  gotoxy(08,17); write('zurck... ->  EINGABE');
  readkey;
  menu;
end;                    {---End Procedure anleitung---}

procedure spiel;
procedure lesen;
begin                   {---Begin Procedure lesen---}
  assign (labdat,datei);
  clrscr;
  {$I-}
  reset (labdat);
  {$I+}
  if ioresult > 0 then
  begin
    writeln ('Datei ',datei,' nicht gefunden!!!'); writeln;
    write ('Programm beendet. Weiter mit beliebiger Taste...');
    readkey;
    ende;
  end else
  while not eof(labdat) do
    begin
      for y := 1 to 49 do
      begin
        readln (labdat,zeile);
        for x := 1 to 80 do kachel[y,x] := zeile[x];
      end;
      for y := 1 to 49 do
      for x := 1 to 80 do begin
                            gotoxy(x,y);
                            case kachel[y,x] of
                              'Û' : textcolor(red);
                              '²' : textcolor(blue);
                              '±' : textcolor(yellow);
                              '°' : textcolor(green);
                              else textcolor(white);
                            end;
                            write (kachel[y,x]);
                          end;
    end;
  close(labdat);
  tot := false;
  gotoxy(1,50); write('Punkte: ',punkte);
  gotoxy(18,50); write('Level: ',numint);
  gotoxy(32,50); write('Leben: '); textcolor(green); write('ÛÛÛ');
  x := 2; y := 48;
  gotoxy(x,y); textcolor(magenta); write(zeichen); textcolor(white);
end;                    {---End Procedure lesen---}

procedure loadnext;
begin                   {---Begin Procedure loadnext---}
  punkteold := punkte;

          d:=1;
          Delay(25);Sound(396);Delay(100*d);nosound;delay(100*d);
          Sound(467);Delay(50*d);nosound;delay(100*d);
          Sound(396);Delay(50*d);nosound;delay(50*d);
          Sound(396);Delay(50*d);nosound;
          Sound(528);Delay(100*d);nosound;
          Sound(396);Delay(100*d);nosound;
          Sound(352);Delay(100*d);nosound;
          Sound(396);Delay(100*d);nosound;delay(100*d);
          Sound(594);Delay(50*d);nosound;delay(100*d);
          Sound(396);Delay(50*d);nosound;delay(50*d);
          Sound(396);Delay(50*d);nosound;
          Sound(627);Delay(100*d);nosound;
          Sound(594);Delay(100*d);nosound;
          Sound(467);Delay(100*d);nosound;
          Sound(396);Delay(100*d);nosound;
          Sound(594);Delay(100*d);nosound;
          Sound(792);Delay(100*d);nosound;
          Sound(396);Delay(50*d);nosound;
          Sound(352);Delay(50*d);nosound;delay(50*d);
          Sound(352);Delay(50*d);nosound;
          Sound(297);Delay(100*d);nosound;
          Sound(467);Delay(100*d);nosound;
          Sound(396);Delay(400*d);nosound;delay(200*d);


  if numint = 9 then begin
                       gotoxy(1,50); write('Das war das letzte Level. Ihr Punktestand: ',punkte,' Punkte. Weiter mit ENTER.');
                       readln;
                       menu;
                       case mnu of
                         '1' : spiel;
                         '2' : anleitung;
                         '3' : ende;
                       end;
                     end else
  begin
    inc(numint);
    str (numint, numstr);
    datei := 'c:\01\spiel\' + numstr + '.lab';
    lesen;
  end;
end;                    {---End Procedure loadnext---}

procedure loadprevious;
begin                   {---Begin Procedure loadprevious---}

  punkte := punkteold;

  if numint > 1 then
  begin
    dec(numint);
    str (numint, numstr);
    datei := 'c:\01\spiel\' + numstr + '.lab';
  end;
  lesen;
end;                    {---End Procedure loadprevious---}

procedure steuerung;
procedure futter;
procedure kachelwrite;
begin                   {---Begin Procedure kachelwrite---}
  kachel[y,x] := ' ';
  gotoxy(x,y); write(kachel[y,x]);
  sound(200); delay(100); nosound;
  gotoxy(1,50); delline;
  write('Punkte: ',punkte);
  gotoxy(18,50); write('Level: ',numint);
  gotoxy(32,50); write('Leben: ');
  if tot = true then textcolor(red) else textcolor(green);
  write('ÛÛÛ'); textcolor(white);
end;                    {---End Procedure kachelwrite---}

begin                   {---Begin Procedure futter---}
  case kachel[y,x] of
    'Û' : begin
            sound(100); delay(100); nosound;
            case tot of
              true : begin
                       gotoxy(1,50); write('Sie sind tot (Hr. Hartmann) !!! Zurck mit beliebiger Taste...');
                       readkey;
                       loadprevious;
                       steuerung;
                     end;
              false : begin
                        punkte := punkte-25;
                        tot := true;
                        kachelwrite;
                      end;
            end;
          end;
    '²' : begin
            punkte := punkte+25;
            kachelwrite;
          end;
    '±' : begin
            punkte := punkte+15;
            kachelwrite;
          end;
    '°' : begin
            punkte := punkte+5;
            kachelwrite;
          end;
  end;
end;                    {---End Procedure futter---}

procedure bewegung;
begin                   {---Begin Procedure bewegung---}
  gotoxy(x,y); textcolor(magenta); write (zeichen); textcolor(white);
  gotoxy(a,b); write(' ');
  gotoxy(x,y);
  if (x = 1) or (x = 80) or (y = 1) or (y = 49) then begin
                                                       loadnext;
                                                       steuerung;
                                                     end;
end;                    {---End Procedure bewegung---}

begin                   {---Begin Procedure steuerung---}
  zeichen := chr(2);
  x := 2; y := 48;
  gotoxy(x,y);
  textcolor(magenta); write (zeichen); textcolor(white);
repeat
  repeat
    taste := readkey;
    if taste = chr(0) then taste := readkey;
  until taste in ['M','K','P','H',chr(27)];
  case taste of
    'M' : begin    {---Links---}
            repeat
              inc(x);
              a := x-1; b := y;
              futter;
              if kachel[y,x] <> ' ' then dec(x)
              else bewegung;
              delay(pause);
            until keypressed
          end;
    'K' : begin    {---Rechts---}
            repeat
              dec(x);
              a := x+1; b := y;
              futter;
              if kachel[y,x] <> ' ' then inc(x)
              else bewegung;
              delay(pause);
            until keypressed
          end;
    'P' : begin    {---Runter---}
            repeat
              inc(y);
              a := x; b := y-1;
              futter;
              if kachel[y,x] <> ' ' then dec(y)
              else bewegung;
              delay(pause);
            until keypressed
          end;
    'H' : begin    {---Hoch---}
            repeat
              dec(y);
              a := x; b := y+1;
              futter;
              if kachel[y,x] <> ' ' then inc(y)
              else bewegung;
              delay(pause);
            until keypressed
          end;
  end;
  until ord(taste) = 27;
end;                    {---End Procedure steuerung---}

begin                   {---Begin Procedure spiel---}
  textmode(Co80 + font8x8);
  pause := 75;
  punkte := 0;
  tot := false;
  numint := 0;
  loadnext;
  steuerung;
  menu;
  case mnu of
    '1' : spiel;
    '2' : anleitung;
    '3' : ende;
  end;
  textmode(modepuffer);
end;                    {---End Procedure spiel---}

procedure Bildeditor;
begin

                           clrscr;
                           grundstruktur;
                           gotoxy(8,05);write('(1) Frank und Manu');
                           gotoxy(8,06);write('(2) Frank');
                           gotoxy(8,07);write('(3) Christina');
                           gotoxy(8,08);write('(4) Eisberg');

                           gotoxy(8,10);write('(5) Hauptmen');
                           gotoxy(8,12);write('INFO:');
                           gotoxy(8,13);write('Durch Drcken von');
                           gotoxy(8,14);write('EINGABE nach dem ge-');
                           gotoxy(8,15);write('w„hlten Bild kehren');
                           gotoxy(8,16);write('Sie hierher zurck.');

                           repeat
                           bildnr:=readkey;
                           until (bildnr='1') or (bildnr='2') or (bildnr='3') or (bildnr='4') or (bildnr='5');


                 case bildnr of '1' :  begin
                      clrscr;
                      grundstruktur;
                      bildpfad:='C:\01\pcx\20.pcx';
                                      end;

                               '2' :  begin
                      clrscr;
                      grundstruktur;
                      bildpfad:='C:\01\pcx\21.pcx';
                                      end;


                               '3' :  begin
                      clrscr;
                      grundstruktur;
                      bildpfad:='C:\01\pcx\22.pcx';
                                      end;

                               '4' :  begin
                      clrscr;
                      grundstruktur;
                      bildpfad:='C:\01\pcx\13.pcx';
                                      end;

                               '5' :  begin ant:='z'; end;
                                  end;


end;


Procedure PutPixel(X : Word; y,c:byte);
Assembler;
Asm
  mov ax,0A000h;
  mov es,ax;
  mov al,y;
  xor ah,ah;
  shl ax,6;
  add ah,y;
  add ax,x;
  mov bx,ax;
  mov al,c;
  mov [es:bx],al;
End;


Procedure ShowScr(Pic:ScrArrPtr);
var ww : Word;
Begin
  For ww:=0 to width*depth do
    PutPixel(ww mod width ,ww div width,pic^[ww]);
End;


procedure Read_PCX_Line(vidoffset: word);
var c, run: byte;
    n: integer;
    w: word;
begin
  n:=0;
  while (n < bytes) do
  begin
    blockread (f, c, 1);
    if ((c and 192)=192) then
    begin
      run:=c and 63;
      blockread(f, c, 1);
      n:=n+run;
      for w:=0 to run-1 do
      begin
        scr^[vidoffset]:=c;
        inc(vidoffset);
      end;
    end
    else
    begin
      n:=n+1;
      scr^[vidoffset]:=c;
      inc (vidoffset);
    end;
  end;
end;

procedure SetPal;
var i: integer;
begin
  for i:=0 to 767 do palette[i]:=palette[i] shr 2;
  asm
    mov ax,1012h
    xor bx,bx
    mov cx,256
    mov dx,offset palette
    int 10h
  end;
end;

Procedure PcXview(S : String);
var i:word;
Begin
  assign (f, s);
  reset (f,1);
  blockread (f, header, sizeof (header));
  if (header.manufacturer=10) and (header.version=5) and
     (header.bits_per_pixel=8) and (header.colour_planes=1) then
  begin
    seek(f, filesize(f)-769);
    blockread (f, c, 1);
    if (c=12) then
    begin
      blockread (f, palette, 768);
      seek (f, 128);
      width:=header.xmax-header.xmin+1;
      depth:=header.ymax-header.ymin+1;
      bytes:=header.bytes_per_line;
      SetPal;
      for i:=0 to depth-1 do Read_PCX_Line (i*width);
    end;
  close (f);
  end;
End;

procedure rechne(fop1,fop2:real;frz:char;var erg:real);

         begin

         if (frz='+') or (frz='-') or (frz='*') or (frz='/') then
            begin
            case frz of
                 '+': erg:=fop1+fop2;
                 '-': erg:=fop1-fop2;
                 '*': erg:=fop1*fop2;
                 '/':    begin
                         if fop2=0 then writeln('Division durch Null ist nicht erlaubt!')
                         else erg:=fop1/fop2;
                         end
            else
            writeln('FALSCHES RECHENZEICHEN');
            end;
            gotoxy(08,10);writeln('Ergebnis:',erg:10:2);
            end; end;

procedure verzeichnis;

var name : array [1..50] of string;
    nummer : array [1..50] of string;
    u : longint;
    ant,i,j : char;
begin
     gotoxy(8,05);write('Was m”chten Sie tun?');
     gotoxy(8,07);write('(1) Name und Nummer');
     gotoxy(8,08);write('    speichern');
     gotoxy(8,10);write('(2) Name und Nummer');
     gotoxy(8,11);write('    abfragen');
     gotoxy(8,14);write('(3) Hauptmen');
      repeat
      i := readkey;
      until (i='1') or (i='2') or (i='3');


case i of '1' :  begin

                 u := 1;
                 repeat
                 clrscr;
                 grundstruktur;
                 gotoxy(8,5);write('Name: ');
                 readln(name[u]);
                 gotoxy(8,7);write('Nummer: +49');
                 readln(nummer[u]);
                 u := u + 1;
                 gotoxy(8,17);write('Noch einmal? j/n');
                  repeat
                  ant := readkey;
                  until (ant='j') or (ant='n');
                 until ant = 'n';
                 clrscr;
                 end;

          '2' : begin
                u := 1;
                repeat
                clrscr;
                grundstruktur;
                gotoxy(8,5);writeln(u,name[u]);
                gotoxy(8,10);writeln('Weiter? j/n');
                 repeat
                 j := readkey;
                 until (j='j') or (j='n');
                case j of 'j' : begin
                                u := u+1;
                                end;
                          'n' : begin
                                gotoxy(8,10);write(name[u]);
                                gotoxy(8,12);write('+49',nummer[u]);
                                end;
                end;
                gotoxy(8,16);write('Noch eine Nummer? j/n');
                 repeat
                 ant := readkey;
                 until (ant='j') or (ant='n');
                until ant = 'n';  end;


           '3' :  begin ant:='z'; end;
end;
end;

procedure einstellung;
var ant : char;
begin
gotoxy(8,6);writeln('Schriftfarbe:');
gotoxy(8,8);writeln('(R)ot');
gotoxy(8,9);writeln('(B)lau');
gotoxy(8,10);writeln('(G)rn');
gotoxy(8,11);writeln('G(e)lb');
gotoxy(8,12);writeln('(L)ila');
gotoxy(8,13);writeln('(W)eiss');
gotoxy(8,15);writeln('(H)auptmen');
 repeat
 ant := readkey;
 until (ant='r') or (ant='b') or (ant='g') or (ant='e') or (ant='l') or (ant='w') or (ant='h');
       case ant of 'r' : begin textcolor(red);end;
                   'b' : begin textcolor(blue);end;
                   'g' : begin textcolor(green);end;
                   'e' : begin textcolor(yellow);end;
                   'l' : begin textcolor(magenta);end;
                   'w' : begin textcolor(white);end;
                   'h' : begin einst:='z';end;
       end;

end;

procedure Musik;
var d,h:integer;
    titel: char;
begin
                 clrscr;
                 grundstruktur;
                 gotoxy(8,05);write('(1) Axle F.2003');
                 gotoxy(8,06);write('(2) M„dchen');
                 gotoxy(8,07);write('(3) Mamor Stein');
                 gotoxy(8,08);write('(4) Bomerlunder');
                 gotoxy(8,10);write('(5) Hauptmen');
                  repeat
                  titel:=readkey;
                  until (titel='1') or (titel='2') or (titel='3') or (titel='4') or (titel='5');

case titel of '1' :  begin
                 clrscr;
                 grundstruktur;
                 d:=2;
                 {axel F.2003}
                 gotoxy(8,5);write('Axle F.2003');
                 for h:=1 downto 1 do begin
          Delay(25);Sound(396);Delay(100*d);nosound;delay(100*d);
          Sound(467);Delay(50*d);nosound;delay(100*d);
          Sound(396);Delay(50*d);nosound;delay(50*d);
          Sound(396);Delay(50*d);nosound;
          Sound(528);Delay(100*d);nosound;
          Sound(396);Delay(100*d);nosound;
          Sound(352);Delay(100*d);nosound;
          Sound(396);Delay(100*d);nosound;delay(100*d);
          Sound(594);Delay(50*d);nosound;delay(100*d);
          Sound(396);Delay(50*d);nosound;delay(50*d);
          Sound(396);Delay(50*d);nosound;
          Sound(627);Delay(100*d);nosound;
          Sound(594);Delay(100*d);nosound;
          Sound(467);Delay(100*d);nosound;
          Sound(396);Delay(100*d);nosound;
          Sound(594);Delay(100*d);nosound;
          Sound(792);Delay(100*d);nosound;
          Sound(396);Delay(50*d);nosound;
          Sound(352);Delay(50*d);nosound;delay(50*d);
          Sound(352);Delay(50*d);nosound;
          Sound(297);Delay(100*d);nosound;
          Sound(467);Delay(100*d);nosound;
          Sound(396);Delay(400*d);nosound;delay(200*d);
           Sound(704);Delay(50*d);nosound;
           Sound(594);Delay(100*d);nosound;
           Sound(528);Delay(100*d);nosound;
           Sound(467);Delay(100*d);nosound;
          end; end;{for-schleife}

          '2' :  begin
                 clrscr;
                 grundstruktur;
                 d:=2;
                 gotoxy(8,5);write('M„dchen');
                    {M„dchen}
                      for h:=1 downto 1 do begin
                       Sound(495);Delay(50*d);nosound;
                       Sound(495);Delay(50*d);nosound;
                       Sound(528);Delay(50*d);nosound;
                       Sound(594);Delay(100*d);nosound;
                       Sound(792);Delay(100*d);nosound;
                       Sound(396);Delay(50*d);nosound;
                       Sound(396);Delay(50*d);nosound;
                       Sound(396);Delay(50*d);nosound;
                       Sound(396);Delay(50*d);nosound;
                       Sound(396);Delay(100*d);nosound;
                       Sound(396);Delay(100*d);nosound;
                       Sound(297);Delay(50*d);nosound;
                       Sound(297);Delay(50*d);nosound;
                       Sound(297);Delay(50*d);nosound;
                       Sound(297);Delay(50*d);nosound;
                       Sound(297);Delay(100*d);nosound;
                       Sound(352);Delay(100*d);nosound;
                       Sound(352);Delay(50*d);nosound;
                       Sound(352);Delay(50*d);nosound;
                       Sound(352);Delay(50*d);nosound;
                       Sound(352);Delay(50*d);nosound;
                       Sound(396);Delay(100*d);nosound;
                       Sound(396);Delay(100*d);nosound;
                       Sound(396);Delay(100*d);nosound;
                       Sound(495);Delay(50*d);nosound;
                       Sound(528);Delay(50*d);nosound;
                       Sound(594);Delay(50*d);nosound;
                       Sound(594);Delay(50*d);nosound;
                       Sound(594);Delay(50*d);nosound;
                       Sound(792);Delay(50*d);nosound;
                       Sound(396);Delay(50*d);nosound;
                       Sound(396);Delay(50*d);nosound;
                       Sound(396);Delay(50*d);nosound;
                       Sound(396);Delay(50*d);nosound;
                       Sound(396);Delay(50*d);nosound;
                       Sound(396);Delay(50*d);nosound;
                       Sound(396);Delay(50*d);nosound;
                       Sound(396);Delay(50*d);nosound;
                       Sound(297);Delay(50*d);nosound;
                       Sound(495);Delay(50*d);nosound;
                       Sound(495);Delay(50*d);nosound;
                       Sound(528);Delay(50*d);nosound;
                       Sound(594);Delay(50*d);nosound;
                       Sound(528);Delay(50*d);nosound;
                       Sound(495);Delay(50*d);nosound;
                       Sound(440);Delay(50*d);nosound;
                       Sound(396);Delay(100*d);nosound;
                       Sound(352);Delay(100*d);nosound;
                       Sound(396);Delay(200*d);nosound;
 end;  end;

 '3' :  begin
                 clrscr;
                 grundstruktur;
                 d:=1;
                 gotoxy(8,5);write('Mamor Stein');
            {Mamor}
for h:=1 downto 1 do begin
 Sound(748);Delay(400*d);nosound;
 Sound(748);Delay(400*d);nosound;
 Sound(748);Delay(400*d);nosound;
 Sound(748);Delay(400*d);nosound;
 Sound(660);Delay(400*d);nosound;
 Sound(594);Delay(400*d);nosound;
 Sound(495);Delay(200*d);nosound;
 Sound(440);Delay(200*d);nosound;
 Sound(396);Delay(400*d);nosound;
 Delay(200*d);
 Sound(528);Delay(600*d);nosound;
 Sound(440);Delay(200*d);nosound;
 Sound(495);Delay(400*d);nosound;
 Sound(561);Delay(600*d);nosound;
 Delay(200*d);
 Sound(594);Delay(400*d);nosound;
 Sound(594);Delay(200*d);nosound;
 Sound(495);Delay(200*d);nosound;
 Sound(440);Delay(600*d);nosound;
 Sound(748);Delay(400*d);nosound;
 Sound(748);Delay(400*d);nosound;
 Sound(748);Delay(200*d);nosound;
 Sound(748);Delay(200*d);nosound;
 Sound(748);Delay(200*d);nosound;
 Sound(748);Delay(200*d);nosound;
 Delay(200*d);
 Sound(660);Delay(400*d);nosound;
 Sound(594);Delay(200*d);nosound;
 Sound(495);Delay(200*d);nosound;
 Sound(440);Delay(200*d);nosound;
 Sound(396);Delay(400*d);nosound;
 Sound(561);Delay(200*d);nosound;
 Sound(440);Delay(600*d);nosound;
 Sound(495);Delay(200*d);nosound;
 Sound(561);Delay(600*d);nosound;
 Sound(594);Delay(1000*d);nosound;
  end;end;

 '4' :  begin
                 clrscr;
                 grundstruktur;
                 d:=1;
                 gotoxy(8,5);write('(4) Bomerlunder');
            {bomerlunder}
for h:=1 downto 1 do begin
 {HT}
 Sound(468);Delay(600*d);nosound;
 Sound(468);Delay(200*d);nosound;
 Sound(396);Delay(200*d);nosound;
 Sound(396);Delay(200*d);nosound;
 Sound(352);Delay(200*d);nosound;
 Sound(297);Delay(300*d);nosound;
 Sound(297);Delay(100*d);nosound;
 Sound(297);Delay(200*d);nosound;
 Sound(297);Delay(600*d);nosound;
 Sound(468);Delay(600*d);nosound;
 Sound(468);Delay(200*d);nosound;
 Sound(396);Delay(200*d);nosound;
 Sound(396);Delay(200*d);nosound;
 Sound(352);Delay(200*d);nosound;
 Sound(352);Delay(200*d);nosound;
 Sound(440);Delay(800*d);nosound;
 Sound(440);Delay(800*d);nosound;
 Sound(528);Delay(600*d);nosound;
 Sound(528);Delay(200*d);nosound;
 Sound(468);Delay(200*d);nosound;
 Sound(468);Delay(200*d);nosound;
 Sound(396);Delay(200*d);nosound;
 Sound(396);Delay(200*d);nosound;
 Sound(440);Delay(300*d);nosound;
 Sound(440);Delay(100*d);nosound;
 Sound(440);Delay(400*d);nosound;
 Sound(440);Delay(200*d);nosound;
 Sound(440);Delay(200*d);nosound;
 Sound(440);Delay(200*d);nosound;
 Sound(396);Delay(200*d);nosound;
 Sound(352);Delay(600*d);nosound;
 Sound(396);Delay(200*d);nosound;
 {a}
 Sound(352);Delay(200*d);nosound;
 Sound(396);Delay(200*d);nosound;
 Sound(314);Delay(200*d);nosound;
 Sound(352);Delay(200*d);nosound;
 Sound(297);Delay(600*d);nosound;
 {HT}
 Sound(468);Delay(600*d);nosound;
 Sound(468);Delay(200*d);nosound;
 Sound(396);Delay(200*d);nosound;
 Sound(396);Delay(200*d);nosound;
 Sound(352);Delay(200*d);nosound;
 Sound(297);Delay(300*d);nosound;
 Sound(297);Delay(100*d);nosound;
 Sound(297);Delay(200*d);nosound;
 Sound(297);Delay(600*d);nosound;
 Sound(468);Delay(600*d);nosound;
 Sound(468);Delay(200*d);nosound;
 Sound(396);Delay(200*d);nosound;
 Sound(396);Delay(200*d);nosound;
 Sound(352);Delay(200*d);nosound;
 Sound(352);Delay(200*d);nosound;
 Sound(440);Delay(800*d);nosound;
 Sound(440);Delay(800*d);nosound;
 Sound(528);Delay(600*d);nosound;
 Sound(528);Delay(200*d);nosound;
 Sound(468);Delay(200*d);nosound;
 Sound(468);Delay(200*d);nosound;
 Sound(396);Delay(200*d);nosound;
 Sound(396);Delay(200*d);nosound;
 Sound(440);Delay(300*d);nosound;
 Sound(440);Delay(100*d);nosound;
 Sound(440);Delay(400*d);nosound;
 Sound(440);Delay(200*d);nosound;
 Sound(440);Delay(200*d);nosound;
 Sound(440);Delay(200*d);nosound;
 Sound(396);Delay(200*d);nosound;
 Sound(352);Delay(600*d);nosound;
 Sound(396);Delay(200*d);nosound;
 {b}
 Sound(352);Delay(200*d);nosound;
 Sound(396);Delay(200*d);nosound;
 Sound(440);Delay(200*d);nosound;
 Sound(528);Delay(200*d);nosound;
 Sound(468);Delay(600*d);nosound;
 end; end;

 '5' :  begin ant:='z';
 end;
end;
end; {procedure}

procedure uhr;

var h,m,s,hs,st,t,mo,j,ta,mon,ja,wt : word;



    begin
    gotoxy(8,8);writeln('(U)hr anzeigen');
    gotoxy(8,10);writeln('(O)rganizer');
    ant := readkey;
    case ant of 'u' : begin
                      clrscr;
                      grundstruktur;
                      gettime(h,m,s,hs);
                      gotoxy(8,8);writeln('Stunde: ',h);
                      gotoxy(8,10);writeln('Minute: ',m);
                      gotoxy(8,12);writeln('Sekunde: ',s);
                      end;
                'o' : begin
                      clrscr;
                      grundstruktur;
                      gotoxy(8,5);writeln('Erinnerung');
                      gotoxy(8,7);write('Stunde: ');
                      readln(st);
                      gotoxy(8,9);write('Tag: ');
                      readln(t);
                      gotoxy(8,11);write('Monat: ');
                      readln(mo);
                      gotoxy(8,13);write('Jahr: ');
                      readln(j);
                      getdate(ja,mon,ta,wt);
                      gettime(h,m,s,hs);
                      if (st = h) and (t = ta) and (mo = mon) and (j = ja) = true then begin
                                                                                       clrscr;
                                                                                       grundstruktur;
                                                                                       sound(440);
                                                                                       gotoxy(8,14);writeln('Erinnerung');
                                                                                       readln;
                                                                                       nosound;
                                                                                       end;

    end;
end;
end;

procedure mitteilung;
var i,u : longint;
    mit : array [1..50] of string;
    ant : char;
begin
repeat
clrscr;
writeln('Mitteilungsbildschirm');
writeln;
writeln('Leertaste = ENTER');
writeln('Text versenden = 2x ENTER');
writeln;
writeln('Text eingeben:');
writeln;
readln(mit[i]);
i := i+1;
until mit[i-1] = '';
i := 1;
{leider war es mir nicht m”glich einen
textanschauungsmodus zu programmieren
wer ideen hat kann sich ja melden oder
versuchen das programm zu vervollst„ndigen}
u:=1;
repeat
                clrscr;
                grundstruktur;
                gotoxy(8,5);writeln(u,name[u]);
                gotoxy(8,10);writeln('(W)eiter?');
                gotoxy(8,12);writeln('N(u)mmer anzeigen');
                j := readkey;
                case j of 'w' : begin
                                u := u+1;
                                end;
                          'u' : begin
                                clrscr;
                                grundstruktur;
                                gotoxy(8,10);write(name[u]);
                                gotoxy(8,12);write(nummer[u]);
                                readln;
                                end;
                                end;
                                clrscr;
                                grundstruktur;
                                gotoxy(8,14);write('Noch eine Nummer? j/n');
                                ant := readkey;
                                until ant = 'n';
end;

begin {vom HP}
repeat {vom gesamten Programm}
sprung:
clrscr;
grundstruktur;
ant:='0';
      {z ,sp}
gotoxy(08,05);write('     Men    ');
gotoxy(08,06);write('1 Verzeichnis');
gotoxy(08,07);write('2 Mitteilungen');
gotoxy(08,08);write('3 T”ne');
gotoxy(08,09);write('4 Einstellungen');
gotoxy(08,10);write('5 Spiele');
gotoxy(08,11);write('6 Taschenrechner');
gotoxy(08,12);write('7 Uhr/Organizer');
gotoxy(08,13);write('8 Bildeditor');
gotoxy(08,14);write('9 Ausschalten');
gotoxy(08,16);write('H Hilfe');

gotoxy(08,15);
repeat
vormenue:=readkey;
until (vormenue='1')
   or (vormenue='2')
   or (vormenue='3')
   or (vormenue='4')
   or (vormenue='5')
   or (vormenue='6')
   or (vormenue='7')
   or (vormenue='8')
   or (vormenue='9')
   or (vormenue='h');

case vormenue of '1':begin
                          clrscr;
                          grundstruktur;
                          verzeichnis;
                          if ant = 'z' then goto sprung;

                     end;

                  '2':begin
                          clrscr;
                          grundstruktur;
                          mitteilung;
                          clrscr;
                          grundstruktur;
                          gotoxy(8,14);write('(Z)urck');
                          ant := readkey;
                          if ant = 'z' then goto sprung;
                          end;
                  '3':begin
                          repeat
                          clrscr;
                          grundstruktur;
                          Musik;
                          if ant = 'z' then goto sprung
                          until ant='z';
                        end;
                  '4':begin
                           einst:='0';
                           repeat
                           clrscr;
                           grundstruktur;
                           einstellung;

                           if einst = 'z' then goto sprung;
                           until ant='z';
                           end;
                  '5':begin
                           clrscr;
                           grundstruktur;
                           modepuffer := lastmode;
                           menu;
                           repeat
                           case mnu of
                                       '1' : spiel;
                                       '2' : anleitung;
                                       '3' : ende;
                                       end;
                           until (mnu='3') or (ord(taste)=27);
                           goto sprung;
                           end;
                  '6':begin
                           clrscr;
                           repeat
                           grundstruktur;
                           gotoxy(08,06); write('erste Zahl: ');

                           readln(fop1);
                           gotoxy(08,07);write('Rechenzeichen: ');
                           readln(frz);
                           gotoxy(08,08);write('zweite Zahl:');
                           readln(fop2);
                           rechne(fop1,fop2,frz,erg);
                           gotoxy(08,12);write('noch eine Rechnung? j/n');
                           gotoxy(08,13);ant := readkey;
                           until ant = 'n';
                           writeln('(z)urck');
                           ant := readkey;

                           if ant = 'z' then goto sprung;
                           end;

                  '7':begin
                           clrscr;
                           grundstruktur;
                           uhr;
                           gotoxy(8,17);writeln('(z)urck');
                           ant := readkey;
                           if ant = 'z' then goto sprung;
                           end;

                  '8':begin
                             repeat
                             clrscr;
                             grundstruktur;
                             Bildeditor;
                             If (bildnr='1')
                             or (bildnr='2')
                             or (bildnr='3')
                             or (bildnr='4')      then begin
                                 asm
                                 mov ax,13h;
                                 int 10h;
                                 end;
                                 New(scr);
                                 PcxView(bildpfad);
                                 ShowScr(scr);
                                 Dispose(scr);
                                 asm
                                 xor ax,ax
                                 int 16h
                                 mov ax,03h;
                                 int 10h;
                                 end;              end;

                          if ant = 'z' then goto sprung;
                          until ant='z';
                                 end;

                 '9':begin
                           clrscr;
                           grundstruktur;
                           ant:='b';
                      end;

                 'h':begin
  clrscr;
  grundstruktur;
  gotoxy(08,05); write('Hilfe:');
  gotoxy(08,07); write('Sie mssen die Zahl, die');
  gotoxy(08,08); write('vor dem Meneintrag');
  gotoxy(08,09); write('steht, eingeben, um in');
  gotoxy(08,10); write('ein Untermen zu ge- ');
  gotoxy(08,11); write('langen. ');
  gotoxy(08,14); write('Hauptmen... -> EINGABE');
  readkey;
                     end;end;

until ant='b';
end.  {vom HP}

Cookies erleichtern die Bereitstellung unserer Dienste. Mit der Nutzung unserer Dienste erklären Sie sich damit einverstanden, dass wir Cookies verwenden.