Προγράμματα Σε Turbo Pascal

Συζητήσεις σχετικές με την Delphi και την πρόγονη της Pascal

Συντονιστές: WebDev Moderators, Super-Moderators

Απάντηση
mariosal
Honorary Member
Δημοσιεύσεις: 1473
Εγγραφή: 09 Νοέμ 2007 23:55

Προγράμματα Σε Turbo Pascal

Δημοσίευση από mariosal » 06 Ιαν 2008 16:24

Να κάποια από τα προγράμματα που έχω φτιάξει.

Μέσος Όρος:

PROGRAM MESOSOROS (INPUT, OUTPVT);
USES CRT;
VAR A,B,C,D,F,G,H,I,J,K,L,M:REAL;
BEGIN;
CLRSCR;
WRITELN ('ΔΩΣΕ ΤΟ ΒΑΘΜΟ ΤΗΣ ΟΡΘ. ΧΡ. ΑΓΩΓΗΣ');
READLN (A);
WRITELN ('ΔΩΣΕ ΤΟ ΒΑΘΜΟ ΤΗΣ ΕΛΛ. ΓΛΩΣΣΑΣ');
READLN (B);
WRITELN ('ΔΩΣΕ ΤΟ ΒΑΘΜΟ ΤΩΝ ΜΑΘΗΜΑΤΙΚΩΝ');
READLN (C);
WRITELN ('ΔΩΣΕ ΤΟ ΒΑΘΜΟ ΤΗΣ ΙΣΤΟΡΙΑΣ');
READLN (D);
WRITELN ('ΔΩΣΕ ΤΟ ΒΑΘΜΟ ΤΗΣ ΓΕΩΓΡΑΦΙΑΣ');
READLN (F);
WRITELN ('ΔΩΣΕ ΤΟ ΒΑΘΜΟ ΤΗΣ ΦΥΣΙΚΗΣ');
READLN (G);
WRITELN ('ΔΩΣΕ ΤΟ ΒΑΘΜΟ ΚΟΙΝ. ΑΓΩΓΗΣ');
READLN (H);
WRITELN ('ΔΩΣΕ ΤΟ ΒΑΘΜΟ ΤΩΝ ΤΕΧΝΙΚΩΝ');
READLN (I);
WRITELN ('ΔΩΣΕ ΤΟ ΒΑΘΜΟ ΤΗΣ ΜΟΥΣΙΚΗΣ');
READLN (J);
WRITELN ('ΔΩΣΕ ΤΟ ΒΑΘΜΟ ΤΗΣ ΓΥΜΝΑΣΤΙΚΗΣ');
READLN (K);
WRITELN ('ΔΩΣΕ ΤΟ ΒΑΘΜΟ ΤΩΝ ΑΓΓΛΙΚΩΝ');
READLN (L);
M:=(A+B+C+D+F+G+H+I+J+K+L)/11;
WRITELN ('Ο ΜΕΣΟΣ ΟΡΟΣ ΤΟΥ ΕΛΕΓΧΟΥ ΤΟΥ ΠΡΩΤΟΥ ΤΡΙΜΗΝΟΥ ΕΙΝΑΙ ',M);
END.

Βρήσκει Πόσες Μέρες Έχει Ζήσει Κάποιος:

PROGRAM ILIKIA (INPUT, OUTPUT);
USES CRT;
VAR B,D,E,AGE,BDAY,BMONTH,BYEAR,NDAY,NMONTH,NYEAR: INTEGER;
Procedure Wait;
Begin;
Write('');
Readln;
End;
BEGIN;
CLRSCR;
WRITELN ('ΔΩΣΕ ΤΟ ΕΤΟΣ ΓΕΝΝΗΣΗΣ ΣΟΥ');
READLN (BYEAR);
WHILE ( (BYEAR<1900) OR (BYEAR>2007) ) DO BEGIN
WRITELN ('ΛΑΘΟΣ ΕΤΟΣ. ΠΑΡΑΚΑΛΩ ΠΛΗΚΤΡΟΛΟΓΗΣΤΕ ΤΟ ΕΤΟΣ ΓΕΝΝΗΣΗΣ ΞΑΝΑ');
READLN (BYEAR);
END;
WRITELN ('ΔΩΣΕ ΤΟ ΜΗΝΑ ΓΕΝΝΗΣΗΣ ΣΟΥ');
READLN (BMONTH);
WHILE ( (BMONTH<1) OR (BMONTH>12) ) DO BEGIN
WRITELN ('ΛΑΘΟΣ ΜΗΝΑΣ. ΠΑΡΑΚΑΛΩ ΠΛΗΚΤΡΟΛΟΓΗΣΤΕ ΤΟ ΜΗΝΑ ΓΕΝΝΗΣΗΣ ΞΑΝΑ');
READLN (BMONTH);
END;
WRITELN ('ΔΩΣΕ ΤΗΝ ΗΜΕΡΑ ΓΕΝΝΗΣΗΣ ΣΟΥ');
READLN (BDAY);
WHILE ( (BDAY<1) OR (BDAY>31) ) DO BEGIN
WRITELN ('ΛΑΘΟΣ ΗΜΕΡΑ. ΠΑΡΑΚΑΛΩ ΠΛΗΚΤΡΟΛΟΓΗΣΤΕ ΤΗΝ ΗΜΕΡΑ ΓΕΝΝΗΣΗΣ ΞΑΝΑ');
READLN (BDAY);
END;
WRITELN ('ΔΩΣΕ ΤΟ ΤΩΡΙΝΟ ΕΤΟΣ');
READLN (NYEAR);
WHILE (NYEAR<2007) DO BEGIN
WRITELN ('ΛΑΘΟΣ ΕΤΟΣ. ΠΑΡΑΚΑΛΩ ΠΛΗΚΤΡΟΛΟΓΗΣΤΕ ΤΟ ΤΩΡΙΝΟ ΕΤΟΣ ΞΑΝΑ');
READLN (NYEAR);
END;
WRITELN ('ΔΩΣΕ ΤΟΝ ΤΩΡΙΝΟ ΜΗΝΑ');
READLN (NMONTH);
WHILE ( (NMONTH<1) OR (NMONTH>12) ) DO BEGIN
WRITELN ('ΛΑΘΟΣ ΜΗΝΑΣ. ΠΑΡΑΚΑΛΩ ΠΛΗΚΤΡΟΛΟΓΗΣΤΕ ΤΟΝ ΤΩΡΙΝΟ ΜΗΝΑ ΞΑΝΑ');
READLN (NMONTH);
END;
WRITELN ('ΔΩΣΕ ΤΗΝ ΤΩΡΙΝΗ ΗΜΕΡΑ');
READLN (NDAY);
WHILE ( (NDAY<1) OR (NDAY>31) ) DO BEGIN
WRITELN ('ΛΑΘΟΣ ΗΜΕΡΑ. ΠΑΡΑΚΑΛΩ ΠΛΗΚΤΡΟΛΟΓΗΣΤΕ ΤΗΝ ΤΩΡΙΝΗ ΗΜΕΡΑ ΞΑΝΑ');
READLN (NDAY);
END;
B:=(NYEAR-BYEAR)*365;
D:=(NMONTH-BMONTH)*30;
E:=NDAY-BDAY;
AGE:=B+D+E;
WRITELN ('ΕΧΕΙΣ ΖΗΣΕΙ ' , AGE, ' ΜΈΡΕΣ');

Wait;

END.

Βάση Δεδομένων: (μεταφράστε το σε MS-DOS για να το δείτε)

PROGRAM BASI (INPUT, OUTPUT);
USES CRT;
VAR A:CHAR;
VAR B,C,D:INTEGER;
VAR ONOMA:ARRAY [1..25] OF CHAR;
VAR EPI8ETO:ARRAY [1..50] OF CHAR;
VAR TILEFONO1,TILEFONO2:ARRAY [1..10] OF CHAR;
VAR DIEU8INSI:ARRAY [1..40] OF CHAR;
VAR POLI:ARRAY [1..20] OF CHAR;
Procedure Wait;
Begin
Write('');
Readln;
End;
BEGIN
CLRSCR;
WRITELN ('&#8364;"&#8217;Ž &#8222;ˆŒ&#8364;ˆ &#8222;Œ&#8364; Ž&#8218;&#8364;&#8249;&#8249;&#8364; &#8240;&#8364;&#8217;&#8364;&#8226;&#8212;&#8224;&#8216;&#8224;&#8216; &#402;&#8222;&#402;&#8212;&#8249;&#8222;Œ&#8212;Œ');
WRITELN ('&#8249;Ž&#8222;ˆ&#8216; Œ&#8364; &#8364;Ž&#8225;&#8224;&#8240;&#8222;"&#8216;&#8222;ˆ&#8216; ŽŽˆŽ &#8216;&#8217;Žˆ&#8226;&#8222;ˆŽ &#8225;&#8222;&#8216;, &#8364;Œ&#8364;ŠŽ&#8218;&#8364;');
WRITELN ('ME TO Š&#8224;&#8240;&#8217;Ž Ž" &#8225;&#8364; &#8222;ˆŠ&#8222;&#8222;ˆ&#8216;.ˆ&#8222;&#8216;&#8222;:');
WRITELN ('&#8217;Ž Š&#8224;&#8240;&#8217;Ž "Ž" &#8218;ˆ&#8364; ŽŒŽ&#8249;&#8364;');
WRITELN ('&#8217;Ž Š&#8224;&#8240;&#8217;Ž "&#8222;" &#8218;ˆ&#8364; &#8222;&#8212;Œ"&#8249;Ž');
WRITELN ('&#8217;Ž Š&#8224;&#8240;&#8217;Ž "1" &#8218;ˆ&#8364; &#8217;&#8224;Š&#8222;"&#8212;ŒŽ');
WRITELN ('&#8217;Ž Š&#8224;&#8240;&#8217;Ž "2" AN &#8225;&#8222;&#8216; Œ&#8364; &#8364;Ž&#8225;&#8224;&#8240;&#8222;"&#8216;&#8222;ˆ&#8216; &#8240;&#8364;ˆ &#8364;ŠŠŽ &#8217;&#8224;Š&#8222;"&#8212;ŒŽ');
WRITELN ('&#8217;Ž Š&#8224;&#8240;&#8217;Ž "D" &#8218;ˆ&#8364; &#402;ˆ&#8222;"&#8225;"Œ&#8216;&#8224;');
WRITELN ('&#8217;Ž Š&#8224;&#8240;&#8217;Ž "P" &#8218;ˆ&#8364; ŽŠ&#8224;');
WRITELN ('&#8364;Œ &#8225;&#8222;Š&#8222;ˆ&#8216; Œ&#8364; &#8217;&#8222;Š&#8222;ˆ&#8212;&#8216;&#8222;ˆ &#8224; &#8240;&#8364;&#8217;&#8364;&#8226;&#8212;&#8224;&#8216;&#8224;, &#8364;&#8217;&#8364; "."');
C:=0;
WRITELN ('&#8216;&#8222; &#8240;&#8364;&#8225;&#8222; &#8216;&#8217;Žˆ&#8226;&#8222;ˆŽ Ž" &#8240;&#8364;&#8217;&#8364;&#8226;&#8212;&#8222;ˆ&#8216; &#8218;ˆ&#8364; Œ&#8364; &#8218;ˆ&#8364; Œ&#8364; &#8216;&#8217;&#8364;&#8249;&#8364;&#8217;&#8224;&#8216;&#8222;ˆ&#8216;, &#8364;&#8217;&#8364; ","');
WHILE C<6 DO BEGIN
A:=READKEY;
B:=1;
CASE A OF
'.': C:=6;
'O': BEGIN WRITELN ('&#8240;&#8364;&#8217;&#8364;&#8226;&#8212;&#8224;&#8216;&#8222; &#8217;Ž ŽŒŽ&#8249;&#8364;'); WHILE B<=25 DO BEGIN A:=READKEY; IF (A=',') THEN B:=25 ELSE ONOMA:=A; B:=B+1; END; IF (B>=25) THEN WRITELN('&#8217;&#8222;ŠŽ&#8216; &#8240;&#8364;&#8217;&#8364;&#8226;&#8212;&#8224;&#8216;&#8224;&#8216; ŽŒŽ&#8249;&#8364;&#8217;Ž&#8216;. &#8364;&#8217;&#8224;&#8216;&#8217;&#8222; &#8364;ŠŠŽ Š&#8224;&#8240;&#8217;Ž &#8218;ˆ&#8364; &#8364;ŠŠ&#8224; &#8240;&#8364;&#8217;&#8364;&#8226;&#8212;&#8224;&#8216;&#8224;'); END;
'E': BEGIN WRITELN ('&#8240;&#8364;&#8217;&#8364;&#8226;&#8212;&#8224;&#8216;&#8222; &#8217;Ž &#8222;ˆ&#8225;&#8222;&#8217;Ž'); WHILE B<=50 DO BEGIN A:=READKEY; IF (A=',') THEN B:=50 ELSE EPI8ETO:=A; B:=B+1; END; IF (B>=50) THEN WRITELN('&#8217;&#8222;ŠŽ&#8216; &#8240;&#8364;&#8217;&#8364;&#8226;&#8212;&#8224;&#8216;&#8224;&#8216; &#8222;ˆ&#8225;&#8222;&#8217;Ž". &#8364;&#8217;&#8224;&#8216;&#8217;&#8222; &#8364;ŠŠŽ Š&#8224;&#8240;&#8217;Ž &#8218;ˆ&#8364; &#8364;ŠŠ&#8224; &#8240;&#8364;&#8217;&#8364;&#8226;&#8212;&#8224;&#8216;&#8224;'); END;
'1': BEGIN WRITELN ('&#8240;&#8364;&#8217;&#8364;&#8226;&#8212;&#8224;&#8216;&#8222; &#8217;Ž &#8217;&#8224;Š&#8222;"&#8212;ŒŽ 1'); WHILE B<=10 DO BEGIN A:=READKEY; IF (A=',') THEN B:=10 ELSE TILEFONO1:=A; B:=B+1; END; IF (B>=10) THEN WRITELN('&#8217;&#8222;ŠŽ&#8216; &#8240;&#8364;&#8217;&#8364;&#8226;&#8212;&#8224;&#8216;&#8224;&#8216; &#8217;&#8224;Š&#8222;"&#8212;ŒŽ"1. &#8364;&#8217;&#8224;&#8216;&#8217;&#8222; &#8364;ŠŠŽ Š&#8224;&#8240;&#8217;Ž &#8218;ˆ&#8364; &#8364;ŠŠ&#8224; &#8240;&#8364;&#8217;&#8364;&#8226;&#8212;&#8224;&#8216;&#8224;'); END;
'2': BEGIN WRITELN ('&#8240;&#8364;&#8217;&#8364;&#8226;&#8212;&#8224;&#8216;&#8222; &#8217;Ž &#8217;&#8224;Š&#8222;"&#8212;ŒŽ 2'); WHILE B<=10 DO BEGIN A:=READKEY; IF (A=',') THEN B:=10 ELSE TILEFONO2:=A; B:=B+1; END; IF (B>=10) THEN WRITELN('&#8217;&#8222;ŠŽ&#8216; &#8240;&#8364;&#8217;&#8364;&#8226;&#8212;&#8224;&#8216;&#8224;&#8216; &#8217;ˆŠ&#8222;"&#8212;ŒŽ"2. &#8364;&#8217;&#8224;&#8216;&#8217;&#8222; &#8364;ŠŠŽ Š&#8224;&#8240;&#8217;Ž &#8218;ˆ&#8364; &#8364;ŠŠ&#8224; &#8240;&#8364;&#8217;&#8364;&#8226;&#8212;&#8224;&#8216;&#8224;'); END;
'D': BEGIN WRITELN ('&#8240;&#8364;&#8217;&#8364;&#8226;&#8212;&#8224;&#8216;&#8222; &#8217;&#8224; &#402;ˆ&#8222;"&#8225;"Œ&#8216;&#8224;'); WHILE B<=40 DO BEGIN A:=READKEY; IF (A=',') THEN B:=40 ELSE DIEU8INSI:=A; B:=B+1; END; IF (B>=40) THEN WRITELN('&#8217;&#8222;ŠŽ&#8216; &#8240;&#8364;&#8217;&#8364;&#8226;&#8212;&#8224;&#8216;&#8224;&#8216; &#402;ˆ&#8222;"&#8225;"Œ&#8216;&#8224;&#8216;. &#8364;&#8217;&#8224;&#8216;&#8217;&#8222; &#8364;ŠŠŽ Š&#8224;&#8240;&#8217;Ž &#8218;ˆ&#8364; &#8364;ŠŠ&#8224; &#8240;&#8364;&#8217;&#8364;&#8226;&#8212;&#8224;&#8216;&#8224;'); END;
'P': BEGIN WRITELN ('&#8240;&#8364;&#8217;&#8364;&#8226;&#8212;&#8224;&#8216;&#8222; &#8217;&#8224;Œ ŽŠ&#8224;'); WHILE B<=20 DO BEGIN A:=READKEY;IF (A=',') THEN B:=20 ELSE POLI:=A; B:=B+1; END; IF (B>=20) THEN WRITELN('&#8217;&#8222;ŠŽ&#8216; &#8240;&#8364;&#8217;&#8364;&#8226;&#8212;&#8224;&#8216;&#8224;&#8216; ŽŠ&#8224;&#8216;. &#8364;&#8217;&#8224;&#8216;&#8217;&#8222; &#8364;ŠŠŽ Š&#8224;&#8240;&#8217;Ž &#8218;ˆ&#8364; &#8364;ŠŠ&#8224; &#8240;&#8364;&#8217;&#8364;&#8226;&#8212;&#8224;&#8216;&#8224;'); END;
ELSE WRITELN ('Š&#8364;&#8225;Ž&#8216; &#8226;&#8364;&#8364;&#8240;&#8217;&#8224;&#8364;&#8216;. &#8364;&#8364;&#8240;&#8364;Š&#8212; Š&#8224;&#8240;&#8217;ŽŠŽ&#8218;&#8224;&#8216;&#8217;&#8222; &#8364;Œ&#8364; &#8217;ŽŒ &#8216;&#8212;&#8216;&#8217;Ž &#8226;&#8364;&#8364;&#8240;&#8217;&#8224;&#8364;');
A:=READKEY;
END;
B:=B+1;
END;
WRITELN ('&#8217;&#8364; &#402;&#8222;&#402;Ž&#8249;&#8222;Œ&#8364; Ž" Š&#8224;&#8240;&#8217;ŽŠŽ&#8218;&#8224;&#8216;&#8364;&#8217;&#8222; &#8222;ˆŒ&#8364;ˆ:');
WRITELN ('ŽŒŽ&#8249;&#8364;=' , ONOMA);
WRITELN ('&#8222;ˆ&#8225;&#8222;&#8217;Ž=' , EPI8ETO);
WRITELN ('&#8217;&#8224;Š&#8222;"&#8212;ŒŽ1=' , TILEFONO1);
WRITELN ('&#8217;&#8224;Š&#8222;"&#8212;ŒŽ2=' , TILEFONO2);
WRITELN ('&#402;ˆ&#8222;"&#8225;"Œ&#8216;&#8224;=' , DIEU8INSI);
WRITELN ('ŽŠ&#8224;=' , POLI);
Wait;
END.

Άβαταρ μέλους
avr_freak
Δημοσιεύσεις: 70
Εγγραφή: 13 Αύγ 2006 18:58
Επικοινωνία:

Προγράμματα Σε Turbo Pascal

Δημοσίευση από avr_freak » 12 Ιαν 2008 02:06

Keep up the good work :-)
Ena tutorial pou egrapsa ...otan "didaska" to antikeimeno .
Elpizw na sou fanei xrisimo ...

http://george.22web.net/downloads.html --> Pascal By Example

Απάντηση

Επιστροφή στο “Delphi, Pascal”

Μέλη σε σύνδεση

Μέλη σε αυτήν τη Δ. Συζήτηση: Δεν υπάρχουν εγγεγραμμένα μέλη και 0 επισκέπτες