Programmeren met Delphi 4 |
De meeste eigen procedures en functies heb ik ondergebracht in een unit. Hierin ook de declaraties van de variabelen en record. Dit is bij nieuw te kiezen. Dus zonder form !!
unit damdeclar;
interface
type
damdata=record
naam : array [1..15] of string[25];
uitslag: array [1..15,1..15,1..6] of integer;
end;
{ de volgende types worden gebruikt om op typewerk te besparen en tbv de
sorteerroutine om type aan te geven }
nnm=array [1..15] of string[25];
ggs=array [1..15] of string[2];
ggm=array [1..15] of string[15];
var
datafile :file of damdata;
datarec :damdata;
recteller :integer;
namen :nnm;
gespeeld :ggs;
wit :ggs;
zwart :ggs;
gewonnen :ggs;
remise :ggs;
verloren :ggs;
gemiddeld :ggm;
punten :ggs;
procedure legen;
procedure wisalles;
procedure leesdata;
procedure schrijfdata;
procedure openbestand;
procedure sluitbestand;
function int_str(nummer:integer):string;
function int_str2(nummer:integer):string;
function int_str4(nummer:integer):string;
function str_int(naam:string):integer;
procedure berekenalles;
procedure sorteerspelers(var bb:ggm;var aa,cc,dd,ee,ff,gg,hh:ggs;var tt:nnm;j,n:integer);
implementation
{ deze sorteerroutine in recursief, dwz hij roept zichzelf weer aan. De snelheid
van deze routine is echt SNEL }
procedure sorteerspelers;
var k,p:integer;
h,w:string;
begin
k:=j; p:=n; w:=bb[(k+n) div 2];
repeat
while bb[k]>w do k:=k+1;
while w>bb[p] do p:=p-1;
if k<=p then
begin
h:=bb[k]; bb[k]:=bb[p]; bb[p]:=h;
h:=aa[k]; aa[k]:=aa[p]; aa[p]:=h;
h:=cc[k]; cc[k]:=cc[p]; cc[p]:=h;
h:=dd[k]; dd[k]:=dd[p]; dd[p]:=h;
h:=ee[k]; ee[k]:=ee[p]; ee[p]:=h;
h:=ff[k]; ff[k]:=ff[p]; ff[p]:=h;
h:=gg[k]; gg[k]:=gg[p]; gg[p]:=h;
h:=hh[k]; hh[k]:=hh[p]; hh[p]:=h;
h:=tt[k]; tt[k]:=tt[p]; tt[p]:=h;
k:=k+1; p:=p-1;
end;
until k>p;
if j<p then sorteerspelers(bb,aa,cc,dd,ee,ff,gg,hh,tt,j,p);
if k<n then sorteerspelers(bb,aa,cc,dd,ee,ff,gg,hh,tt,k,n);
end;
{ de gemiddeldes enz worden met deze procedure berekend }
procedure berekenalles;
var tel,tel1,tel2,res:integer;
aant,wt,zwrt,gw,rm,vrl,pt:integer;
gemid:integer;
begin
with datarec do
begin
for tel:=1 to 15 do {elke speler}
begin
aant:=0; wt:=0; zwrt:=0; gw:=0; rm:=0; vrl:=0; pt:=0;
for tel1:=1 to 15 do {elke tegenstander}
begin
if tel1<>tel then
begin
for tel2:=1 to 3 do {elke partij met wit}
begin
res:=uitslag[tel,tel1,tel2];
case res of
0:begin
aant:=aant+1; wt:=wt+1; vrl:=vrl+1;
end;
1:begin
aant:=aant+1; wt:=wt+1; rm:=rm+1; pt:=pt+1;
end;
3:begin
aant:=aant+1; wt:=wt+1; gw:=gw+1; pt:=pt+3;
end;
end;
end;
for tel2:=4 to 6 do {elke partij met zwart}
begin
res:=uitslag[tel,tel1,tel2];
case res of
0:begin
aant:=aant+1; zwrt:=zwrt+1; vrl:=vrl+1;
end;
1:begin
aant:=aant+1; zwrt:=zwrt+1; rm:=rm+1; pt:=pt+1;
end;
3:begin
aant:=aant+1; zwrt:=zwrt+1; gw:=gw+1; pt:=pt+3;
end;
end;
end;
end;
end;
if aant>0 then
{alleen uitrekenen wanneer meer dan 0 gespeeld}
begin
gemid :=((pt*1000) div aant);
namen[tel] :=naam[tel];
gespeeld[tel] :=int_str2(aant);
wit[tel] :=int_str2(wt);
zwart[tel] :=int_str2(zwrt);
gewonnen[tel] :=int_str2(gw);
remise[tel] :=int_str2(rm);
verloren[tel] :=int_str2(vrl);
gemiddeld[tel]:=int_str4(gemid);
punten[tel] :=int_str2(pt);
end;
end;
end;
end;
{ het omzetten van een string naar een integer }
function str_int; {terugzetten naar integer}
var hulp,contro:integer;
begin
str_int:=0;
val(naam,hulp,contro);
if contro=0 then str_int:=hulp;
end;
{ het omzetten van een integer naar een string (onbepaalde lengte) }
function int_str;
var hulp:string;
begin
str(nummer,hulp);
int_str:=hulp;
end;
{ het omzetten van een integer naar een string in een veld van 2 tekens breed }
function int_str2; {in veld van 2}
var hulp:string;
begin
str(nummer:2,hulp);
int_str2:=hulp;
end;
{ het omzetten van een integer naar een string in een veld van 4 tekens }
function int_str4; {in veld van 4}
var hulp:string;
begin
str(nummer:4,hulp);
int_str4:=hulp;
end;
{ een eigenlijk overbodige procedure, echter ten behoeve van de uniformiteit }
procedure sluitbestand;
begin
close(datafile);
end;
{ het openen en controleren op de diskdata in damdata.dat. Is het bestand niet
aanwezig, dan wordt deze aangemaakt }
procedure openbestand;
begin
assign(datafile,'damdata.dat');
{$I-} reset(datafile); {$I+} {controle of bestand bestaat}
if ioresult <> 0 then {als bestand niet bestaat maak
bestand}
begin
legen;
rewrite(datafile);
write(datafile,datarec);
closefile(datafile);
reset(datafile);
end;
end;
{ Het bestand wordt overschreven bij het schrijven Er wordt ook maar 1 record
gebruikt }
procedure schrijfdata;
begin
rewrite(datafile);
write(datafile,datarec);
end;
{ in het eerste record staan de gegevens }
procedure leesdata;
begin
reset(datafile);
read(datafile,datarec);
end;
{ alle gegevens worden gewist en naar de disk geschreven. Niet de namen deze
blijven onveranderd }
procedure wisalles;
var tel,tel1,tel2:integer;
begin
with datarec do
begin
for tel:=1 to 15 do {alle spelers}
begin
for tel2:=1 to 15 do
{tegen alle spelers}
begin
for tel1:=1 to 6 do {alle partijen}
begin
uitslag[tel,tel2,tel1]:=9; {9=niet gespeeld}
end;
end;
end;
schrijfdata;
end;
end;
{ alle gegevens worden gewist en naar de disk geschreven. Ook de namen }
procedure legen;
var tel,tel1,tel2:integer;
begin
with datarec do
begin
for tel:=1 to 15 do {alle spelers}
begin
naam[tel]:='';
for tel2:=1 to 15 do
{tegen alle spelers}
begin
for tel1:=1 to 6 do {alle partijen}
begin
uitslag[tel,tel2,tel1]:=9; {9 = niet gespeeld}
end;
end;
end;
schrijfdata;
end;
end;
end.