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}

Wir nutzen Cookies auf unserer Website. Einige von ihnen sind essenziell für den Betrieb der Seite, während andere uns helfen, diese Website und die Nutzererfahrung zu verbessern (Tracking Cookies). Sie können selbst entscheiden, ob Sie die Cookies zulassen möchten. Bitte beachten Sie, dass bei einer Ablehnung womöglich nicht mehr alle Funktionalitäten der Seite zur Verfügung stehen.