pascal für dos...*kotz

<felicia> ich brauch ein geiles pascal program
<felicia> am besten irgendein spiel
<felicia> schach, oder mühle
<felicia> oder son raumschiffspiel
<martin> wofür ? *g+
<felicia> irgendetwas
<felicia> fürn unterricht
<felicia> wir haben nächstens hj proekt
<martin> sollst du was programmieren ?
<felicia> und da ich unfähig bin sowas selbst zu schreiben
<felicia> brauch ichs halt irgendwo her
<martin> sowas stinkt auch
<martin> pascal..
<felicia> für dos
<martin> die sprache der zukunft *g+
<martin> dos is tot..
<martin> das is sinnlos sowas zu programmieren
<martin> aber die meisten lehrer kennen nix anderes
<felicia> is ja egal
<felicia> ich brauch trotzdem ein prog
<felicia> im inet gibts nur müll
<felicia> das kann ich alles auch selber schreiben was es da gibt bzw hab ich schon geschrieben
<martin> frag doch mal im coderforum, vielleicht hat jemand sowas mal gemacht

was ich damit sagen will, ich bin ne null in pascal meine zeugnissnote sagt das auch. ich bin absolut NICHt in der lage so ein prog zu schreiben. wenn also jmd eins zuhause hat, oder weiß wo ich ein schönes herkrieg ( über google hab ichs probiert, dei man dort findet haben wir im unterriocht gemacht) sagts mir doch bitte . es soll halt a bissel aufwendig sein damit es aussieht als ob ich 7 wochen intensiv dran gearbeitet hab

das ich so ein prog hab ist leider recht wichtig für meine zeugnisnote

udn damit für mein abi

danke im vorraus

Mehr habsch auch net geshen. Aber vielleicht ist da ja was bei...
http://www-user.tu-chemnitz.de/~chu/pascal.html

http://www.gambitsoft.com/share.htm

Ich glaub ich hab hier irgendwo sogar ein Vier-gewinnt Spiel in Pascal rumliegen (natürlich mit Source) ... wenn dich das interessiert

das wär schon mal ein anfang

Und wie solls ich dir das geben?

ka, von mir aus kopier den text in ne pm, oder hierher

dank dir schon mal im vorraus

so far

Oh ich habe eine Vision ~~~ich sehe eine neue sendemöglichkeit die e-mail heisst~~~*ohmm*

löl , jo mailen kannstes auch

{ ************************************************** ************************
* Turbo-PASCAL - Pr�fungsaufgabe WS *
* *************************************** *
* **********"VIER GEWINNT" V1.0********** *
* *************************************** *
* * Autor: mrpenne@hotmail.com * *
* * Sprache: Borland Turbo-Pascal 7.0 * *
************************************************** ************************}


Program Vier_gewinnt;


uses crt;

const spalten = 7; zeilen = 6; { 5..9 / 5..11 Begrenzung wegen Darstellung }
{ Spielfeldgr”áe, �blich: 7 Spalten, 6 Zeilen}
warten = 30; { f�r Fallgeschwindigkeit der Steine }
mensch = yellow; compu = red; { Farben der Spielsteine }
reihen = spalten + zeilen + 2 * ( (zeilen - 3) + (spalten - 4) );
{ Anzahl der Reihen, in denen vier oder mehr Felder hinterein-
ander liegen k”nnen (horizontal, vertikal, diagonal) }

type str11 = string[11]; { Eine Reihe kann maximal 11 Felder lang sein }

var feld: array [0..(spalten + 1), 0..(zeilen + 1)] of shortint; { Spielfeld }
dx, dy, xpos: integer; { dx, dy: SpielsteingrӇe }
eingabe, sieger: integer;
aktiv, merken: integer; { aktiv: Wer ist gerade dran? }
alles_voll, sieg, simuliert: boolean; { s. sp„ter...}
beenden, gegen_compu: boolean; { wie der Name sagt }
gesperrt: array [1..spalten] of boolean; { "blockierte" Spalten}
daten: array [1..reihen] of str11; { s. sp„ter...}
b1, b2, b3, b4, b5, b6: integer; { s. sp„ter...}
falle: record { Beschreibungen m”glicher }
bild: array[1..7] of string[5]; { Fallen }
offset: array[1..7] of integer;
end;


{************************************************* **************************
* Procedure: Initialisieren *
* Hier werden alle Variablen mit definierten Startwerten *
* versehen und die Frage, ob gegen Computer oder gegen einen *
* Mitspieler gespielt werden soll, gekl„rt. *
* ver„ndert: dx, dy, aktiv, gesperrt [ ], feld [ , ], simuliert, *
* b1 .. b6, falle [ ] *
************************************************** *************************}
Procedure initialisieren;

var i, j: integer;

begin
aktiv:= mensch; { Mensch f„ngt an }
simuliert:= false; { s. Vorkommen }
sieger:= 0; beenden:= false;
textbackground (black); textcolor (white);

ClrScr;
writeln;
writeln (' 4 gewinnt V1.0');
writeln;
writeln (' (c) by Penne');
writeln;
writeln (' Penne@h-d-c.org');
writeln;
writeln (' ... der HDC w�nscht allen ein gOOd ZoCkinG!');
writeln;
writeln;
writeln;
writeln (' Sie k”nnen entweder gegen einen menschlichen Partner spielen');
writeln (' oder versuchen, mich zu besiegen.');
write (' Wollen Sie es mit mir aufnehmen? (j/n) ');
if upcase (readkey) = 'J' then gegen_compu:= true else gegen_compu:= false;
dx:= 78 div spalten - 1; { Breite eines Spielsteins }
dy:= 23 div zeilen - 1; { H”he eines Spielsteins }
for i:= 1 to spalten do begin
for j:= 1 to zeilen do feld [i, j]:= 0; { Spielfeld ist noch leer }
end;

for i:= 0 to spalten + 1 do begin { Rand um das Spielfeld herum wird }
feld [i, zeilen + 1]:= -1; { mit -1 markiert }
feld [i, 0]:= -1; { hier: obere und untere Zeile }
end;
for j:= 1 to zeilen do begin
feld [0, j]:= -1; { linke und }
feld [spalten + 1, j]:= -1; { rechte Spalte }
end;

b1:= spalten; { alle Reihen, in den vertikal vier m”glich sind}
b2:= b1 + zeilen; { alle horizontalen Reihen }
b3:= b2 + zeilen - 3; { rot b? bezeichnet jeweils das Ende }
b4:= b3 + spalten - 4; { blau einer Gruppe von Reihen, die ins}
b5:= b4 + zeilen - 3; { gr�n Array daten[ ] gespeichert werden}
b6:= b5 + spalten - 4; { gelb (Farben siehe Dokumentation) }

falle.bild[1]:='-c-c-'; falle.offset[1]:= 2; { So k”nnen die Situationen}
falle.bild[2]:='-cc--'; falle.offset[2]:= 3; { aussehen, die durch Ein- }
falle.bild[3]:='--cc-'; falle.offset[3]:= 1; { werfen eines Spielsteines}
falle.bild[4]:='-c---'; falle.offset[4]:= 3; { dem Gegner keine Chance }
falle.bild[5]:='--c--'; falle.offset[5]:= 3; { lassen, den Sieg zu ver- }
falle.bild[6]:='---c-'; falle.offset[6]:= 1; { hindern. 'c': Spielstein }
falle.bild[7]:='-----'; falle.offset[7]:= 2; { '-': freies Feld}
{ falle.offset[ ] beschreibt die Position, die die Falle ausl”st
Bsp.: -c!c- offset = 2 --> 1 + 2 = Position 3 --> -ccc- }

end; { Procedure Initialisieren
************************************************** **************************}

{************************************************* **************************
* Procedure: Spielfeld_aufbauen *
* Das Spielfeld wird auf den Monitor gezeichnet *
* ver„ndert: Monitor *
************************************************** *************************}
procedure Spielfeld_aufbauen;

var x, y: integer;
i, j, k: integer;

begin
ClrScr;
x:= dx + 1; { eine Spalte ist ein Zeichen breiter als ein Spielstein}
y:= dy + 1; { und ein Zeichen h”her (wegen der Trennlinien)}
textcolor (blue);
for i:= 1 to spalten * x + 1 do write (#219); { die oberste Zeile }

textcolor (white); textbackground (blue); { Beschriftung der Spalten }
for k:= 1 to spalten do begin
gotoxy ((dx + 1) * k - dx div 2 , wherey); write (k);
end;
textcolor (blue); textbackground (black);
writeln;

for j:= 1 to y * zeilen do begin { y: H”he einer Zeile (Stein + Linie)}
if j mod y = 0 then begin { Trennzeile --> ganz ausf�llen }
for i:= 1 to spalten * x + 1 do write (#219); writeln;
end
else begin
write (#219); { ganz links }
for i:= 1 to spalten do begin { Trennzeichen zwischen den einzelnen}
gotoxy (wherex + x - 1 , wherey); write (#219); { Spalten }
end;
writeln;
end; { j mod y }
end; { 1 to y * zeilen }
end; { Procedure Spielfeld_aufbauen
************************************************** **************************}

{************************************************* **************************
* Procedure: Zeile_anzeigen *
* eine einzelne Zeile eines Spielsteins wird gezeichnet *
* Cursorposition und Farbe werden vor Aufruf definiert. *
* ver„ndert: Monitor *
************************************************** *************************}
Procedure Zeile_anzeigen;

var i: integer;

begin
for i:= 1 to dx do write (#219); { ein Stein ist dx Zeichen breit }
end; { Procedure Zeile_anzeigen
************************************************** **************************}

{************************************************* **************************
* Procedure: Stein_taucht_auf *
* Der Stein erscheint in der obersten Zeile *
* ver„ndert: Monitor *
************************************************** *************************}
Procedure Stein_taucht_auf (Spalte: integer);

var i: integer;

begin
for i:= 1 to dy do begin { jede Zeile einzeln anzeigen }
gotoxy (xpos, wherey +1);
zeile_anzeigen;
delay (warten);
end;
end; { Procedure Stein_taucht_auf
************************************************** **************************}

{************************************************* **************************
* Procedure: Stein_faellt_durch *
* Die Bewegung von der obersten Zeile bis zur Zielposition *
* wird dargestellt *
* ver„ndert: Monitor *
************************************************** *************************}
Procedure Stein_faellt_durch (spalte: integer);

var tiefe: integer;
i, j: integer;

begin
tiefe:= -1; { wg. Startposition in oberster Zeile; auáerdem muá er �ber
dem n„chsten Stein liegenbleiben, deshalb: = -1 }

for i:= 1 to zeilen do if feld [spalte, i] = 0 then inc (tiefe);
{ Wie viele Felder muá der Stein runterfallen? }

gotoxy (xpos, wherey + 1); { xpos ist vorher ausgerechnet worden }
for i:= 1 to tiefe do begin { tiefe Zeilen runterfallen }
for j:= 1 to dy do begin
gotoxy (xpos, wherey + 1); { in oberste Reihe der n„chsten Zeile }
textcolor (aktiv); { Farbe des aktiven Spielers }
zeile_anzeigen; { eine einzelne Zeile darstellen }

textcolor (black);
gotoxy (xpos, wherey - dy - 1); { Cursor oben auf altem Stein }
zeile_anzeigen; { oberstes St�ck des alten Steins entfernen}
gotoxy (xpos, wherey + dy + 1); { und Cursor wieder zur�ck }
delay (warten); { sonst sieht man von dem Effekt nichts }
end;
gotoxy (xpos, wherey + 1); { blaue Trennzeile �berspringen }
end; { 1 to tiefe }
end; { Procedure Stein_faellt_durch
************************************************** **************************}

{************************************************* **************************
* Function: frei *
* Sucht in der angegebenen Spalte nach dem untersten Feld, in *
* dem sich noch kein Stein befindet. *
* ver„ndert: frei *
************************************************** *************************}
function frei (spalte: integer): integer;

var j: integer;

begin
frei:= 0; { zun„chst annehmen, daá die Spalte voll ist }
for j:= 1 to zeilen do
if feld [spalte, j] = 0 then frei:= j; { freies Feld gefunden }
end; { Function frei
************************************************** **************************}

{************************************************* **************************
* Procedure: Stein_einwerfen *
* Die Darstellung des fallenden Steins wird organisiert *
* ver„ndert: Monitor *
************************************************** *************************}
Procedure Stein_einwerfen (spalte: integer);

var i, j: integer;

begin
xpos:= (spalte - 1) * (dx + 1) + 2; { Cursorpositon f�r Stein ausrechnen}
textcolor (aktiv); { Farbe des Spielers einstellen}
gotoxy (xpos, 1);
stein_taucht_auf (spalte);
stein_faellt_durch (spalte);
end; { Procedure Stein_einwerfen
************************************************** **************************}

{************************************************* **************************
* Function: naechstes_feld *
* Gibt den Inhalt und die Koordinaten des n„chsten Feldes *
* in anzugebender Richtung zur�ck. *
* ver„ndert: naechstes_feld, x, y *
************************************************** *************************}
function naechstes_feld (var x, y: integer; richtung: char): integer;
{ in x, y wird das Ausgangsfeld �bergeben }
begin
if richtung = 'o' then begin { diagonal nach rechts oben }
naechstes_feld:= feld [x + 1, y - 1];
inc (x); dec (y);
end;
if richtung = 'u' then begin { diagonal nach rechts unten }
naechstes_feld:= feld [x + 1, y + 1];
inc (x); inc (y)
end;
if richtung = 'h' then begin { horizontal nach rechts }
naechstes_feld:= feld [x + 1, y];
inc (x);
end;
if richtung = 'v' then begin { vertikal nach oben }
naechstes_feld:= feld [x, y - 1];
dec (y);
end;
end; { Function naechstes_feld
************************************************** **************************}

{************************************************* **************************
* Procedure: Siegreihe_markieren *
* Markiert die vier Steine im Spielfeld, die den Sieg bedeuten *
* ver„ndert: feld [ , ] *
************************************************** *************************}
Procedure Siegreihe_markieren (x, y: integer; richtung: char);
{x, y: das letzte Feld der Siegreihe }
var i: integer;

begin
case richtung of
'h': begin
for i:= 1 to 4 do begin { vier Steine markieren }
feld[x, y]:= - feld[x, y]; { markiert wird durch Negieren }
dec(x); { ein Feld horizontal nach links}
end;
end; { 'h' }
'v': begin
for i:= 1 to 4 do begin
feld[x, y]:= - feld[x, y];
inc (y); { vertikal nach unten }
end;
end; { 'v' }
'u': begin
for i:= 1 to 4 do begin
feld[x, y]:= - feld[x, y];
dec (x); dec (y); { diagonal nach links oben }
end;
end; { 'u' }
'o': begin
for i:= 1 to 4 do begin
feld[x, y]:= - feld[x, y];
dec (x); inc (y); { diagonal nach links oben }
end;
end; { 'o' }
end; { case richtung }
end; { Procedure Siegreihe_markieren
************************************************** **************************}

{************************************************* **************************
* Procedure: Reihe_testen *
* Ein Startfeld wird angegeben. Von diesem wird in Richtung *
* richtung gepr�ft, ob vier gleiche Steine hintereinander sind *
* ver„ndert: sieger *
************************************************** *************************}
Procedure reihe_testen (x, y: integer; richtung: char);

var i, j: integer;
v, n, z: integer;

begin
v:= feld [x, y]; { Inhalt des Startfeldes zum Vergleichen merken }
z:= 1; { z„hlt die Anzahl gleicher Steine hintereinander }
repeat
n:= naechstes_feld (x, y, richtung); { was steht im n„chsten Feld?}
if n = v then
inc (z) { falls identisch mit Vergleich, Anzahl erh”hen }
else begin
z:= 1; { falls nicht, mit dem Z„hlen wieder bei 1 anfangen }
v:= n; { und neuen Vergleichswert merken }
end;
if (z = 4) and (v <> 0) then begin sieger:= v; { wenn vier gefunden, }
{vier leere Felder k”nnen nicht gewinnen steht der Sieger fest.}
if not simuliert then siegreihe_markieren (x, y, richtung);
{ der Rechner simuliert das Einwerfen eines Steins, um Siegm”glichk.
zu finden. Dabei darf keine Siegreihe markiert werden. }
end; { if z = 4 }
until n = -1; { Der Rand des Spielfelds ist durch -1 markiert }
end; { Procedure reihe_testen
************************************************** **************************}

{************************************************* **************************
* Procedure: reihe_uebertragen *
* Hier werden die Spielsteine aus einer Reihe in Richtung *
* "richtung" in "reihe" �bertragen. "x, y" bezeichnet das Feld *
* direkt vor Beginn der Reihe. Dies dient der Suche nach einer *
* M”glichkeit, eine Falle aufzubauen. *
* ver„ndert: daten[ ] �ber var reihe *
************************************************** *************************}
procedure reihe_uebertragen (x, y: integer; richtung: char; var reihe: str11);

var n, z: integer;

begin
z:= 0;
repeat { Die Reihe Feld f�r Feld durchgehen und '�bersetzen' }
inc (z); { z bezeichnet die Position im String }
n:= naechstes_feld (x, y, richtung);
case n of
0: begin
if frei (x) = y then reihe[z]:= '-' { '-': freies Feld }
else reihe[z]:= '#'; { '#': nicht erreichbares Feld }
end; { 0:}
compu: reihe[z]:= 'c'; { 'c': Stein des Compus }
mensch: reihe[z]:= 'm'; { 'm': Stein des Spielers }
end; { case n }
until n = -1; { Der Rand um das Spielfeld ist mit -1 markiert }
end; { Procedure reihe_uebertragen
************************************************** **************************}

{************************************************* **************************
* Procedure: reihen_auslesen *
* Alle Reihen, in denen es m”glich ist, vier Steine in neben- *
* einander zu bekommen, werden in das Array daten[ ] �bertra- *
* gen, um eine einfachere Auswertung zu erm”glichen. Diese *
* Reihen k”nnen vertikal, horizontal oder diagonal liegen. *
* ver„ndert: daten[ ] *
************************************************** *************************}
Procedure reihen_auslesen;

var i, z: integer;

begin
for i:= 1 to reihen do daten[i]:= 'xxxxxxxxxxx'; { initialisieren }
z:= 0;

for i:= 1 to spalten do begin { die vertikalen Reihen }
inc (z);
reihe_uebertragen (i, zeilen + 1, 'v', daten[z]);
end;
for i:= 1 to zeilen do begin { die horizontalen }
inc (z);
reihe_uebertragen (0, i, 'h', daten[z]);
end;

for i:= 5 to zeilen + 1 do begin { rot (Farben s. Dokumentation }
inc (z);
reihe_uebertragen (0, i, 'o', daten[z]);
end;
for i:= 1 to spalten - 4 do begin { blau}
inc (z);
reihe_uebertragen (i, zeilen + 1, 'o', daten[z]);
end;

for i:= 2 to spalten - 3 do begin { gr�n }
inc (z);
reihe_uebertragen (i - 1, 0, 'u', daten[z]);
end;
for i:= 1 to zeilen - 3 do begin { gelb }
inc (z);
reihe_uebertragen (0, i - 1, 'u', daten[z]);
end;

end; { Procedure reihen_auslesen
************************************************** **************************}

{************************************************* **************************
* Procedure: Gewonnen *
* Organisiert die Suche nach einem Sieger, der vier Steine in *
* einer Reihe haben muá. Dazu werden die Reihen, die hori- *
* zontal, vertikal oder diagonal durch das Startfeld (in das *
* der letzte Stein geworfen wurde) laufen, �berpr�ft. Aus Ge- *
* schwindigkeitsgr�nden (vor allem bei gr”áeren Feldern) werden*
* nicht alle m”glichen Reihen getestet, sondern nur die, die *
* durch das Startfeld laufen. In anderen ist kein Sieg m”glich.*
* ver„ndert: sieger *
************************************************** *************************}
Procedure gewonnen (spalte, zeile: integer);
{spalte, zeile: Startfeld }
var x, y: integer;

begin
sieger:= 0;
reihe_testen (1, zeile, 'h'); { horizontal durch Startfeld }
reihe_testen (spalte, zeilen, 'v'); { vertikal durch Startfeld }

x:= spalte; y:= zeile;
repeat
dec (x); inc (y); { vom Startfeld nach links unten }
until (x < 1) or (y > zeilen); { bis zum Rand }
reihe_testen (x, y, 'o'); { von da aus testen diagonal nach rechts oben }

x:= spalte; y:= zeile;
repeat
dec (x); dec (y); { nach links oben }
until (x < 1) or (y < 1); { bis in den Rand }
reihe_testen (x, y, 'u'); { von da aus testen diagonal nach rechts unten }

end; { Procedure gewonnen
************************************************** **************************}

{************************************************* **************************
* Procedure: Spielstand_auswerten *
* Der eingeworfene Stein wird gespeichert, ein eventueller *
* Sieger ermittelt, festgestellt, ob noch Felder frei sind und *
* der Gegenspieler aktiviert *
* ver„ndert: feld [ , ], sieger, alles_voll, aktiv *
************************************************** *************************}
procedure spielstand_auswerten (spalte: integer);

var i, fmerk: integer;

begin
fmerk:= frei (spalte); { freies Feld f�r 'gewonnen' merken }
feld [spalte, fmerk]:= aktiv; { gerade eingeworfenen Stein speichern
aktiv entspricht der Farbe des Spielers, der gerade an der Reihe ist }

gewonnen (spalte, fmerk); { Hat einer gewonnen? (fmerk verwenden, da
{ frei ( ) ein anderes Feld liefert, wenn ein Stein eingeworfen wird }

alles_voll:= true; { davon ausgehen, daá alles voll ist. }
for i:= 1 to spalten do
if frei (i) <> 0 then alles_voll:= false; { noch Felder frei? }

if aktiv = mensch then aktiv:= compu else aktiv:= mensch; { n„chster dran}

end; { Procedure Spielstand_auswerten
************************************************** **************************}

{************************************************* **************************
* Function: Eingabe_ok *
* Eingabe des Spieler (spalte) wird �berpr�ft, ob in die ge- *
* w„hlte Spalte ein Stein geworfen werden darf *
* ver„ndert: eingabe_ok *
************************************************** *************************}
function eingabe_ok (spalte: integer): boolean;

begin
eingabe_ok:= true; { Davon ausgehen, daá es erlaubt ist }
if not (eingabe in [1..spalten]) then eingabe_ok:= false;{Spalte vorhanden?}
if feld [spalte, 1] <> 0 then eingabe_ok:= false; {oberstes Feld leer?}
end; { Function eingabe_ok
************************************************** **************************}


{************************************************* **************************
* Procedure: reihe_suchen *
* Durch Simulieren der n„chsten Z�ge versuchen, eine M”glich- *
* keit zu finden, vier Steine in eine Reihe zu bekommen. *
* ver„ndert: spalte *
************************************************** *************************}
Procedure reihe_suchen (var spalte: integer; tiefe: integer);

var i, merker, fmerk: integer;

begin
if (tiefe < 4) and (not sieg) then begin { Rekursionstiefe < 4, noch kein
Sieger gefunden }
for i:= 1 to spalten do begin { alle Spalten durchgehen }
fmerk:= frei (i);
if fmerk <> 0 then begin { in dieser Spalte ist noch Platz }
feld [i, fmerk]:= aktiv; { Einwurf simulieren }
gewonnen (i, fmerk); { m”glichen Sieger suchen }

if sieger = 0 then begin { keinen gefunden }
if aktiv = mensch then aktiv:= compu else aktiv:= mensch;
reihe_suchen (spalte, tiefe + 1); { n„chsten Zug simulieren }
end;
if sieger = compu then sieg:= true; { Gegner soll nicht gewinnen}

feld [i, fmerk]:= 0; { simulierten Stein wieder entfernen }
end; { if fmerk <> 0}

if (sieg = true) and not gesperrt [i] then begin { wenn der Compu
gewinnen kann und die Spalte nicht gesperrt ist, }
sieg:= false;
spalte:= i; { dann in diese Spalte einwerfen }
end;

end; { for i }
end; { Rekursionstiefe < 4 }

end; { Procedure reihe_suchen
************************************************** **************************}

{************************************************* **************************
* Procedure: Spalten_sperren *
* Wenn der Rechner in eine Spalte einen Stein werfen w�rde und *
* der Spieler dadurch gewinnen k”nnte, wird die Spalte ge- *
* sperrt, sodaá der Compu da halt keinen reinwirft *
* ver„ndert: gesperrt [ ] *
************************************************** *************************}
Procedure spalten_sperren;

var i, fmerk1, fmerk2, z: integer;

begin
z:= 0; { Anzahl gesperrter Spalten }
for i:= 1 to spalten do begin { alle Spalten durchgehen }
fmerk1:= frei (i); { merken, welches Feld frei ist }
if fmerk1 <> 0 then begin { = 0 bedeutet, daá keins mehr frei ist}
feld [i, fmerk1]:= compu; { Compu-Einwurf simulieren }

fmerk2:= frei (i);
if fmerk2 <> 0 then begin
feld [i, fmerk2]:= mensch; { Spieler-Einwurf simulieren }
gewonnen (i, fmerk2); { Testen, ob er damit gewinnen w�rde}
if sieger = mensch then begin{ wenn ja,}
gesperrt [i]:= true; { wird Spalte f�r Compu gesperrt }
inc (z);
end else gesperrt [i]:= false; { wenn nicht, ist die Spalte frei}
feld [i, fmerk2]:= 0; { Zug r�ckg„ngig machen }
end else {fmerk2 <> 0 } { wenn die Spalte mit dem Stein }
gesperrt [i]:= false; { des Compus voll ist, kann der }
feld [i, fmerk1]:= 0; { Spieler durch diesen Zug nicht}
end { if fmerk1 } { gewinnen }
else begin
gesperrt [i]:= true; { wenn kein Feld mehr frei ist, }
inc (z); { ist die Spalte auch gesperrt }
end;
end; { for i}
if z = spalten then { wenn alle Spalten gesperrt sind, muá der Rechner}
for i:= 1 to spalten do gesperrt [i]:= false; { halt irgendwo einwerfen}
end; { Procedure spalten_sperren
************************************************** **************************}

{************************************************* **************************
* Procedure: Falle_Suchen *
* Eine Falle besteht aus drei Steinen nebeneinander, wenn *
* jeweils rechts und links noch ein Feld frei ist, sodaá zwei *
* M”glichkeiten bestehen, zu gewinnen. Nat�rlich kann nur eine *
* im n„chsten Zug des Gegners zunichte gemacht werden. *
* ver„ndert: *
************************************************** *************************}
Procedure falle_suchen (var Spalte: integer; fuer_wen: integer);

var i, j, p, wie_weit: integer;

begin
if fuer_wen = compu then begin { f�r den Compu gestellte Fallen }
wie_weit:= 3; { nur fast fertige blockieren, keine potentiellen }
falle.bild[1]:= '-m-m-'; { Nur diese drei M”glichkeiten m�ssen un- }
falle.bild[2]:= '-mm--'; { bedingt blockiert werden, da nur noch }
falle.bild[3]:= '--mm-'; { ein einziger Stein fehlt }
end
else begin
wie_weit:= 7; { wenn irgendwie m”glich, Falle aufbauen }
falle.bild[1]:= '-c-c-'; { die letzten vier Fallen bleiben immer }
falle.bild[2]:= '-cc--'; { gleich (s. Initialisieren), nur diese }
falle.bild[3]:= '--cc-'; { drei m�ssen deshalb restauriert werden}
end;

for i:= b1 + 1 to reihen do begin { Beginn bei b1+1, da vertikal unm”glich}
p:= 0; { p ist die Position, an der eingeworfen werden muá }
for j:= 1 to wie_weit do begin
if p = 0 then begin { wenn noch keine Falle gefunden }
p:= pos (falle.bild[j], daten[i]); { wo ist die Falle? }
if p <> 0 then p:= p + falle.offset[j]; { richtige Einwurfposition}
end; { p = 0 { bestimmen }
end; { for j }

if p <> 0 then begin
if i <= b3 then spalte:= p; { Ausrechnen }
if (i > b3) and (i <= b4) then spalte:= p + (i - b3); { der }
if (i > b4) and (i <= b5) then spalte:= p + (i - b4); { richtigen }
if i > b5 then spalte:= p; { Spalte }
if gesperrt[spalte] then spalte:= 0; { nur einwerfen, wenn frei }
end; { if p <> 0 }
end; { 1 to reihen }
end; { Procedure falle_suchen
************************************************** **************************}

{************************************************* **************************
* Procedure: Spieler_eingabe *
* Der Spieler wird aufgefordert, seine Eingabe zu t„tigen *
* ver„ndert: spalte *
************************************************** *************************}
Procedure Spieler_eingabe(var spalte: integer);

var code: integer;
c: char;

begin

textcolor (aktiv);
repeat
gotoxy (2, 24); { Eingabe unten links }
write ('Sie sind am Zug! W„hlen Sie Ihre Spalte: ');
ClrEol;
c:= readkey; { kein readln verwendet, da durch mehrfaches [ENTER] das}
write (c); { Spielfeld vom Bildschirm verschwinden w�rde}
val (c, spalte, code); { in Zahl umwandeln }
until eingabe_ok (spalte); { wiederholen, bis g�ltige Eingabe }
end; { Procedure Spieler_eingabe
************************************************** **************************}

{************************************************* **************************
* Procedure: Compu_zug *
* Der Compu rechnet einen g�nstigen Zug aus *
* ver„ndert: spalte *
************************************************** *************************}
Procedure compu_zug (var spalte: integer);

var i, fmerk, einwerfen: integer;

begin
if gegen_compu then begin
merken:= aktiv; simuliert:= true; { ab hier werden Z�ge simuliert }
einwerfen:= 0;
for i:= 1 to spalten do begin
fmerk:= frei (i);
if fmerk <> 0 then begin { wenn Spalte frei }
feld [i, fmerk]:= mensch; { Spielereinwurf simulieren }
gewonnen (i, fmerk);
if (sieger = mensch) and (einwerfen = 0) then { wenn noch kein Zug}
einwerfen:= i; { gefunden, dann Spieler am Sieg hindern }
feld [i, fmerk]:= compu; { eigenen Zug simulieren }
gewonnen (i, fmerk);
if sieger = compu then einwerfen:= i; { selbst gewinnen (auch wenn}
feld [i, fmerk]:= 0; { schon anderen Zug gefunden. Sieg ist Sieg}
end;
end;

spalten_sperren;
reihen_auslesen;

if einwerfen = 0 then
falle_suchen (einwerfen, compu); { Falle, die dem Compu gestellt ist,
suchen und entsch„rfen }
if einwerfen = 0 then
falle_suchen (einwerfen, mensch); { dem Spieler eine Falle aufbauen }

if einwerfen = 0 then
reihe_suchen (einwerfen, 1); {s. Prozedur }

if einwerfen = 0 then begin { keinen sinnvollen Zug gefunden, }
randomize;
repeat
einwerfen:= random (spalten + 1); { also einen beliebigen nehmen}
until (frei (einwerfen) <> 0) and not gesperrt [einwerfen];
end;
aktiv:= merken; simuliert:= false; { Compu-Zug/Simulation zu Ende }
spalte:= einwerfen; { in diese Spalte wirft der Compu seinen Stein }
end else { gegen_compu }
spieler_eingabe (spalte);
end; { Procedure compu_zug
************************************************** **************************}

{************************************************* **************************
* Procedure: Siegerehrung *
* Der Name spricht f�r sich selbst *
* ver„ndert: Monitor *
************************************************** *************************}
Procedure Siegerehrung;

var i, j, k: integer;

begin
textcolor (sieger);
if sieger = 0 then begin
gotoxy (1, 24); textcolor (lightmagenta + blink);
write (' Unentschieden!');
end;
for i:= 1 to zeilen do begin { komplettes Spielfeld }
for j:= 1 to spalten do begin { durchgehen }
if feld[j, i] < -1 then begin { < -1: Markierung der Siegreihe}
xpos:= (j - 1) * (dx + 1) + 2; { x-Position dieses Steins }
gotoxy (xpos, 1 + i * (dy + 1) - dy);
textcolor (feld[j, i] * (-1) + blink); { Spielerfarbe blinkend }
for k:= 1 to dy do begin { Stein darstellen }
zeile_anzeigen;
gotoxy (xpos, wherey + 1);
end; { 1 to dy }
end; { feld[j, i] < -1}
end; { 1 to spalten }
end; { 1 to zeilen }
write (#7); { Piep }
gotoxy (14,25); textcolor (white);
write ('[ESC] zum Beenden, beliebige Taste zum Weiterspielen');
if readkey = #27 then beenden:= true;
end; { Procedure Siegerehrung
************************************************** **************************}

{ ************************************************** ************************
* Hauptprogramm *
************************************************** ************************}
begin
if (spalten > 9) or (zeilen > 11) then begin
writeln ('Zu groáes Spielfeld. Programm beendet.');{nicht darstellbar}
readln; exit
end;
if (spalten < 4) or (zeilen < 4) then begin
writeln ('Zu kleines Spielfeld. Programm beendet.');{vier unm”glich}
readln; exit
end;

repeat
initialisieren;
spielfeld_aufbauen;

repeat
if aktiv = mensch then
spieler_eingabe (eingabe)
else
compu_zug (eingabe);

stein_einwerfen (eingabe);
spielstand_auswerten (eingabe);
until (sieger <> 0) or alles_voll;

siegerehrung;
until beenden;
end.

Aber das Copyright beachten! das ist nicht von mir gecoded!

danke erst mal

hast du vielleicht auch ein......weniger aufweniges? wenn ich das präsentiere, vorrausgesetzt ich verstehe es überhaupt bis in jedes detail, dann glaubt mir der lehrer eh nicht das das von mir ist *tüdelitü

naja wenn du eine "übung" *GG oder so hast sag mir mal bitte bescheid