Home > Free Pascal, UwB > Laborki z Pascala – Lista 8 i 9

Laborki z Pascala – Lista 8 i 9

Styczeń 11th, 2010 Katharsis Zostaw komentarz Idź do komentarzy

Do Waszej dyspozycji udostępniam dziś dwie ostatnie, najbardziej pracochłonne listy: 8 i 9. Zadania poświęcone są przede wszystkim tematyce zmiennych rekordów i plikom, będących przykładem zmiennych złożonych.

Laboratorium 8

Zadanie 1

Przeanalizowałem :).

Zadanie 2

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65

PROGRAM lista8_zad2(INPUT, OUTPUT);
 
USES
	CRT;
 
TYPE
	ZBIOR_PKT = ARRAY OF RECORD
					a, b : INTEGER;
				END;
 
VAR
	punkt : ZBIOR_PKT;
	x, y, ilosc, X1, Y1, X2, Y2 : INTEGER;
	wynik, max : REAL;
 
BEGIN
	CLRSCR;
 
	WRITE('Podaj ilość punktów: ');
	READLN(ilosc);
 
	WRITELN;
 
	SETLENGTH(punkt, ilosc);
 
	max := 0;
 
	FOR x := 0 TO (ilosc - 1) DO
		BEGIN
			WITH punkt[x] DO
				BEGIN
					WRITE('Podaj współrzędne punktu ', x + 1, ': ');
					READLN(a, b);
				END;
		END;
 
	FOR x := 0 TO (ilosc - 1) DO
		BEGIN
				FOR y := 0 TO (ilosc - 1) DO
					BEGIN
						WITH punkt[y] DO
							BEGIN
								wynik := SQRT(SQR(punkt[x].a - a) + SQR(punkt[x].b - b));
 
								IF wynik > max THEN
									BEGIN
										max := wynik;
										X1 := punkt[x].a;
										Y1 := punkt[x].b;
										X2 := a;
										Y2 := b;
									END
 
								ELSE
									CONTINUE;
							END;
					END;
		END;
 
	WRITELN;
 
	WRITELN('Punkty: (', X1, ', ', Y1, ') i (', X2, ', ', Y2, '), Odległość: ', max:0:2);
 
	REPEAT UNTIL KEYPRESSED;
END.

Zgodnie z treścią zadania, współrzędne podanych punktów dodaję do tablicy rekordów. Następnie wyliczam odległości pomiędzy wszystkimi punktami z wzoru na odległość euklidesową i wyznaczam maksymalną wartość, która jest rozwiązaniem problemu.

Zadanie 3

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40

PROGRAM lista8_zad3(INPUT, OUTPUT);
 
USES
	CRT;
 
VAR
	rok, miesiac, dzien : INTEGER;
 
	FUNCTION UstalDzien(rok, miesiac, dzien : INTEGER) : STRING;
		VAR
			M, C, D, N : INTEGER;
 
		CONST
			dni : ARRAY[0..6] OF STRING = ('Niedziela', 'Poniedziałek', 'Wtorek', 'Środa', 'Czwartek', 'Piątek', 'Sobota');
 
		BEGIN
			M := 1 + ((miesiac + 9) MOD 12);
 
			IF M > 10 THEN
				rok := rok - 1;
 
			C := rok DIV 100;
			D := rok MOD 100;
			N := ((((13 * M) - 1) DIV 5) + D + (D DIV 4) + (C DIV 4) + (5 * C) + dzien) MOD 7;
 
			UstalDzien:= dni[N];
		END;
 
BEGIN
	CLRSCR;
 
	WRITE('Podaj datę (YYYY MM DD): ');
	READLN(rok, miesiac, dzien);
 
	WRITELN;
 
	WRITELN('Jest to: ', UstalDzien(rok, miesiac, dzien));
 
	REPEAT UNTIL KEYPRESSED;
END.

Sposobów na określenie dnia tygodnia na podstawie podanej daty jest kilka. Do tego zadania wykorzystałem jeden z nich, czyli wieczny kalendarz.

Zadanie 4

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157

PROGRAM lista8_zad4(INPUT, OUTPUT);
 
USES
	CRT;
 
TYPE
	DATA = RECORD
				dzien, miesiac, rok : STRING;
			END;
 
	UCZEN = ARRAY[1..5] OF RECORD
				imie, nazwisko : STRING;
				dataur : DATA;
			END;
 
VAR
	info : UCZEN;
	wybor : INTEGER;
 
	PROCEDURE UzupelnijBaze;
		VAR
			x : INTEGER;
 
		BEGIN
			FOR x := 1 TO 5 DO
				BEGIN
					WITH info[x], dataur DO
						BEGIN
							WRITELN;
 
							WRITELN('Uzupełnij formularz - Osoba nr', x, ':');
 
							WRITELN;
 
							WRITE('Imię: ');
							READLN(imie);
 
							WRITE('Nazwisko: ');
							READLN(nazwisko);
 
							WRITE('Dzień urodzin: ');
							READLN(dzien);
 
							WRITE('Miesiąc urodzin: ');
							READLN(miesiac);
 
							WRITE('Rok urodzin: ');
							READLN(rok);
						END;
				END;
 
			READLN;
			CLRSCR;
		END;
 
	PROCEDURE WyswietlBaze;
		VAR
			x : INTEGER;
 
		BEGIN
			WRITELN;
 
			FOR x := 1 TO 5 DO
				BEGIN
					WITH info[x], dataur DO
						WRITELN('NR', x, ': ', imie, ' ', nazwisko, ' :: ', dzien, '-', miesiac, '-', rok);
				END;
 
			READLN;
			CLRSCR;
		END;
 
	PROCEDURE SzukajNazwiskiem;
		VAR
			x : INTEGER;
			nazw : STRING;
 
		BEGIN
			WRITELN;
 
			WRITE('Wpisz szukane nazwisko: ');
			READLN(nazw);
 
			WRITELN;
 
			FOR x := 1 TO 5 DO
				BEGIN
					WITH info[x] DO
						BEGIN
							IF nazw = nazwisko THEN
								WRITELN('- ', imie, ' ', nazwisko)
 
							ELSE
								CONTINUE;
						END;
				END;
 
			READLN;
			CLRSCR;
		END;
 
	PROCEDURE SzukajData;
		VAR
			x : INTEGER;
			rokur : STRING;
 
		BEGIN
			WRITELN;
 
			WRITE('Wpisz rok urodzenia: ');
			READLN(rokur);
 
			WRITELN;
 
			FOR x := 1 TO 5 DO
				BEGIN
					WITH info[x], dataur DO
						BEGIN
							IF rokur = rok THEN
								WRITELN('- ', imie, ' ', nazwisko)
 
							ELSE
								CONTINUE;
						END;
				END;
 
			READLN;
			CLRSCR;
		END;
 
BEGIN
	WHILE TRUE DO
		BEGIN
			CLRSCR;
 
			WRITELN('1. Uzupełnij bazę');
			WRITELN('2. Wyświetl bazę');
			WRITELN('3. Szukaj względem nazwiska');
			WRITELN('4. Szukaj względem roku urodzenia');
 
			WRITELN;
 
			WRITE('Wybór: ');
			READLN(wybor);
 
			CASE wybor OF
				1 : UzupelnijBaze;
				2 : WyswietlBaze;
				3 : SzukajNazwiskiem;
				4 : SzukajData;
 
			ELSE
				EXIT;
 
			END;
		END;
END.

W zadaniu tym należy skorzystać z rekordów zagnieżdżonych, czyli pól adresowych, będących rekordami umieszczonymi wewnątrz głównego rekordu. Należy zwrócić uwagę na to, w jakiej kolejności definiowane są poszczególne (zależne od siebie) rekordy! Zwróćcie uwagę na to, że skorzystałem z instrukcji WITH, w celu pominięcia nazwy rekordów przed nazwali pól. Całe zadanie dotyczy zdefiniowanych procedur, których rolę realizują założenia wytyczone w treści.

Zadanie 5

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78

PROGRAM lista8_zad5(INPUT, OUTPUT);
 
USES
	CRT;
 
TYPE
	KLASA = ARRAY[1..36] OF RECORD
				imie, nazwisko : STRING;
			END;
 
	TABLICA = ARRAY[1..36] OF INTEGER;
 
VAR
	uczen : KLASA;
	ludzie : TABLICA;
	x : INTEGER;
 
	FUNCTION LosowanieBezPowtorzen : TABLICA;
		VAR
			losy : TABLICA;
			x, temp : INTEGER;
 
		BEGIN
			RANDOMIZE;
 
			FOR x := 1 TO 36 DO
				losy[x] := 0;
 
			FOR x := 1 TO 36 DO
				BEGIN
					REPEAT
						temp := RANDOM(36) + 1;
 
					UNTIL
						losy[temp] = 0;
 
					ludzie[x] := temp;         
					losy[temp] := 1;       
				END;
 
			LosowanieBezPowtorzen := ludzie;
		END;
 
BEGIN
	CLRSCR;
 
	FOR x := 1 TO 36 DO
		BEGIN
			WITH uczen[x] DO
				BEGIN
					WRITE('Imię i nazwisko ucznia: ');
					READLN(imie, nazwisko);
				END;
		END;
 
	ludzie := LosowanieBezPowtorzen;
 
	WRITELN;
 
	WRITELN('Wyniki losowania: ');
 
	WRITELN;
 
	FOR x := 1 TO 36 DO
		BEGIN
			IF (x MOD 2 = 0) THEN
				BEGIN
					WITH uczen[ludzie[x]] DO
						WRITELN(imie, ' ', nazwisko);
				END
 
			ELSE
				WITH uczen[ludzie[x]] DO
						WRITE('Para: ', imie, ' ', nazwisko, 'oraz ');
		END;
 
	REPEAT UNTIL KEYPRESSED;
END.

W celu wylosowania nazwisk uczniów i stworzenia par odbywających dyżury, napisałem funkcję LosowanieBezPowtorzen, która generuje tablicę liczb (z uwzględnionym przedziałem), pozbawioną duplikatów. Tablica posłuży mi jako indeks, za pomocą którego odwołam się do tablicy rekordów przechowującej dane wszystkich uczniów.

Zadanie 6

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47

PROGRAM lista8_zad6(INPUT, OUTPUT);
 
USES
	CRT;
 
CONST
	rozmiar = 3;
 
TYPE
	COMPLEX = ARRAY OF ARRAY OF RECORD
					re, im : REAL;
			  END;
 
VAR
	zespolona : COMPLEX;
	x, y : INTEGER;
 
BEGIN
	CLRSCR;
 
	SETLENGTH(zespolona, rozmiar, rozmiar);
 
	FOR x := 0 TO (rozmiar - 1) DO
		BEGIN
			FOR y := 0 TO (rozmiar - 1) DO
				BEGIN
					WITH zespolona[x][y] DO
						BEGIN
							WRITE('Podaj Re i Im: ');
							READLN(re, im);
						END;
				END;
		END;
 
	WRITELN;
 
	FOR x := 0 TO (rozmiar - 1) DO
		BEGIN
			FOR y := 0 TO (rozmiar - 1) DO
				BEGIN
					WITH zespolona[x][y] DO
						WRITELN('z = ', re:0:0, ' i', im:0:0);
				END;
		END;
 
	REPEAT UNTIL KEYPRESSED;
END.

Wartość stałej nadaje rozmiar macierzy (NxN), przechowującej nowo zdefiniowany typ, jakim są liczby zespolone (COMPLEX). Tablica rekordów zostanie uzupełniona polami przechowującymi część rzeczywistą i urojoną podanych liczb.

Laboratorium 9

Zadanie 1

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31

PROGRAM lista9_zad1(INPUT, OUTPUT);
 
USES
	CRT;
 
TYPE
	BYTEFILE = FILE OF BYTE;
 
VAR
	plik : BYTEFILE;
	x, ilosc, liczba : INTEGER;
 
BEGIN
	CLRSCR;
	RANDOMIZE;
 
	ASSIGN(plik, 'zad1.txt');
	REWRITE(plik);
 
	ilosc := RANDOM(801) + 200;
 
	FOR x := 1 TO ilosc DO
		BEGIN
			liczba := RANDOM(101) + 100;
			WRITE(plik, liczba);
		END;
 
	CLOSE(plik);	
 
	REPEAT UNTIL KEYPRESSED;
END.

Zadanie jest dobrym przykładem sposobu definiowania i korzystania z pliku nietekstowego (w formacie binarnym). Plik ten składa się z losowej ilości liczb o przypadkowych wartościach, ograniczonych przedziałami. Posłuży nam do wykonania pozostałych zadań tej listy.

Zadanie 2a

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37

PROGRAM lista9_zad2a(INPUT, OUTPUT);
 
USES
	CRT;
 
TYPE
	BYTEFILE = FILE OF BYTE;
 
VAR
	plik, plik2 : BYTEFILE;
	temp : BYTE;
 
BEGIN
	CLRSCR;
 
	ASSIGN(plik, 'zad1.txt');
	RESET(plik);
 
	ASSIGN(plik2, 'zad2a.txt');
	REWRITE(plik2);
 
	WHILE NOT EOF(plik) DO
		BEGIN
			READ(plik, temp);
 
			IF (temp MOD 2 = 0) THEN
				WRITE(plik2, temp)
 
			ELSE
				CONTINUE;
		END;
 
	CLOSE(plik2);
	CLOSE(plik);
 
	REPEAT UNTIL KEYPRESSED;
END.

Bazując na pliku z Zadania 1, znajduję wszystkie liczby parzyste. Następnie umieszczam je w pliku docelowym. W tym celu analizuję cały plik źródłowy wykorzystując funkcję EOF.

Zadanie 2b

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72

PROGRAM lista9_zad2b(INPUT, OUTPUT);
 
USES
	CRT;
 
TYPE
	BYTEFILE = FILE OF BYTE;
	BYTEARRAY = ARRAY OF BYTE;
 
	STATS = ARRAY OF RECORD
				cyfra, ile : INTEGER;
			END;
 
VAR
	plik : BYTEFILE;
	tablica : BYTEARRAY;
	statystyka : STATS;
	temp : BYTE;
	x, y, ilosc : INTEGER;
 
BEGIN
	CLRSCR;
 
	ilosc := 0;
 
	ASSIGN(plik, 'zad1.txt');
	RESET(plik);
 
	WHILE NOT EOF(plik) DO
		BEGIN
			SETLENGTH(tablica, ilosc + 1);
			SETLENGTH(statystyka, ilosc + 1);
 
			READ(plik, temp);
			tablica[ilosc] := temp;
 
			ilosc := ilosc + 1;
		END;	
 
	CLOSE(plik);
 
	FOR x := 0 TO (ilosc - 1) DO
		BEGIN
			statystyka[x].ile := 0;
			statystyka[x].cyfra := tablica[x];
 
			FOR y := 0 TO (ilosc - 1) DO
				BEGIN
					IF tablica[x] = tablica[y] THEN
						statystyka[x].ile := statystyka[x].ile + 1
 
					ELSE
						CONTINUE;
				END;
		END;
 
	ASSIGN(plik, 'zad2b.txt');
	REWRITE(plik);
 
	FOR x := 0 TO (ilosc - 1) DO
		BEGIN
			IF statystyka[x].ile = 1 THEN
				WRITE(plik, statystyka[x].cyfra)
 
			ELSE
				CONTINUE;
		END;
 
	CLOSE(plik);
 
	REPEAT UNTIL KEYPRESSED;
END.

Bazując na pliku z Zadania 1, wyodrębniam liczby, które w całym ciągu pojawiły się jeden raz. Aby tego dokonać tworzę statystykę (tablicę rekordów), która dla każdej analizowanej liczby przypisuje ilość jej wystąpień. Następnie do pliku docelowego trafiają liczby, których to wystąpienie w ciągu równe jest 1. Warto szczególną uwagę zwrócić na budowę pierwszej pętli WHILE, odpowiedzialnej za jednoczesne ustalenie ilości liczb w ciągu, jak i dynamiczny przyrost wielkości obu tablic.

Zadanie 3

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71

PROGRAM lista9_zad3(INPUT, OUTPUT);
 
USES
	CRT;
 
TYPE
	BYTEFILE = FILE OF BYTE;
	BYTEARRAY = ARRAY OF BYTE;
 
VAR
	plik : BYTEFILE;
	tablica : BYTEARRAY;
	temp : BYTE;
	x, ilosc : INTEGER;
 
	FUNCTION SortujTablice(tablica : BYTEARRAY) : BYTEARRAY;
		VAR
			x, y, liczba : INTEGER;
 
		BEGIN
			FOR x := 0 TO (ilosc - 2) DO
				BEGIN
					FOR y := (ilosc - 1) DOWNTO (x + 1) DO
						BEGIN
							IF tablica[y - 1] > tablica[y] THEN
								BEGIN
									liczba := tablica[y];
									tablica[y] := tablica[y - 1];
									tablica[y - 1] := liczba;
								END
 
							ELSE
								CONTINUE;
						END;
				END;
 
			SortujTablice := tablica;
		END;
 
BEGIN
	CLRSCR;
 
	ilosc := 0;
 
	ASSIGN(plik, 'zad1.txt');
	RESET(plik);
 
	WHILE NOT EOF(plik) DO
		BEGIN
			SETLENGTH(tablica, ilosc + 1);
 
			READ(plik, temp);
			tablica[ilosc] := temp;
 
			ilosc := ilosc + 1;
		END;
 
	CLOSE(plik);
 
	tablica := SortujTablice(tablica);
 
	ASSIGN(plik, 'zad1.txt');
	REWRITE(plik);
 
	FOR x := 0 TO (ilosc - 1) DO
		WRITE(plik, tablica[x]);
 
	CLOSE(plik);
 
	REPEAT UNTIL KEYPRESSED;
END.

Bazując na pliku z Zadania 1, sortuję cały ciąg liczb, bez tworzenia pliku pomocniczego. W tym celu stworzyłem tablicę dynamiczną zawierającą dane liczby, którą to “przepuściłem” przez funkcję SortujTablice. Następnie wynik nadpisałem na plik źródłowy.

Zadanie 4

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65

PROGRAM lista9_zad4(INPUT, OUTPUT);
 
USES
	CRT;
 
TYPE
	LINEARRAY = ARRAY OF STRING;
 
VAR
	plik : TEXT;
	x, ilosc, dlugosc : INTEGER;
	liczba, temp : STRING;
	tablica : LINEARRAY;
 
BEGIN
	CLRSCR;
 
	ilosc := 0;
 
	ASSIGN(plik, 'zad4.txt');
	RESET(plik);
 
	WHILE NOT EOF(plik) DO
		BEGIN
			SETLENGTH(tablica, ilosc + 1);
 
			READLN(plik, temp);
			tablica[ilosc] := temp;
 
			ilosc := ilosc + 1;
		END;
 
	CLOSE(plik);
 
	ASSIGN(plik, 'zad4.txt');
	REWRITE(plik);	
 
	FOR x := 0 TO (ilosc - 1) DO
		BEGIN
			STR(x + 1, liczba);
			dlugosc := LENGTH(liczba);
 
			IF dlugosc = 1 THEN
				WRITE(plik, CONCAT('000', liczba, tablica[x]))
 
			ELSE IF dlugosc = 2 THEN
				WRITE(plik, CONCAT('00', liczba, tablica[x]))
 
			ELSE IF dlugosc = 3 THEN
				WRITE(plik, CONCAT('0', liczba, tablica[x]))
 
			ELSE
				WRITE(plik, CONCAT(liczba, tablica[x]));
 
			IF x = (ilosc - 1) THEN
				WRITE(plik)
 
			ELSE
				WRITELN(plik);
		END;
 
	CLOSE(plik);
 
	REPEAT UNTIL KEYPRESSED;
END.

W celu prawidłowego uruchomienia tego programu, należy wcześniej przygotować plik tekstowy zad4.txt (z zawartością). Każdej linii pliku zostaje przyporządkowany numer wiersza, który powinien zajmować (zawsze) 4 pozycje.

Zadanie 5

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92

PROGRAM lista9_zad5(INPUT, OUTPUT);
 
USES
	CRT;
 
TYPE
	MACIERZ = ARRAY OF ARRAY OF INTEGER;
 
VAR
	plik, plik2 : TEXT;
	x, y, wiersze, kolumny, a, b : INTEGER;
	znak : CHAR;
	tablica : MACIERZ;
 
BEGIN
	CLRSCR;
 
	ASSIGN(plik, 'zad5.txt');
	RESET(plik);
 
	wiersze := 0;
	kolumny := 0;
 
	WHILE NOT EOF(plik) DO
		BEGIN
			WHILE NOT EOLN(plik) DO
				BEGIN
					READ(plik, znak);
 
					IF znak IN ['0'..'9'] THEN
						kolumny := kolumny + 1
 
					ELSE
						CONTINUE;
				END;
 
			READLN(plik);
			wiersze := wiersze + 1;
		END;
 
	CLOSE(plik);
 
	kolumny := ROUND(kolumny / wiersze) - 1;
 
	a := 0;
	b := 0;
 
	SETLENGTH(tablica, wiersze, kolumny);
 
	ASSIGN(plik, 'zad5.txt');
	RESET(plik);
 
	ASSIGN(plik2, 'zad5-trans.txt');
	REWRITE(plik2);
 
	FOR y := 0 TO (kolumny - 1) DO
		BEGIN
			FOR x := 0 TO (wiersze - 1) DO
				BEGIN
					WHILE NOT EOF(plik) DO
						BEGIN
							WHILE NOT EOLN(plik) DO
								BEGIN
									READ(plik, tablica[a, b]);
									b := b + 1;
								END;
 
							READLN(plik);
 
							b := 0;
							a := a + 1;
						END;	
 
					IF x = (wiersze - 1) THEN
						WRITE(plik2, tablica[x][y])
 
					ELSE
						WRITE(plik2, tablica[x][y], ' ');
				END;
 
			IF y = (kolumny - 1) THEN
				WRITE(plik2)
 
			ELSE
				WRITELN(plik2);
		END;
 
	CLOSE(plik2);
	CLOSE(plik);
 
	REPEAT UNTIL KEYPRESSED;
END.

W celu prawidłowego uruchomienia tego programu, należy wcześniej przygotować plik tekstowy zad5.txt, z zawartością macierzy (NxM). Program dokona przestawienia macierzy, a wynik zapisze w pliku docelowym.

Zadanie 6

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188

PROGRAM lista9_zad6(INPUT, OUTPUT);
 
USES
	CRT, DOS, SYSUTILS;
 
CONST
	baza = 'zad6.txt';
 
TYPE
	OSOBA = RECORD
				imie, nazwisko : STRING[25];
				dzien, miesiac : BYTE;
				rok : INTEGER;
			END;
 
VAR
	plik : TEXT;
	wybor : CHAR;
 
	PROCEDURE SprBaza;
		BEGIN
			IF FSEARCH(baza, '') = '' THEN
				BEGIN
					ASSIGN(plik, baza);
					REWRITE(plik);
					CLOSE(plik);
				END;
		END;
 
	PROCEDURE DodajOsobe;
		VAR
			nowy : OSOBA;
			d, m, r : STRING;
 
		BEGIN
			ASSIGN(plik, baza);
			APPEND(plik);
 
			WITH nowy DO
				BEGIN
					WRITELN;
 
					WRITE('Podaj imię i nazwisko: ');
					READLN(imie, nazwisko);
 
					WRITE('Podaj datę urodzenia (DD MM RRRR): ');
					READLN(dzien, miesiac, rok);
 
					STR(dzien, d);
					STR(miesiac, m);
					STR(rok, r);
 
					IF LENGTH(d) = 1 THEN
						d := '0' + d;
 
					IF LENGTH(m) = 1 THEN
						m := '0' + m;
 
					WRITELN(plik, CONCAT(imie, nazwisko, ' ', d, '-', m, '-', r));
				END;
 
			CLOSE(plik);
 
			READLN;
			CLRSCR;
		END;
 
	PROCEDURE WyswietlPelnoletnich;
		VAR
			linia, data : STRING;
			akt_d, akt_m, akt_r, d, m, r : INTEGER;
 
		BEGIN
			WRITELN;
 
			ASSIGN(plik, baza);
			RESET(plik);
 
			WHILE NOT EOF(plik) DO
				BEGIN
					READLN(plik, linia);
 
					data := DATETOSTR(Date);
 
					VAL(COPY(linia, LENGTH(linia) - 9, 2), d);
					VAL(COPY(linia, LENGTH(linia) - 6, 2), m);
					VAL(COPY(linia, LENGTH(linia) - 3, 4), r);
					VAL(COPY(data, 9, 2), akt_d);
					VAL(COPY(data, 6, 2), akt_m);
					VAL(COPY(data, 1, 4), akt_r);
 
					IF (akt_r - r) > 18 THEN
						WRITELN('- ', linia)
 
					ELSE IF (akt_r - r) = 18 THEN
						BEGIN
							IF (akt_m - m) > 0 THEN
								WRITELN('- ', linia)
 
							ELSE IF (akt_m - m) = 0 THEN
								BEGIN
									IF (akt_d - d) >= 0 THEN
										WRITELN('- ', linia);
								END;
						END;
 
				END;
 
			CLOSE(plik);
 
			READLN;
			CLRSCR;
		END;
 
	PROCEDURE WyswietlWzgledemDaty;
		VAR
			linia : STRING;
			ust_d, ust_m, ust_r, d, m, r : INTEGER;
 
		BEGIN
			WRITELN;
 
			WRITE('Podaj datę (DD MM RRRR): ');
			READLN(ust_d, ust_m, ust_r);
 
			WRITELN;
 
			ASSIGN(plik, baza);
			RESET(plik);
 
			WHILE NOT EOF(plik) DO
				BEGIN
					READLN(plik, linia);
 
					VAL(COPY(linia, LENGTH(linia) - 9, 2), d);
					VAL(COPY(linia, LENGTH(linia) - 6, 2), m);
					VAL(COPY(linia, LENGTH(linia) - 3, 4), r);
 
					IF (ust_r - r) < 0 THEN
						WRITELN('- ', linia)
 
					ELSE IF (ust_r - r) = 0 THEN
						BEGIN
							IF (ust_m - m) < 0 THEN
								WRITELN('- ', linia)
 
							ELSE IF (ust_m - m) = 0 THEN
								BEGIN
									IF (ust_d - d) < 0 THEN
										WRITELN('- ', linia);
								END;
						END;
 
				END;
 
			CLOSE(plik);
 
			READLN;
			CLRSCR;
		END;
 
BEGIN
	CLRSCR;
 
	WHILE TRUE DO
		BEGIN
			SprBaza;
 
			WRITELN('1. Dodaj nową osobę');
			WRITELN('2. Wyświetl osoby pełnoletnie');
			WRITELN('3. Wyświetl osoby później urodzone');
 
			WRITELN;
 
			WRITE('Wybór: ');
			READLN(wybor);
 
			CASE wybor OF
				'1' : DodajOsobe;
				'2' : WyswietlPelnoletnich;
				'3' : WyswietlWzgledemDaty;
 
			ELSE
				EXIT;
 
			END;
		END;
END.

Na podstawie ustalonego już typu – OSOBA, należy wykonać sprawnie działającą bazę danych. Na początku każdego uruchomienia programu sprawdzam, czy w obrębie aplikacji nie znajduje się już plik tekstowy, przechowujący dane tych osób. Dokonuję tego przy pomocy funkcji FSEARCH, z modułu DOS. Brak pliku spowoduje utworzenie nowej bazy. Dodawanie osób odbywa się przy pomocy procedury DodajOsobe ściśle powiązanej z typem OSOBA. WyswietlPelnoletnich, to kolejna procedura naszego menu, która na podstawie dogłębnej analizy daty urodzenia każdej z osób oraz aktualnej daty, wyznacza tylko te, które ukończyły 18 lat. Dzisiejszą datę ustala funkcja DATETOSTR(Date), z modułu SYSUTILS. WyswietlWzgledemDaty, działa podobnie do powyższej procedury. Algorytm postępowania jest analogiczny, zmieniają się tylko warunki logiczne.

Wszystkie zadania z tych lekcji można pobrać: tutaj i tutaj.

Categories: Free Pascal, UwB Tags:
  1. Ula
    Styczeń 12th, 2010 at 23:27 | #1
    Odpowiedz | Cytuj

    Będą teraz inni rżnąć z tąd na głupa ;]. Milo było troche pomóc panie PRACOWITY, kawał dobrej roboty!

  1. Brak jeszcze trackbacków
Kod (wymagane)