//////////////////////////////////////////////////////////
///////////////// PPK1.pas /////////////////
//////////////////////////////////////////////////////////
// //
// Program wypełniający liczbami naturalnymi //
// "po skosie" tablicę o zadanych rozmiarach. //
// //
//////////////////////////////////////////////////////////
////////// Prawa autorskie: Mateusz Dylong (2009) //
//////////////////////////////////////////////////////////
program PPK1;
uses CRT;
var
sze,wys,x,y,n: integer;
tab: array of array of integer;
isodd: boolean;
function inttostr(i: longint): string; //
var // implementacja IntToStr znanej z delphi
s: string[11]; //
begin //
str(i,s); //
inttostr := s; //
end; //
function checkdimensions(iswidth: boolean; up: integer): integer;
var
temp: string;
k,err: integer;
dim: longint;
begin
temp := '';
repeat
repeat //
gotoxy(12,up); //
for k := 1 to length(temp) do write(#0); // czyszczenie wartości wprowadzonej przez użytkownika
gotoxy(12,up);
textcolor(9); //
readln(temp); // wczytywanie danego wymiaru
val(temp,dim,err); // konwersja stringa na integer
gotoxy(20,up);
textcolor(12); //
write('Tylko l.naturalne!'); // błąd: liczba nie jest naturalna
until
(err = 0) and (dim > 0); // przerwij jeśli dane są liczbowe i większe od zera
gotoxy(20,up); //
case iswidth of //
false : write('Maks. wysokość: 8!'); // błąd: wysokość maksymalna przekroczona
true : write('Maks. szerok.: 20!'); // błąd: szerokość maksymalna przekroczona
end; //
until
(iswidth = false) and (dim <= 8) or // przerwij jeśli sprawdzamy dane dot. wys. i są nie większe od 25
(iswidth = true) and (dim <= 20); // przerwij jeśli sprawdzamy dane dot. szer. i są nie większe od 80
gotoxy(20,up); //
textcolor(2);
write('OK'); // podany wymiar jest poprawny
for k := 1 to 16 do write(#0); // czyszczenie komunikatu z błędem
textcolor(7);
checkdimensions := dim;
end;
begin
clrscr; // czyszczenie ekranu
writeln('+------------------------------------+');
writeln('| Podaj wymiary tablicy |');
writeln('| (maksymalne wymiary: 20x8) |');
writeln('+------------------------------------+');
writeln('| Szer.: |');
writeln('+------------------------------------+');
writeln('| Wys.: |');
writeln('+------------------------------------+');
sze := checkdimensions(true, 5); // druga zmienna (up) jest marginesem górnym
wys := checkdimensions(false, 7); // -||-
setlength(tab,sze,wys); // przypisanie wymiarów tablicy
n := 1; //
x := 0; // ...
y := 0; //
tab[0][0] := 1; //
isodd := true; // czy dany "rząd" jest nieparzysty
repeat // powtarzaj dopóki nie zostanie wypełniona cała tabela
if isodd then // jeśli "rząd" jest nieparzysty
if x+2 <= sze then // sprawdź, czy masz możliwość pójścia w prawo
inc(x) // jeśli tak, to idź
else if y+2 <= wys then // jeśli nie, sprawdź, czy możesz iść w dół
inc(y) // jeśli tak, to idź
else break // jeśli nie, jesteś na końcu tablicy
else // jeśli rząd jest parzysty
if y+2 <= wys then // sprawdź, czy masz możliwość pójścia w dół
inc(y) // jeśli tak, to idź
else if x+2 <= sze then // jeśli nie, sprawdź czy możesz iść w prawo
inc(x) // jeśli tak, to idź
else break; // jeśli nie, jesteś na końcu tablicy
inc(n); // zwiększanie wartości l.naturalnej
tab[x][y] := n; // przypisanie jej do obecnej pozycji
if (x+2 <= sze) and (y-1 >= 0) then // sprawdź, czy masz możliwość pójścia w prawo i w górę
repeat // jeśli tak, idź tak długo,
inc(x); // aż ta możliwość się skończy
dec(y); //
inc(n); // i po każdej zmianie pozycji wypełniaj
tab[x][y] := n; // tabelę kolejnymi liczbami naturalnymi
until //
(x+2 > sze) or (y-1 < 0) //
else if (x-1 >= 0) and (y+2 <= wys) then // jeśli nie, sprawdź, czy masz możliwość pójścia w lewo i w dół
repeat // jeśli tak, idź tak długo,
dec(x); // aż ta możliwość się skończy
inc(y); //
inc(n); // i po każdej zmianie pozycji wypełniaj
tab[x][y] := n; // tabelę kolejnymi liczbami naturalnymi
until //
(x-1 < 0) or (y+2 > wys); //
isodd := not(isodd); // rząd parzysty <-> rząd nieparzysty
until
(x+1 = sze) and (y+1 = wys);
gotoxy(1,9); // ustawienie kursora w pozycji gotowości do drukowania
for y := 0 to wys - 1 do begin // drukowanie tablicy
for x := 0 to sze - 1 do begin //
textcolor(((x+y) mod 15) + 1); // bajer z kolorami; modulo pozwala na uniknięcie przyjęcia wartości 16
write(tab[x,y]:4); //
end; //
write(#10+#13); // przejście do następnej linii
end; //
textcolor(7);
write('Wciśnij ENTER aby zakończyć.');
readln; //press any key...
end.
Wyszukiwarka
Podobne podstrony:
ALS do wydrukukod do czcionek i obrazkakod do LicytantaKod do VisualBasickod do tego tła 2Jak napisać kod do wyszukiwarki z własnym obrazkiemSylaby do wydruku układanie wyrazówkod do poankieta do wydrukuKod do reklamy w chomikowych rozmowachwięcej podobnych podstron