odeszliDoszli

             {#################################################
              # Program służący do sprawdzenia aktualnego     #
              # składu, zmianach w składzie oraz wypisaniu    #
              # kto odszedł, a kto doszedł do klanu oraz      #
              # przedstawienie tego w postaci liczb.          #
              # Do poprawnego działania potrzebne są dwa      #
              # pliki: wcz.txt i poz.txt.                     #
              #                                               #
              # Czynności:                                    #
              # 1) Do pliku poz.txt wklejamy listę graczy     #
              # 2) Odpalamy program spr.exe                   #
              # 3) Wybieramy 1. opcję                         #
              # 4) Wybieramy 2. opcję                         #
              # 5) Wybieramy 3. opcję                         #
              # 6) Za każdym razem, gdy znów będziemy chcieli #
              # wykonać zestawienie, wykonujemy kolejno       #
              # punkty od 1) - 5)                             #
              #                                               #
              # program tworzy 2 pliki:                       #
              # - zes.txt - aktualne zestawienie (bez składu) #
              # - arch.txt - dane ze wszystkich robionych     #
              # plików zes.txt+dopisany skład na samym        #
              # początku.                                     #
              # autor: asmodeus94                             #
              #################################################}
program odeszliDoszli;
uses crt,dos;
type
byli = record
nick,nickPam : string;
byl : byte;
end;
var
t,t1,tK : text;
s1,s2 : array [1..100] of byli;
const dl = 3;
var
menuT : array [1..dl] of string;
tekstP : string;
wyborLicz,i,j,w,f,wys,wys1,odeszli,nowi : byte;
dT,d,m,y,
h,mm,s,mS : word;
przyrost : integer;
function wysrodkuj(x : string) : byte;
begin
wysrodkuj:=(80-length(x)) div 2;
end;
procedure wyczyscTekst(d : string;y : byte);
var c : byte;
begin
for c:=1 to length(d) do begin
    gotoxy(wysrodkuj(d)+c-1,y);write(' ');
end;
end;
procedure wstawTekst(tekst : string;y:byte);
begin
gotoxy(wysrodkuj(tekst),y);write(tekst);gotoxy(1,1);delay(2000);
wyczyscTekst(tekst,y);
end;
procedure zestawienie;
begin
getDate(y,m,d,dT);getTime(h,mm,s,mS);
if fSearch('arch.txt','')='' then begin assign(t1,'arch.txt');rewrite(t1);close(t1);end;
assign(t,'wcz.txt');
reset(t);
i:=0;
REPEAT
i:=i+1;
readln(t,s1[i].nickPam);
s1[i].nick:=lowercase(s1[i].nickPam);
UNTIL eof(t);
close(t);
assign(t1,'arch.txt');reset(t1);
assign(tK,'sch.txt');rewrite(tK);
REPEAT
readln(t1,tekstP);
writeln(tK,tekstP);
UNTIL eof(t1);
close(tK);
close(t1);
assign(t1,'arch.txt');
rewrite(t1);
assign(t,'poz.txt');
reset(t);
writeln(t1,'Stan wraz ze zmianami: ',d,'.');
if m div 10=0 then write(t1,'0',m,'.') ELSE write(t1,m,'.');
write(t1,y,'r. (',h,':');
if mm div 10=0 then write(t1,'0',mm,':') ELSE write(t1,mm,':');
if s div 10=0 then writeln(t1,'0',s,')') ELSE writeln(t1,s,')');
writeln(t1,'Skład obecny:');
w:=i;
i:=0;
REPEAT
i:=i+1;
readln(t,s2[i].nickPam);
s2[i].nick:=lowercase(s2[i].nickPam);
writeln(t1,s2[i].nickPam);
UNTIL eof(t);
close(t1);
close(t);
f:=i;
for i:=1 to w do begin
    for j:=1 to f do begin
        if s1[i].nick=s2[j].nick then begin
           s1[i].byl:=1;
           s2[j].byl:=1;break;
        end;
    end;
end;
odeszli:=0;
assign(t1,'arch.txt');
append(t1);
assign(t,'zes.txt');
rewrite(t);
writeln(t,'Zmiany na: ',d,'.');
if m div 10=0 then write(t,'0',m,'.') ELSE write(t,m,'.');
write(t,y,'r. (',h,':');
if mm div 10=0 then write(t,'0',mm,':') ELSE write(t,mm,':');
if s div 10=0 then writeln(t,'0',s,')') ELSE writeln(t,s,')');
for i:=1 to w do begin
    if s1[i].byl<>1 then begin odeszli:=1;break;end;
end;
if odeszli=1 then begin
wys:=0;
writeln(t,'Odeszli: ');writeln(t1,'Odeszli: ');
   for i:=1 to w do begin
         if s1[i].byl<>1 then begin
         wys:=wys+1;write(t,wys);write(t,'. ');write(t1,wys);write(t1,'. ');
         writeln(t,s1[i].nickPam);writeln(t1,s1[i].nickPam);
         end;
   end;
end ELSE begin writeln(t,'Nikt nie odszedł');writeln(t1,'Nikt nie odszedł');end;
nowi:=0;
for i:=1 to w do begin
    if (s2[i].byl<>1)AND(s2[i].nick<>'') then begin nowi:=1;break;end;
end;
if nowi=1 then begin
wys1:=0;
writeln(t,'Nowi: ');writeln(t1,'Nowi: ');
   for i:=1 to w do begin
       if (s2[i].byl<>1)AND(s2[i].nick<>'') then begin
       wys1:=wys1+1;write(t,wys1);write(t,'. ');write(t1,wys1);write(t1,'. ');
       writeln(t,s2[i].nickPam);writeln(t1,s2[i].nickPam);
       end;
   end;
end ELSE begin writeln(t,'Nikt nie doszedł');writeln(t1,'Nikt nie doszedł');end;
if (odeszli=1)OR(nowi=1) then begin
   writeln(t,'-------------------');writeln(t1,'-------------------');
   writeln(t,'Było graczy: ',w);writeln(t1,'Było graczy: ',w);
   writeln(t,'Odeszło graczy: ',wys);writeln(t1,'Odeszło graczy: ',wys);
   writeln(t,'Doszło: ',wys1);writeln(t1,'Doszło: ',wys1);
   przyrost:=wys1-wys;
   writeln(t,'Przyrost: ',wys1-wys);writeln(t1,'Przyrost: ',przyrost);
end;

w:=0;
for i:=1 to 100 do begin
    if s2[i].nick<>'' then begin w:=w+1;end ELSE break;
end;
writeln(t,'Aktualny stan klanu: ',w,' graczy');writeln(t1,'Aktualny stan klanu: ',w,' graczy');
close(t);
writeln(t1,'*******************');
assign(tK,'sch.txt');reset(tK);
REPEAT
readln(tK,tekstP);
writeln(t1,tekstP);
UNTIL eof(tK);
close(tK);
close(t1);
assign(tK,'sch.txt');
erase(tK);
wstawTekst('Zestawienie zostalo wykonane!',15);
end;
procedure nadpisz;
var linia : string;
begin
assign(t,'wcz.txt');
rewrite(t);
assign(t1,'poz.txt');
reset(t1);
REPEAT
readln(t1,linia);
writeln(t,linia);
UNTIL eof(t1);
rewrite(t1);
close(t1);
close(t);
wstawTekst('Plik wcz.txt nadpisano!',15);
end;
procedure tabMenu;
begin
menuT[1]:='Zrob zestawienie';
menuT[2]:='Nadpisz wcz.txt danymi z poz.txt';
menuT[3]:='Wylacz';
end;
procedure wysM;
var c : byte;
begin
tekstP:='MENU';
gotoxy((80-length(tekstP)) div 2,10);textbackground(blue);write(tekstP);textbackground(0);
for c:=1 to dl do begin
gotoxy((80-length(menuT[c])) div 2,10+c);
    if c=wyborLicz then textcolor(red) ELSE textcolor(7);
    write(menuT[c]);
end;
textcolor(7);gotoxy(1,1);
end;
procedure menu;
var znak : char;
begin
REPEAT
wysM;
znak:=readkey;
   case znak of
   'w','W':begin wyborLicz:=wyborLicz-1; end;
   's','S':begin wyborLicz:=wyborLicz+1; end;
   end;
   if wyborLicz=0 then wyborLicz:=dl;
   if wyborLicz=dl+1 then wyborLicz:=1;
UNTIL znak=#13;
end;
begin clrscr;
tabMenu;wyborLicz:=1;
REPEAT
menu;
case wyborLicz of
1:begin zestawienie;end;
2:begin nadpisz;end;
end;
UNTIL wyborLicz=3;
end.