Program S6C30_ICTSBA;
Type
GuestRecordType = Record
GName : String[30];
GradYear : integer; {add setting}
Sex : char;
age : integer;
ReservedSeats : 0..15;
IDNum : String;
FamilyMember : integer;
Pair : string;
TableNum : integer;
end;
var
GDataFile : text;
Guest : array[1..480] of GuestRecordType;
DPGuest:array[1..480] of GuestRecordType;{Display}
count,i,e : integer;
choice : 1..5;
Table,ExistGuest : integer;
Procedure RecallData(var count : integer);
begin
assign(GDataFile, 'GuestData.txt');
reset(GDataFile);
while not eof(GDataFile) do
begin
count:= count+1; {Miss}
with Guest[count] do
begin
readln(GDataFile, GName);
readln(GDataFile, GradYear);
readln(GDataFile, Sex);
readln(GDataFile, age);
readln(GDataFile, IDNum);
readln(GDataFile, FamilyMember);
readln(GDataFile, ReservedSeats);
readln(GDataFile, Pair);
readln(GDataFile, TableNum);
end;
end;
close(GDataFile);
end;
Procedure AddRecord(var count : integer);
var
i,e : integer;
Wrong : boolean;
IDNum2:String;
begin
if count<480
then begin{Not fulled yet}
Wrong := false;
writeln('---Enter your information---');
count := count + 1;
Repeat
write('Enter your Name:');
readln(Guest[count].GName);
For i:=1 to count-1 do
if (Guest[i].GName = Guest[count].GName)or((length(Guest[count].GName) > 50)and(length(Guest[count].GName) <= 0))
then Wrong := true
else Wrong := false;
If Wrong = true
then writeln('Wrong Input or Repeated');
Until Wrong = false;
With Guest[count] do
begin
e:=0;
Repeat
If e>0 then writeln('Wrong Input');
write('Enter your Graduation year:');
readln(GradYear);
e:=e+1;
Until (GradYear >=1930) and (GradYear <=2017);
end;
with Guest[count] do
begin
e:=0;
Repeat
If e>0 then writeln('Wrong Input');
write('Enter your sex (M/F):');
readln(Sex);
e:=e+1;
Until (Sex='M') or (Sex='F');
end;
with Guest[count] do
begin
e:=0;
Repeat
If e>0 then writeln('Wrong Input');
write('Enter your age:');
readln(age);
e:=e+1;
Until (age>=18) and (age<=120);
end;
Repeat
e:=0;
write('Enter your ID number(e.g.X123456(7)):');
readln(Guest[count].IDNum);
write('Enter your ID number again(e.g.X123456(7)):');
readln(IDNum2);
for i:=1 to count-1 do
if (IDNum2<>Guest[count].IDNum) or (Guest[count].IDNum=Guest[i].IDNum)
then e:=e+1;
If e>0 then writeln('Wrong Input or IDNum used');
Until e=0;
with Guest[count] do
begin
e:=0;
Repeat
If e>0 then writeln('Wrong Input');
write('Enter how many family member(s) will attend:');
readln(FamilyMember);
e:=e+1;
Until (FamilyMember >= 0) and (FamilyMember <= 15);
end;
with Guest[count] do
begin
e:=0;
Repeat
If e>0 then writeln('Wrong Input');
write('Enter you reserve 1~15 seat(s):');
readln(ReservedSeats);
e:= e+1;
Until {(ReservedSeats>0) and (ReservedSeats<16)and} (ReservedSeats>=FamilyMember);
end;
with Guest[count] do
begin
Pair:= 'NotPaired';
TableNum:=0;
end;
Writeln('New Record Added');
end
else writeln('Seat fulled or Time out');
end;
Procedure DelRecord(count : integer);
var
IDNumb : String;
i,j : integer;
found : boolean;
begin
if count<480
then begin
found := false;
write('Enter your ID number(e.g.X123456(7)):');
readln(IDNumb);
For i:= 1 to count do
begin
if Guest[i].IDNum = IDNumb
then begin
Guest[i].GName := 'xxx';
Guest[i].IDNum := 'xxx';
found := true;
for j:=1 to count do
if (Guest[i].TableNum = Guest[j].TableNum)
then begin
Guest[i].TableNum:=0;
Guest[i].Pair := 'NotPaired';
Guest[j].TableNum:=0;
Guest[j].Pair := 'NotPaired';
end;
end
end;
if found = false
then writeln('Wrong Input');
end
else writeln('Seat fulled or Time out');
end;
Procedure DisplayRecord(var count : integer);
var IDnumb : String;
i, alignN: integer;
found : Boolean;
begin
found := false;
write('Enter your ID number(e.g.X123456(7)):');
readln(IDnumb);
For i := 1 to count do
begin
if Guest[i].IDNum = IDnumb
then begin
found := true;
alignN := length(Guest[i].GName)-4;
If found = true
then begin
writeln;
writeln('Name',' ':alignN, 'GradYear',' ':2, 'Sex',' ':2, 'ReservedSeats',' ':2,'TableNumber');
with guest[i] do
if TableNum = 0
then writeln(GName, ' ':2, GradYear,' ':6, Sex,' ':8, ReservedSeats,' ':8,'Not Matched yet')
else writeln(GName, ' ':2, GradYear,' ':6, Sex,' ':8, ReservedSeats,' ':13,TableNum);
end
end
end;
if found = false
then writeln('Wrong Input');
end;
Procedure SaveRecord(count : integer;var ExistGuest:integer);
var i : integer;
begin
assign(GDataFile, 'GuestData.txt');
rewrite(GDataFile);
for i := 1 to count do
begin
with Guest[i] do
if gname <> 'xxx'
then begin
ExistGuest := ExistGuest+1;
writeln(GDataFile, GName);
writeln(GDataFile, GradYear);
writeln(GDataFile, Sex);
writeln(GDataFile, age);
writeln(GDataFile, IDNum);
writeln(GDataFile, FamilyMember);
writeln(GDataFile, ReservedSeats);
writeln(GDataFile, Pair);
writeln(GDataFile,TableNum);
end;
end;
close(GDataFile);
end;
Procedure PairBySex(count:integer; var Table :integer); {FamilyPair Procedure Run First}
var
i,j,s,cal,a : integer;
begin
a := 70;
for s:=1 to 2 do
begin
For i:=1 to count do
Begin
cal :=0;
if (Guest[i].Sex = chr(a)) and (Guest[i].Pair = 'NotPaired')
then if Guest[i].ReservedSeats <> 15
then begin
Guest[i].Pair := 'Paired';
Guest[i].TableNum := Table;
cal := 15-Guest[i].ReservedSeats;
Repeat
For j:=1 to count do
if (Guest[j].Pair = 'NotPaired') and (Guest[j].FamilyMember >=1) and (Guest[j].ReservedSeats <= cal)
then Begin
Guest[j].Pair := 'Paired';
Guest[j].TableNum := Table;
cal:=cal-Guest[j].ReservedSeats;
end;
Until ((cal>=15) and (cal<=15))or (j=count);
end
else begin
Guest[i].Pair := 'Paired';
Guest[i].TableNum := Table;
Table := Table +1;
end;
end;
a:=a+7;
end;
end;
Procedure PairByFamily(count : integer;var Table :integer); {Mistake : wrong to use With ..do}
var
cal,i,j:integer;
begin
For i:=1 to count do
Begin
cal :=0;
if (Guest[i].Pair = 'NotPaired') and (Guest[i].FamilyMember >=1)
then if Guest[i].ReservedSeats <> 15
then begin
cal := 15-Guest[i].ReservedSeats;
Guest[i].Pair := 'Paired';
Guest[i].TableNum := Table;
Repeat
For j:=1 to count do
if (Guest[j].Pair = 'NotPaired') and (Guest[j].FamilyMember >=1) and (Guest[j].ReservedSeats <= cal)
then Begin
Guest[j].Pair := 'Paired';
Guest[j].TableNum := Table;
cal:=cal-Guest[j].ReservedSeats;
end;
Until ((cal>=15) and (cal<=15))or (j=count);
Table := Table+1;
end
else begin
Guest[i].Pair := 'Paired';
Guest[i].TableNum := Table;
Table := Table+1;
end;
end;
end;
Procedure Sorting(count,Table:integer);{bubble sort}
var j,a:integer;
begin
For a:=1 to count-1 do
for j:= 1 to Count-a do
if Guest[j].GName > Guest[j+1].GName
then begin
DPGuest[1].GName := Guest[j].GName;
DPGuest[1].GradYear := Guest[j].GradYear;
DPGuest[1].Sex := Guest[j].Sex;
DPGuest[1].age := Guest[j].age;
DPGuest[1].IDNum := Guest[j].IDNum;
DPGuest[1].FamilyMember := Guest[j].FamilyMember;
DPGuest[1].ReservedSeats := Guest[j].ReservedSeats;
DPGuest[1].Pair := Guest[j].Pair;
DPGuest[1].TableNum := Guest[j].TableNum;
Guest[j].GName := Guest[j+1].GName;
Guest[j].GradYear := Guest[j+1].GradYear;
Guest[j].Sex := Guest[j+1].Sex;
Guest[j].age := Guest[j+1].age;
Guest[j].IDNum := Guest[j+1].IDNum;
Guest[j].FamilyMember := Guest[j+1].FamilyMember;
Guest[j].ReservedSeats := Guest[j+1].ReservedSeats;
Guest[j].Pair := Guest[j+1].Pair;
Guest[j].TableNum := Guest[j+1].TableNum;
Guest[j+1].GName := DPGuest[1].GName;
Guest[j+1].GradYear := DPGuest[1].GradYear;
Guest[j+1].Sex := DPGuest[1].Sex;
Guest[j+1].age := DPGuest[1].age;
Guest[j+1].IDNum := DPGuest[1].IDNum;
Guest[j+1].FamilyMember := DPGuest[1].FamilyMember;
Guest[j+1].ReservedSeats := DPGuest[1].ReservedSeats;
Guest[j+1].Pair := DPGuest[1].Pair;
Guest[j+1].TableNum := DPGuest[1].TableNum;
end;
end;
Procedure AdminFunctions;
Var password:string;
ans,ans2:char;
alignN:integer;
begin
write('Enter the password:');
readln(password);
if password = 'raymond123'
then begin
Repeat
write('Do matching?(Y/N) : ');
readln(ans);
Until (ans = 'Y') or (ans='N');
if ans = 'Y'
then begin
PairByFamily(count,Table);
PairBySex(count,Table);
Sorting(count, Table);
Repeat
write('Display result?(Y/N) : ');
readln(ans2);
Until (ans = 'Y') or (ans='N');
If ans2 = 'Y'
then for i :=1 to count do
begin
alignN := 30-length(Guest[i].GName);
writeln(Guest[i].GName,' ':alignN,'Table No.',Guest[i].TableNum) ;
end;
end;
end
else writeln('Wrong Input!');
end;
Begin {Main Program}
count := 0;{added}
ExistGuest :=0;
Table:=1;
RecallData(count);
Repeat
writeln('==============================');
writeln('Guest Record:');
writeln('==============================');
writeln('1. Add New Record');
writeln('2. Delete Record');
writeln('3. Display Record');
writeln('4. AdminFunctions');
writeln('5. Quit');
E:=0;
repeat
if e>0 then writeln('Wrong Input');
write('Enter your choice(1-5):');
readln(choice);
e:=e+1;
until choice in [1..5];
case choice of
1 : AddRecord(count);
2 : DelRecord(count);
3 : DisplayRecord(count);
4 : AdminFunctions;
end;
Until choice = 5;
SaveRecord(count,ExistGuest);
Writeln(ExistGuest,' Guest(s)');
end.
program NumeralSystems;
const
alf : array[0..15] of char = ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F');
var
i,c,m, s, tmp : longint;
res : string;
begin
writeln('Program was written by Paweł Bielecki 2017');
writeln;
readln(c); //count of data
for i := 0 to c-1 do
begin
readln(m); //data (repeat c times)
writeln(m, ':');
for s := 2 to 16 do
begin
tmp := m;
write(s, #32);
res :='';
repeat
res := alf[tmp mod s] + res;
tmp := tmp div s;
until tmp = 0;
writeln(res);
end;
writeln;
end;
end.
program Tp_Archivos;
uses crt;
Const NMax=84; // Maximo de numeros
NMed=42; // Mitad de numeros
NMin=21; // 1/4 de numeros
var Op, Op2, I: byte; //Opciones Menu Y Contador
NB, NW, NI, NL: string; //Nombres para los archivos
VB: array [1..NMax] of byte; //Vector para datos Byte
VW: array [1..NMax] of Word; //Vector para datos Word
VI: array [1..NMax] of Integer; //Vector para datos Integer
VL: array [1..NMax] of LongInt; //Vector para datos LongInt
//-------------------------------------------------------------------
Procedure GenArchB (NB:string; VB:array of byte);
Var Aux: Byte;
FLB: File of byte;
Begin
randomize;
{$I-}
Assign (FLB, NB);
Rewrite (FLB);
For Aux:=1 to NMax do
Begin
VB[Aux]:= random (200);
End;
If (IOResult=0) then
Begin
For Aux:=1 to NMax do
Begin
write (FLB, VB[Aux]);
End;
End
Else
Begin
writeln ('Error');
writeln ('Presione una tecla');
readkey;
End;
close (FLB);
{$I+}
End;
//-------------------------------------------------------------------
Procedure GenArchW (NW, NB:string; VW:array of word);
Var FLW: File of Word;
FLB: File of Byte;
Aux, Lee: Byte;
GW: Word;
Begin
{$I-}
Assign (FLB, NB);
Reset (FLB);
If (IOResult=0) then
Begin
Aux:= 0;
Repeat
Aux:= Aux+1;
read (FLB, Lee);
If Lee>99 then
GW:= (Lee mod 100)
Else
GW:= Lee;
read (FLB, Lee);
If Lee<10 then
GW:= (GW*10)+Lee
Else
If Lee<100 then
GW:= (GW*100)+Lee
Else
GW:= (GW*100)+(Lee mod 100);
VW[Aux]:= GW;
Until (Aux=NMed);
close (FLB);
Assign (FLW, NW);
Rewrite (FLW);
For Aux:=1 to NMed do
Begin
write (FLW, VW[Aux]);
End;
End
Else
Begin
writeln ('Error');
writeln ('Presione una tecla');
readkey;
End;
close (FLW);
{$I+}
End;
//-------------------------------------------------------------------
Procedure GenArchI (NI, NB:string; VI:array of integer);
Var FLI: File of Integer;
FLB: File of byte;
Aux, Lee: byte;
GI: Integer;
Begin
{$I-}
Assign (FLB, NB);
Reset (FLB);
If (IOResult=0) then
Begin
Aux:= 0;
Repeat
Aux:= Aux+1;
read (FLB, Lee);
If Lee>99 then
GI:= (Lee mod 100) * -1
Else
GI:= Lee;
read (FLB, Lee);
If Lee<10 then
Begin
If GI<0 then
Begin
GI:= (GI*10)-Lee;
End
Else
GI:= (GI*10)+Lee;
End
Else
If Lee<100 then
Begin
If GI<0 then
Begin
GI:= (GI*100)-Lee;
End
Else
GI:= (GI*100)+Lee;
End
Else
Begin
If GI<0 then
Begin
GI:= (GI*100)-(Lee mod 100);
End
Else
GI:= (GI*100)+(Lee mod 100);
End;
VI[Aux]:= GI;
Until (Aux=NMed);
close (FLB);
Assign (FLI, NI);
Rewrite (FLI);
For Aux:=1 to NMed do
Begin
write (FLI, VI[Aux]);
End;
End
Else
Begin
writeln ('Error');
writeln ('Presione una tecla');
readkey;
End;
close (FLI);
{$I+}
End;
//-------------------------------------------------------------------
Procedure GenArchL (NL, NB:string; VL:array of longint);
Var FLL: File of LongInt;
FLB: File of byte;
Aux, Lee, Cont: byte;
GL: LongInt;
Begin
{$I-}
Assign (FLB, NB);
Reset (FLB);
If (IOResult=0) then
Begin
Aux:= 0;
Repeat
Aux:= Aux+1;
Cont:= 0;
repeat
Cont:= Cont+1;
Read (FLB, Lee);
If Cont=1 then
Begin
If Lee>99 then
GL:= (Lee mod 100) * -1
Else
GL:= Lee;
End
Else
Begin
If Lee<10 then
Begin
If GL<0 then
Begin
GL:= (GL*10)-Lee;
End
Else
GL:= (GL*10)+Lee;
End
Else
If Lee<100 then
Begin
If GL<0 then
Begin
GL:= (GL*100)-Lee;
End
Else
GL:= (GL*100)+Lee;
End
Else
Begin
If GL<0 then
Begin
GL:= (GL*100)-(Lee mod 100);
End
Else
GL:= (GL*100)+(Lee mod 100);
End;
End;
until (Cont=4);
VL[Aux]:= GL;
Until (Aux=NMin);
close (FLB);
Assign (FLL, NL);
Rewrite (FLL);
For Aux:=1 to NMed do
Begin
write (FLL, VL[Aux]);
End;
End
Else
Begin
writeln ('Error');
writeln ('Presione una tecla');
readkey;
End;
close (FLL);
{$I+}
End;
//-------------------------------------------------------------------
Procedure VerB (NB:string);
Var Aux, Lee: Byte;
FLB: File of byte;
Begin
{$I-}
clrscr;
writeln ('Ver Byte:');
writeln ('Archivo: ', NB);
writeln (' ');
Assign (FLB, NB);
Reset (FLB);
If (IOResult=0) then
Begin
For Aux:=1 to NMax do
Begin
Read (FLB, Lee);
write (Lee:3, ' | ');
End;
writeln (' ');
writeln (' ');
End
Else
writeln ('Error');
writeln ('Presione una tecla');
readkey;
Close (FLB);
{$I+}
End;
//-------------------------------------------------------------------
Procedure VerC (NB: string);
Var Aux, Lee: Byte;
FLB: File of byte;
Begin
{$I-}
clrscr;
writeln ('Ver caracteres:');
writeln ('Archivo: ', NB);
writeln (' ');
Assign (FLB, NB);
Reset (FLB);
If (IOResult=0) then
Begin
For Aux:=1 to NMax do
Begin
Read (FLB, Lee);
write (chr (Lee), ' ');
End;
writeln (' ');
writeln (' ');
End
Else
writeln ('Error');
writeln ('Presione una tecla');
readkey;
Close (FLB);
{$I+}
End;
//-------------------------------------------------------------------
Procedure VerW (NW: string);
Var Aux: Byte;
Lee: Word;
FLW: File of Word;
Begin
{$I-}
clrscr;
writeln ('Ver Word:');
writeln ('Archivo: ', NW);
writeln (' ');
Assign (FLW, NW);
Reset (FLW);
If (IOResult=0) then
Begin
For Aux:=1 to NMed do
Begin
Read (FLW, Lee);
write (Lee:4, ' | ');
End;
writeln (' ');
writeln (' ');
End
Else
writeln ('Error');
writeln ('Presione una tecla');
readkey;
Close (FLW);
{$I+}
End;
//-------------------------------------------------------------------
Procedure VerI (NI: string);
Var Aux: byte;
Lee: integer;
FLI: File of integer;
Begin
{$I-}
clrscr;
writeln ('Ver Integer:');
writeln ('Archivo: ', NI);
writeln (' ');
Assign (FLI, NI);
Reset (FLI);
If (IOResult=0) then
Begin
For Aux:=1 to NMed do
Begin
Read (FLI, Lee);
write (Lee:4, ' | ');
End;
writeln (' ');
writeln (' ');
End
Else
writeln ('Error');
writeln ('Presione una tecla');
readkey;
Close (FLI);
{$I+}
End;
//-------------------------------------------------------------------
Procedure VerL (NL: string);
Var Aux: byte;
Lee: LongInt;
FLL: File of LongInt;
Begin
{$I-}
clrscr;
writeln ('Ver Integer:');
writeln ('Archivo: ', NL);
writeln (' ');
Assign (FLL, NL);
Reset (FLL);
If (IOResult=0) then
Begin
For Aux:=1 to NMin do
Begin
Read (FLL, Lee);
write (Lee:8, ' | ');
End;
writeln (' ');
writeln (' ');
End
Else
writeln ('Error');
writeln ('Presione una tecla');
readkey;
Close (FLL);
{$I+}
End;
//-------------------------------------------------------------------
BEGIN
repeat
clrscr;
writeln ('MENU:');
writeln ('1- Crear Archivo');
writeln ('2- Ver Archivo');
writeln ('0- Salir');
readln (Op);
//---------------------------------
If Op=1 then
Begin
repeat
clrscr;
writeln ('CREAR ARCHIVO');
writeln ('1- Byte');
writeln ('2- Word');
writeln ('3- Integer');
writeln ('4- LongInt');
writeln ('0- Salir');
readln (Op2);
If Op2=1 then
Begin
clrscr;
write ('Nombre para archivo Byte: ');
readln (NB);
For I:=1 to NMax do
VB[I]:= 0;
GenArchB (NB, VB);
End;
If Op2=2 then
Begin
clrscr;
write ('Nombre del archivo Byte: ');
readln (NB);
write ('Nombre para archivo Word: ');
readln (NW);
For I:=1 to NMax do
VW[I]:= 0;
GenArchW (NW, NB, VW);
End;
If Op2=3 then
Begin
clrscr;
write ('Nombre del archivo Byte: ');
readln (NB);
write ('Nombre para archivo Integer: ');
readln (NI);
For I:=1 to NMax do
VI[I]:= 0;
GenArchI (NI, NB, VI);
End;
If Op2=4 then
Begin
clrscr;
write ('Nombre del archivo Byte: ');
readln (NB);
write ('Nombre para archivo LongInt: ');
readln (NL);
For I:=1 to NMax do
VL[I]:= 0;
GenArchL (NL, NB, VL);
End;
If (Op2<0) or (Op2>4) then
Begin
writeln (' ');
writeln ('Opcion no valida');
writeln ('Presione una tecla');
readkey;
End;
Until (Op2>=0)and(Op2<=3);
End;
//---------------------------------
If Op=2 then
Begin
repeat
clrscr;
writeln ('VER ARCHIVO');
writeln ('1- Byte');
writeln ('2- Caracteres');
writeln ('3- Word');
writeln ('4- Integer');
writeln ('5- LongInt');
writeln ('0- Salir');
readln (Op2);
If Op2=1 then
Begin
clrscr;
write ('Nombre del archivo Byte: ');
readln (NB);
VerB (NB);
End;
If Op2=2 then
Begin
clrscr;
write ('Nombre del archivo Byte: ');
readln (NB);
VerC (NB);
End;
If Op2=3 then
Begin
clrscr;
write ('Nombre del archivo Word: ');
readln (NW);
VerW (NW);
End;
If Op2=4 then
Begin
clrscr;
write ('Nombre del archivo Integer: ');
readln (NI);
VerI (NI);
End;
If Op2=5 then
Begin
clrscr;
write ('Nombre del archivo LongInt: ');
readln (NL);
VerL (NL);
End;
If (Op2<0) or (Op2>5) then
Begin
writeln (' ');
writeln ('Opcion no valida');
writeln ('Presione una tecla');
readkey;
End;
Until (Op2>=0)and(Op2<=4);
End;
//---------------------------------
If (Op<0)or(Op>2)then
Begin
writeln (' ');
writeln ('Opcion no valida');
writeln ('Presione una tecla');
readkey;
End;
//---------------------------------
Until (Op=0);
END.
program NumeralSystems;
const
alf : array[0..15] of char = ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F');
var
i,c,m, s, tmp : longint;
res : string;
begin
writeln('Program was written by Paweł Bielecki 2017');
writeln;
readln(c); //count of data
for i := 0 to c-1 do
begin
readln(m); //data (repeat c times)
writeln(m, ':');
for s := 2 to 16 do
begin
tmp := m;
write(s, #32);
res :='';
repeat
res := alf[tmp mod s] + res;
tmp := tmp div s;
until tmp = 0;
writeln(res);
end;
writeln;
end;
end.
Program sum;
var a,b,c :integer;
begin
a:=5;
b:=8;
c:=3;
a:=a+b;
b:=b+c;
c:=c+a;
writeln('a=',a);
writeln('b=',b);
writeln('c=',c)
We use cookies to provide and improve our services. By using our site, you consent to our Cookies Policy. Accept Learn more
