|
Registriert seit: 9. Dez 2022 1 Beiträge |
#1
Moin Leute, ich hab für die Uni folgenden Quellcode geschrieben:
(Die SetConsolePosition hat mich komplett verrückt gemacht...in den TODO's steht auch was der Fehler im Programm ist. Aber ansonsten funktioniert das Programm ![]() // TODO: Ungültige Eingabe muss direkt zu der Fehlermeldung führen, nicht erst nach einem zweiten Enter. // TODO: Nach ungültiger Eingabe muss die Position wieder auf die Position der // ursprünglichen Eingabe gesetzt werden, alte Eingaben sollen verschwinden.
Delphi-Quellcode:
program Übung7;
// imca 105243 // Das Programm visualisiert eine einfache Wassersimulation // mit der Möglichkeit Steine zu legen uses System.SysUtils, Windows; {$APPTYPE CONSOLE} {$R+,Q+,X-} const // Konstante der Feldgröße FIELDSIZE = 6; type // Teilbereichstyp für Breite und Höhe TSize = 1 .. FIELDSIZE; // Aufzählungstyp für die Zustände der Zellen TState = (stLeer, stStein, stNeuesWasser, stWasser); // 2D Array entsprechend dem Aufzählungstyp TField = array [TSize, TSize] of TState; // Setzt die Textfarbe der Konsole. // @param // color - zu setzender Farbwert procedure setTextColor(color: word); begin if SetConsoleTextAttribute(GetStdHandle(STD_OUTPUT_HANDLE), color) then; end; // Setzt die Ausgabeposition der Konsole auf die angegebene Koordinate. // @param // x,y - zu setzende Position in der Konsole ab 0/0 = oben links procedure setConsolePosition(x, y: byte); var coord: _COORD; begin coord.x := x; coord.y := y; if SetConsoleCursorPosition(GetStdHandle(STD_OUTPUT_HANDLE), coord) then; end; // Prozedur zum löschen der Ausgegenen Zeilen // @ param zu löschende Zahl geht rein procedure deleteZeilen(Zeile: integer); var x, y: integer; begin for y := 1 to Zeile do for x := 1 to 80 do write(' '); end; // initialisiert das Feld leer // @param field geht rein wird verarbeitet procedure initField(var field: TField); var x, y: TSize; begin // durchläuft alle Zellen des Feldes for x := 1 to FIELDSIZE do for y := 1 to FIELDSIZE do // setzt das Feld auf leer field[x, y] := stLeer; end; // Gibt das Feld in der Konsole aus // @ field geht rein wird verarbeitet procedure printField(field: TField); var x, y: TSize; begin setConsolePosition(0, 0); // Durchlaufe alle Zellen des Feldes for x := 1 to FIELDSIZE do begin for y := 1 to FIELDSIZE do begin // Gib das Symbol für den Zustand der aktuellen Zelle aus case field[x, y] of stLeer: setTextColor(7); stStein: setTextColor(8); stNeuesWasser: setTextColor(9); stWasser: setTextColor(9); end; Write('▓'); end; Writeln; end; setTextColor(7); end; // Prüft ob die Kooordinaten im gültigen Bereich liegen // @ param Werte gehen rein // // x,y - Koordinaten des Feldes // @ return boolean wird wird ausgegeben function isValidCoord(x, y: integer): boolean; begin // Prüfe, ob die Koordinaten innerhalb des Feldes liegen if ((x >= 1) and (x <= FIELDSIZE)) and ((y >= 1) and (y <= FIELDSIZE)) then isValidCoord := true else isValidCoord := false; end; // Prüft ob Feld frei ist // @ param Werte gehen rein // x,y - Koordinaten des Feldes und field // @ return Boolean wert wird ausgegeben function freeField(x, y: integer; field: TField): boolean; begin if field[x, y] = stLeer then freeField := true else freeField := false; end; // Liest vom Benutzer Spalte und Zeile ein und validiert diese Eingaben. // @param // x,y - Koordinaten des Feldes // cancel - beenden // @return // true, bei gültiger Eingabe function readPos(var x, y: TSize; var cancel: boolean): boolean; var eingabe: string; check: integer; // entweder 0 wenn nicht umwandelbar oder die Zahl begin Writeln('Bitte eine Spalte von 1 bis ', FIELDSIZE, ' eingeben oder ''x'' für Abbruch'); repeat repeat // Prüft die X _Koordinate cancel := false; readln(eingabe); val(eingabe, y, check); if uppercase(eingabe) = 'X' then cancel := true else if not isValidCoord(y, FIELDSIZE) and (check <> 0) then begin setConsolePosition(0, FIELDSIZE + 5); Writeln('Ungültige Eingabe'); setConsolePosition(0, FIELDSIZE + 1); deleteZeilen(1); setConsolePosition(0, FIELDSIZE + 1); end else setConsolePosition(0, FIELDSIZE + 5); deleteZeilen(1); setConsolePosition(0, FIELDSIZE+ 2 ); until cancel or isValidCoord(y, FIELDSIZE); // Prüft die Y Koordinate if not cancel then begin Writeln('Bitte eine Zeile von 1 bis ', FIELDSIZE, ' eingeben oder ''x'' für Abbruch'); readln(eingabe); setConsolePosition(0, FIELDSIZE + 1); deleteZeilen(1); val(eingabe, x, check); if uppercase(eingabe) = 'X' then cancel := true else if not isValidCoord(x, FIELDSIZE) then begin setConsolePosition(0, FIELDSIZE + 5); Writeln('Ungültige Eingabe'); setConsolePosition(0, FIELDSIZE + 1); deleteZeilen(1); setConsolePosition(0, FIELDSIZE + 2); deleteZeilen(2); end; setConsolePosition(0, FIELDSIZE + 2); deleteZeilen(4); setConsolePosition(0, FIELDSIZE + 1); end; until cancel or isValidCoord(x, y); readPos := isValidCoord(x, y); setConsolePosition(0, FIELDSIZE+1 ); deleteZeilen(3); end; // Setzt die steine auf dem Feld // @ param x,y Koordinaten gehen rein und field //koordinaten werden auf Stein gesetzt procedure setStone(x, y: TSize; var field: TField); begin // Setze den Stein für die entsprechende koordinate field[x, y] := stStein; end; // Prüft, ob das gesamte Spielfeld voll ist // @param // field - Spielfeld // @return // true, wenn das Feld voll ist function isFieldFull( field: TField): boolean; var x, y: byte; fertig: boolean; begin fertig := true; for x := low(TSize) to high(TSize) do for y := low(TSize) to high(TSize) do if (field[x, y] = stNeuesWasser) then fertig := false; isFieldFull := fertig; end; // setzt das erste Wasser auf das Spielfeld //@ param x,y und field gehen rein procedure setWater(x, y: TSize; var field: TField); begin field[x, y] := stWasser; end; // Wandelt das neue Wasser in ,,altes Wasser'' um // @ param field geht rein // das neue Wasser wird auf altes Wasser gesetzt procedure convertWater(var field: TField); var x, y: TSize; begin // Durchlaufe alle Zellen des Feldes for x := low(TSize) to high(TSize) do for y := low(TSize) to high(TSize) do if field[x, y] = stNeuesWasser then field[x, y] := stWasser; end; // Flutet das Spielfeld mit Wasser //@param field geht rein // freie stellen werden geprüft und auf neuesWasser gesetzt procedure floodField(var field: TField); var x, y: TSize; begin Sleep(1000); repeat // Durchlaufe alle Zellen des Feldes convertWater(field); for x := low(TSize) to high(TSize) do for y := low(TSize) to high(TSize) do // wenn field Wasser dann prüf ob leer ist if field[x, y] = stWasser then begin if isValidCoord(x - 1, y) and (field[x - 1, y] = stLeer) then field[x - 1, y] := stNeuesWasser; if isValidCoord(x + 1, y) and (field[x + 1, y] = stLeer) then field[x + 1, y] := stNeuesWasser; if isValidCoord(x, y - 1) and (field[x, y - 1] = stLeer) then field[x, y - 1] := stNeuesWasser; if isValidCoord(x, y + 1) and (field[x, y + 1] = stLeer) then field[x, y + 1] := stNeuesWasser; end; // Gib das Feld aus printField(field); // Pausiere das Programm für 1 Sekunde Sleep(1000); until isFieldFull(field); end; // -----------------------------Hauptprogramm------------------------------------ var field: TField; // Variable vom array x, y: TSize; // Variablen vom Teilbereichstyp cancel : boolean; begin cancel := false; initField(field); printField(field); repeat if readPos(x, y, cancel) and freeField(x, y, field) then begin setStone(x, y, field); printField(field); end else if not cancel then Writeln('Positon belegt'); setConsolePosition(0, FIELDSIZE); deleteZeilen(4); setConsolePosition(0, FIELDSIZE); until cancel; repeat cancel := false; setConsolePosition(0, FIELDSIZE ); write('Wassereingabe. '); if readPos(x, y, cancel) and freeField(x, y, field) then begin setWater(x, y, field); printField(field); cancel := true; end else if not cancel then Writeln('Positon belegt'); setConsolePosition(0, FIELDSIZE+1); deleteZeilen(4); setConsolePosition(0, FIELDSIZE); until cancel ; floodField(field); setConsolePosition(0, FIELDSIZE + 5); setTextColor(7); Writeln('Fertig!'); readln; end. Die SetConsolePosition hat mich komplett verrückt gemacht...in den TODO's steht auch was der Fehler im Programm ist. Aber ansonsten funktioniert das Programm ![]() Geändert von Student2022 (15. Dez 2022 um 23:04 Uhr) |
![]() |
Ansicht |
![]() |
![]() |
![]() |
ForumregelnEs ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.
BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus. Trackbacks are an
Pingbacks are an
Refbacks are aus
|
|
Nützliche Links |
Heutige Beiträge |
Sitemap |
Suchen |
Code-Library |
Wer ist online |
Alle Foren als gelesen markieren |
Gehe zu... |
LinkBack |
![]() |
![]() |