Pascal source: UKODELES.PAS
unit ukodeles;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Menus, StdCtrls, ExtCtrls,
CurveFit, Grids;
const
MAXMATR=100;
MAXMATK=15;
type
tmat = array [0..100,0..MAXMATK] of integer;
TFileObject = class
public
endoffile:boolean;
felt: array[0..100] of string;
constructor create(dlm:char;aar:integer);
destructor free;
Procedure open(fn:string;mode:char);
Function AsFloat(fieldno:integer):real;
Procedure Les;
procedure LesSkriv(filname:string;var utfil:textfile);
procedure SkrivHushald(filname:string;var utfil:textfile);
Procedure LesMatrikkel(filname:string;var utfil:textfile);
Procedure Kopier(var ut:TFileObject;forste:boolean);
Procedure Skriv;
Procedure close;
private
F: TextFile;
linje:string;
ix,lest,skr:integer;
delim:char;
Fkommnr,Fkjonn,Falder,Fsivstat,FBosatt,Frel, Frelcode, Fhead:integer;
Fpnr,Fhnr,Fetter,Ffor,FGnr:integer;
Flnr,fore,fmark,fsk:integer;
cMann,ckvinne,cugift,chead,cgift,cenkje:integer;
barnset: set of byte;
end;
Tperson = record
essex:integer;
famstil:integer;
alder: integer;
sivstat:integer;
kjonn:integer;
end;
type
s_laslett = (l1a,l1b,l1c,l2a,l2b,l2c,l3a,l3b,l3c,l3d,l3e,l4a,l4b,l4c,l4d,
l5a,l5b,l5c,l5d,l5e,l6,l7);
Thushald = class
Personar : array [0..100] of TPerson;
t_laslett : array [l1a..l7] of boolean;
hstilling : array [0..200] of integer;
constructor create(knr,pnr,hnr:string);
procedure compute(var fil:TFileObject);
procedure person(kjonn,alder,famstil,essex,sivstat:integer);
procedure skriv(var fil:text);
private
hix:integer;
kommnr,persnr,hushnr:string;
end;
TStatObject = class
public
constructor create(dlm:char;aar:integer);
Procedure Skriv(startrow:integer);
Procedure Agg;
Function ComputeQ(harkol,sumkol,quartile,har2:integer):real;
Function SMAM(k:integer):real;
Function Median(k,q:integer):real;
Function ProsentDiff(k,q:integer):real;
Function CurveF(k,nTerms,startx:integer;kvartil:integer):real;
private
person:tmat;
akk,diff,percent :array [0..100] of real;
movavg :array [0..100] of real;
age0:integer;
antagg:integer;
kjonn,alder,sivstat,famstil,famstilkode,head:integer;
end;
TForm1 = class(TForm)
OpenDialog1: TOpenDialog;
MainMenu1: TMainMenu;
File1: TMenuItem;
Open1: TMenuItem;
Avslutt1: TMenuItem;
Memo1: TMemo;
RadioGroup1: TRadioGroup;
LagSample1: TMenuItem;
RadioGroup2: TRadioGroup;
StringGrid1: TStringGrid;
Kodhushald1: TMenuItem;
LesMatrikkel1: TMenuItem;
KopierMatrikkel1: TMenuItem;
procedure Open1Click(Sender: TObject);
procedure Avslutt1Click(Sender: TObject);
procedure RadioGroup1Click(Sender: TObject);
procedure LagSample1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure RadioGroup2Click(Sender: TObject);
procedure Kodhushald1Click(Sender: TObject);
procedure LesMatrikkel1Click(Sender: TObject);
procedure KopierMatrikkel1Click(Sender: TObject);
private
Mitt :array [-1..10] of TStatObject;
aar:integer;
Kommtab:TStringList;
antkomm:integer;
ktab: array [0..9999] of integer;
felt: array[0..10] of string;
kommnr: integer; { Private declarations }
bosatt,kode:integer;
regionar:integer;
public
Fil: TFileObject;
Procedure LesFil(filname:string);
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
constructor TFileObject.Create(dlm:char;aar:integer);
begin
delim:=dlm;
lest:=0;
skr:=0;
if aar=1801 then begin
Fkommnr:=0;
Fkjonn:=9;
Fsivstat:=10;
Frel:=7;
Frelcode:=7;
Falder:=8;
cugift:=21;
cmann:=0;
chead:=1;
barnset:=[3..4];
Fbosatt:=-1;
Fhead:=7;
end
else if aar=1886 then begin
Fkommnr:=0;
Fetter:=1;
FFor:=2;
FGnr:=3;
{ FBnr:=4;
FMnr:=5;}
FLnr:=6;
{ FGnavn:=7;
FBnavn:=8;
Fdaler:=9;
Fort:=10;
}
FMark:=12;
FOre:=13;
Fsk:=11;
end
else begin
Fkommnr:=0;
Fpnr:=1;
Fhnr:=2;
Fhead:=4;
Fkjonn:=5;
Fsivstat:=6;
Falder:=7;
Frelcode:=9;
Frel:=8;
Fbosatt:=10;
Cugift:=1;
cgift:=2;
cenkje:=4;
barnset:=[31..34];
cmann:=1;
chead:=1;
end;
end;
procedure TFileObject.Open(fn:string;mode:char);
begin
Assignfile(f,fn);
if (mode='w') or (mode='W') then
rewrite(f)
else reset(f);
endoffile:=false;
end;
destructor TFileOBject.Free;
begin
closefile(f);
end;
procedure TFileOBject.les;
var i,j:integer;
begin
if not eof(f) then begin
readln(f,linje);
ix:=0;
j:=0;
for i:=0 to 20 do felt[i]:='';
for i:=1 to length(linje) do begin
if (linje[i]=delim) then begin
felt[ix]:=copy(linje,j+1,i-j-1);
ix:=succ(ix);
j:=i;
end
end;
felt[ix]:=copy(linje,j+1,i-j-1);
lest:=lest+1;
end;
endoffile:=eof(f);
end;
function TFileObject.AsFloat(fieldno:integer):real;
var
p, p2, kode, inemn, itel:integer;
tal:real;
s:string;
begin
if (fieldno<ix) then begin
felt[fieldno]:=trim(felt[fieldno]);
val(felt[fieldno],tal,kode);
if kode>0 then begin
p:=pos('\',felt[fieldno]);
if p>0 then felt[fieldno][p]:='/';
p:=pos('|',felt[fieldno]);
if p>0 then felt[fieldno][p]:='1';
p:=pos(' ',felt[fieldno]);
p2:=pos('/',felt[fieldno]);
if (p>0) and (p2>0) then begin
inc(p);
inc(p2);
s:=trim(copy(felt[fieldno],p2,4));
val(s,inemn,kode);
if kode=0 then
if (inemn>0) then begin
val(trim(copy(felt[fieldno],p,4)),itel,kode);
tal:=tal+(itel/inemn);
end;
end
else if (p2>0) then begin
inc(p2);
val(copy(felt[fieldno],p2,4),inemn,kode);
if (kode=0) and (inemn>=0) then
tal:=tal/inemn;
end;
end;
AsFloat:=tal;
end
else AsFloat:= 0.0;
end;
procedure TfileObject.LesSkriv(filname:string;var utfil:textfile);
var i,antut:integer;
byland:char;
myindex:integer;
begin
Open(filname,'r');
myindex:=LastDelimiter('\',filname);
byland:=upcase(filname[myindex+1]);
i:=0;
antut:=0;
while not eof(f) do begin
readln(f,linje);
if ((byland='F') and (i mod 20=0))
or ((byland='B') and (i mod 10=0)) then begin
writeln(utfil,linje);
antut:=succ(antut);
end;
i:=succ(i);
end;
Close;
Form1.Memo1.Lines.Add(filname+';'+Inttostr(i)+';'+Inttostr(antut));
lest:=lest+i;
skr:=skr+antut;
end;
Procedure TFileObject.SkrivHushald( filname:string;var utfil:textfile);
var bosatt,head:integer;
Hushald:Thushald;
forste:boolean;
begin
Open(filname,'r');
Les;
forste:=true;
hushald:=Thushald.create(felt[fkommnr],felt[fpnr],felt[Fhnr]);
while not endoffile do begin
if (Fbosatt>0) then
bosatt:=strtoint(felt[Fbosatt])
else bosatt:=0;
head:=strtoint(felt[FHead]);
if (head=1) and (not forste) then begin
hushald.compute(self);
hushald.skriv(utfil);
hushald.free;
hushald:=Thushald.create(felt[fkommnr],felt[fpnr],felt[Fhnr]);
end;
hushald.person(strtoint(felt[Fkjonn]),strtoint(felt[Falder]),strtoint(felt[Frel]),strtoint(felt[Frelcode]),strtoint(felt[Fsivstat]));
forste:=false;
les;
end;
hushald.skriv(utfil);
hushald.free;
close;
{ kjonn:=strtoint(felt[Fkjonn]);
alder:=strtoint(form1.fil.felt[form1.fil.Falder]);
if alder>0 then alder:=alder-age0;
if (alder<0) or (alder>99) then alder:=99;
sivstat:=strtoint(form1.fil.felt[form1.fil.FSivStat]);
if (sivstat=form1.fil.cugift) then sivstat:=0
else sivstat:=1;
famstil:=strtoint(form1.fil.felt[form1.fil.Frelcode]);
if famstil in form1.fil.barnset then famstil:=3 else famstil:=4;
if kjonn=form1.fil.cmann then begin
inc(person[alder,famstil]);
inc(person[alder,sivstat]);
if head=form1.fil.chead then inc(person[alder,11]) else inc(person[alder,10]);
end
else begin
inc(person[alder,famstil+5]);
inc(person[alder,sivstat+5]);
end;
if ((byland='F') and (i mod 20=0))
or ((byland='B') and (i mod 10=0)) then begin
writeln(utfil,linje);
antut:=succ(antut);
end;
i:=succ(i);
end;
Close;
Form1.Memo1.Lines.Add(filname+';'+Inttostr(i)+';'+Inttostr(antut));
lest:=lest+i;
skr:=skr+antut;}
end;
Procedure TFileObject.LesMatrikkel(filname:string;var utfil:textfile);
var knr:string;
skill,ore:real;
brukskill,brukore:real;
sumsk,sumore:real;
medsk,medore:integer;
snittsk,snittore:real;
sn25:real;
sk10,ore10:integer;
sk10maal, sk50maal:integer;
ore10maal, ore50maal:integer;
skl: array [0..3000] of integer;
orel: array [0..3000] of integer;
antsk, antore, ant25:integer;
skint, oreint:integer;
i, p, knum:integer;
bruksstor : array [0..5] of integer;
bruksore: array [0..5] of integer;
eigar, forreigar: string;
antskr,antdub,antsum:integer;
Procedure LesSum;
var i:integer;
begin
snittsk:=sumsk/antsk;
snittore:=sumore/antore;
sk50maal:=round(antsk/2);
sk10maal:=round(antsk/10);
ore50maal:=round(antore/2);
ore10maal:=round(antore/10);
sn25:=sn25/ant25;
write(utfil,knr,';',antsk,';',sumsk:1:2,';',antore,';',sumore:1:2,';',snittsk:1:2,';',snittore:1:2,';');
write(utfil,ant25,';',sn25:1:2,';');
antsk:=0; antore:=0;
sk10:=0;ore10:=0;medsk:=0;medore:=0;
i:=0;
while i<3000 do begin
antsk:=antsk+skl[i];
antore:=antore+orel[i];
if sk10maal>antsk then sk10:=i;
if sk50maal>antsk then medsk:=i;
if ore10maal>antore then ore10:=i;
if ore50maal>antore then medore:=i;
inc(i);
end;
write(utfil,sk10,';',medsk,';',ore10,';',medore,';');
for i:=0 to 4 do write(utfil,bruksstor[i],';');
write(utfil,(bruksstor[1]/bruksstor[0]*100):4:2,';');
write(utfil,(bruksstor[2]/bruksstor[0]*100):4:2,';');
write(utfil,(bruksore[1]/bruksore[0]*100):4:2,';');
write(utfil,(bruksore[2]/bruksore[0]*100):4:2);
writeln(utfil);
inc(antskr);
knr:=felt[Fkommnr];
antsk:=0; antore:=0; sumsk:=0;sumore:=0; ant25:=0; sn25:=0;
for i:=0 to 3000 do begin
skl[i]:=0;
orel[i]:=0;
end;
for i:=0 to 5 do begin
bruksstor[i]:=0;
bruksore[i]:=0;
end;
end;
Procedure Nyeigar;
begin
if skill>0 then begin
antsk:=antsk+1;
sumsk:=sumsk+skill;
if skill<2999.4 then begin
skint:=round(skill);
inc(skl[skint]);
end;
if skill>=25 then begin
sn25:=sn25+skill;
inc(ant25);
end;
if skill<25 then
inc(bruksstor[1])
else if skill<240 then
inc(bruksstor[2])
else if skill<1200 then
inc(bruksstor[3])
else
inc(bruksstor[4]);
inc(bruksstor[0]);
end;
if ore>0 then begin
antore:=antore+1;
sumore:=sumore+ore;
if ore<2999.4 then begin
oreint:=round(ore);
inc(orel[oreint]);
end;
if ore<36 then
inc(bruksore[1])
else if ore<348 then
inc(bruksore[2])
else if ore<1740 then
inc(bruksore[3])
else
inc(bruksore[4]);
inc(bruksore[0]);
end;
end;
begin
open(filname,'r');
antsk:=0; antore:=0; sumsk:=0;sumore:=0; ant25:=0; sn25:=0;
antskr:=0; antsum:=0;
les;
les;
knr:=felt[Fkommnr];
for i:=0 to 3000 do begin
skl[i]:=0;
orel[i]:=0;
end;
for i:=0 to 5 do begin
bruksstor[i]:=0;
bruksore[i]:=0;
end;
eigar:=felt[Ffor]+felt[Fetter]+felt[Fgnr];
forreigar:=eigar;
brukore:=0;
brukskill:=0;
skill:=0;
ore:=0;
antdub:=0;
lest:=1;
while not endoffile do begin
val(felt[Fkommnr],knum,i);
if (knum>100) and (knum<2050) and (ix>15) and (i=0) then begin
if felt[Fkommnr]<>knr then begin
NyEigar;
LesSum;
skill:=0;ore:=0; forreigar:=eigar;
end;
brukskill:=(AsFloat(Fsk-2)*120)+(AsFloat(Fsk-1)*24)+AsFloat(Fsk);
brukore:=(AsFloat(FMARK)*100)+AsFloat(FORE);
eigar:=felt[Ffor]+felt[Fetter]+felt[Fgnr];
if eigar=forreigar then begin
skill:=skill+brukskill;
ore:=ore+brukore;
inc(antdub);
end
else begin
NyEigar;
forreigar:=eigar;
skill:=brukskill;
ore:=brukore;
inc(antsum);
end;
end;
les;
end;
NyEigar;
LesSum;
Form1.Memo1.Lines.Add(filname+';'+Inttostr(lest)+';'+Inttostr(antdub)+';'+IntToStr(antsum));
close;
end;
Procedure TFileOBject.Skriv;
var i:integer;
begin
for i:=0 to ix-1 do write(f,felt[i],delim);
writeln(f,felt[ix]);
end;
Procedure TFileOBject.Kopier(var ut:TFileObject;forste:boolean);
var i,p:short;
sk,ore:real;
begin
les;
ut.ix:=11;
if forste then begin
ut.felt[0]:=felt[FKOMMNR];
for i:=3 to 6 do
ut.felt[i-2]:=felt[i];
for i:=9 to 13 do
ut.felt[i-4]:=felt[i];
ut.felt[10]:='Totskilling';
ut.felt[11]:='Totore';
ut.skriv;
end;
les;
while not endoffile do begin
ut.felt[0]:=felt[FKOMMNR];
for i:=3 to 6 do
ut.felt[i-2]:=felt[i];
for i:=9 to 13 do
ut.felt[i-4]:=felt[i];
sk:=(AsFloat(Fsk-2)*120)+(AsFloat(Fsk-1)*24)+AsFloat(Fsk);
ore:=(AsFloat(FMARK)*100)+AsFloat(FORE);
ut.felt[10]:=FloatToStrF(sk,ffFixed,15,2);
ut.felt[11]:=FloatToStrF(ore,ffFixed,15,2);
ut.skriv;
les;
end;
end;
procedure TFileObject.Close;
begin
closefile(f);
end;
constructor THushald.create(knr,pnr,hnr:string);
var i:integer;
lix:s_laslett;
begin
for i:=0 to 200 do hstilling[i]:=0;
for lix:=l1a to l7 do t_laslett[lix]:=false;
hix:=0;
kommnr:=knr;
persnr:=pnr;
hushnr:=hnr;
end;
Procedure Thushald.compute(var fil:TFileOBject);
var
lix:s_laslett;
i:integer;
begin
if personar[0].sivstat=fil.cenkje then
lix:=l1a
else
lix:=l1b;
t_laslett[lix]:=true;
for i:=1 to hix-1 do begin
if (personar[i].essex>20) and (personar[i].essex<30) then
lix:=l3a;
t_laslett[lix]:=true;
if (personar[i].essex>30) and (personar[i].essex<35) then
if t_laslett[l3a]=true then
lix:=l3b
else if personar[0].sivstat=fil.cenkje then
if personar[0].kjonn=fil.cmann then
lix:=l3c
else
lix:=l3d
else lix:=l3e;
t_laslett[lix]:=true;
end;
end;
Procedure Thushald.person(kjonn,alder,famstil,essex,sivstat:integer);
begin
personar[hix].kjonn:=kjonn;
personar[hix].famstil:=famstil;
personar[hix].essex:=essex;
personar[hix].alder:=alder;
personar[hix].sivstat:=sivstat;
if hix<100 then
hix:=hix+1;
end;
Procedure Thushald.skriv(var fil:text);
var
lix:s_laslett;
begin
lix:=l7;
while (t_laslett[lix]=false) and (lix>l1a) do lix:=pred(lix);
writeln(fil,kommnr,chr(9),persnr,chr(9),hushnr,chr(9),hix,chr(9),ord(lix));
end;
constructor TStatObject.Create(dlm:char;aar:integer);
var i,j:integer;
begin
for i:=0 to 100 do
for j:=0 to MAXMATK do
person[i,j]:=0;
if (aar=1865) or (aar=1801) then age0:=1
else age0:=0;
antagg:=0;
end;
Procedure TStatObject.Agg;
begin
antagg:=antagg+1;
kjonn:=strtoint(form1.fil.felt[form1.fil.Fkjonn]);
alder:=strtoint(form1.fil.felt[form1.fil.Falder]);
if alder>0 then alder:=alder-age0;
if (alder<0) or (alder>99) then alder:=99;
sivstat:=strtoint(form1.fil.felt[form1.fil.FSivStat]);
if (sivstat=form1.fil.cugift) then sivstat:=0
else sivstat:=1;
famstil:=strtoint(form1.fil.felt[form1.fil.Frelcode]);
if famstil in form1.fil.barnset then famstil:=3 else famstil:=4;
head:=strtoint(form1.fil.felt[form1.fil.FHead]);
if kjonn=form1.fil.cmann then begin
inc(person[alder,famstil]);
inc(person[alder,sivstat]);
if head=form1.fil.chead then inc(person[alder,11]) else inc(person[alder,10]);
end
else begin
inc(person[alder,famstil+5]);
inc(person[alder,sivstat+5]);
end;
end;
Function TStatObject.ComputeQ(harkol,sumkol,quartile,har2:integer):real;
var
diff1, derivert, prevl,terskel: real;
i:integer;
begin
for i:=0 to 100 do begin
person[i,2]:=person[i,0]+person[i,1];
person[i,7]:=person[i,5]+person[i,6];
end;
if (har2=0) then
for i:=0 to 99 do
if (person[i,sumkol]>0) then
percent[i]:=person[i,harkol]/person[i,sumkol]
else percent[i]:=0.0
else
for i:=0 to 99 do
if (person[i,sumkol]>0) then
percent[i]:= 1.0 - ((person[i,harkol]+person[i,har2])/person[i,sumkol])
else percent[i]:=0.0;
prevl:=0.0;
for i:=45 to 54 do
prevl:=prevl+percent[i];
{ if (pfemale>0.1)
prevl=pfemale;
else if (pmale>0.1)
prevl=pmale;
else}
prevl:=prevl/10.0;
terskel:=prevl / 4 * quartile;
for i:=0 to 99 do
if (percent[i]>terskel) then break;
derivert := (percent[i] - percent[i-1]);
if derivert<>0 then
diff1:=(terskel-percent[i-1])/derivert
else
diff1:=0.0;
// computeQ:= (i - 1) + diff1;
computeQ:= (i - 0.5) + diff1;
end;
Function TStatObject.CurveF(k,nterms,startx:integer;kvartil:integer):real;
const
max_points = 55;
p_end=49;
max_terms = 6;
var
nPoints: 1..max_points;
x, yv, yca: array [0..max_points-1] of real;
coef: array [0..max_terms-1] of real;
tersk,correl: real;
married, pop: real;
i,j : integer;
married45,avvik:real;
xc, ycalc, delta: real;
mini, maxi, nyx: real;
linje:string;
begin
married:=0; pop:=0;
for i:=0 to max_points-1 do begin
x[i]:=0.0;
yv[i]:=0.0;
end;
for i:=45 to 54 do begin
married:=married+person[i,k+1];
pop:=pop+person[i,k]+person[i,k+1];
end;
married45:=married/pop;
case kvartil of
1: tersk:=married45/4.0;
2: tersk:=married45/2.0;
3: tersk:=married45/4.0*3.0;
end;
{ linje:=';'+fLOATtostr(married45);
Form1.Memo1.lines.add(linje);}
diff[0]:=0.0;married:=0;pop:=0;
for i:=0 to 98 do begin
married:=person[i,k+1];
pop:=person[i,k]+person[i,k+1];
if pop>0 then percent[i]:=married/pop
else percent[i]:=0;
if i>0 then begin
diff[i]:=percent[i]-percent[i-1];
// if diff[i]<0 then diff[i]:=0.0;
akk[i]:=akk[i-1]+diff[i];
end
else begin
diff[i]:=percent[i];
akk[i]:=diff[i];
end;
end;
nPoints := p_end-startx-1;
for i:=startx to p_end do begin
x[i-startx]:= i;
// y[i-startx] := akk[i];
yv[i-startx] := percent[i];
end;
PolyFit (x, yv, coef, correl, nPoints, nTerms);
for i := 0 to nPoints do begin
yca[i] := 0.0;
xc := 1.0;
for j := 0 to nTerms - 1 do begin
yca[i] := yca[i] + coef [j] * xc;
xc := xc * x [i];
end;
end;
{ if (k=8) and (startx=5) and (kvartil=1) then
for i:=startx to p_end do begin
linje:=inttostr(i)+';'+fLOATtostr(x[i-startx])+';'+floattostr(yv[i-startx])+';'+floattostr(yca[i-startx]);
Form1.Memo1.lines.add(linje);
end;}
for i:=startx to p_end do
if tersk<yca[i-startx] then break;
avvik:=yca[i-startx]-tersk;
nyx:=i;
maxi:=nyx;
mini:=i-1.0;
while (abs(avvik)>0.0001) do begin
ycalc := 0.0;
xc := 1.0;
nyx:=(maxi+mini)/2.0;
for j := 0 to nTerms - 1 do
begin
ycalc := ycalc + coef [j] * xc;
xc := xc * nyx;
end;
avvik:=ycalc-tersk;
if avvik>0.0 then
maxi:=nyx
else
mini:=nyx;
end;
CurveF:=nyx+0.500;
{
if (k=8) and (startx=5) and (kvartil=1) then begin
Form1.Memo1.Lines.Add ('I; X; Y; Ycalc residual');
for i := 0 to nPoints do
begin
ycalc := 0.0;
xc := 1.0;
for j := 0 to nTerms - 1 do
begin
ycalc := ycalc + coef [j] * xc;
xc := xc * x [i];
end;
delta := ycalc - yv [i];
Form1.Memo1.Lines.Add (Format ('%1d; %3f;%6.2f;%6.2f;%6.2f',
[i, x [i], yv [i], ycalc, delta]));
end;
Form1.Memo1.Lines.Add (' ');
Form1.Memo1.Lines.Add ('Coefficients');
Form1.Memo1.Lines.Add (Format ('%.4f; constant term', [coef [0]]));
for i := 1 to nTerms - 1 do
Form1.Memo1.Lines.Add (Format ('%.8f ; X^%d', [coef [i], i]));
end;}
end;
Function TStatObject.ProsentDiff(k,q:integer):real;
var i:integer;
married, pop:integer;
terskel,diffdiff,fdiff,sumdiff,married45:real;
begin
diff[0]:=0.0;married:=0;pop:=0;
for i:=0 to 98 do begin
married:=person[i,k+1];
pop:=person[i,k]+person[i,k+1];
if pop>0 then percent[i]:=married/pop
else percent[i]:=0;
if i>0 then begin
diff[i]:=percent[i]-percent[i-1];
if diff[i]<0 then diff[i]:=0.0;
end;
end;
sumdiff:=0.0;
for i:=45 to 54 do
sumdiff:=sumdiff+percent[i];
sumdiff:=sumdiff/10;
terskel:=sumdiff/4*q;
sumdiff:=0.0;fdiff:=0.0;
for i:=15 to 44 do begin
sumdiff:=sumdiff+diff[i];
if terskel<sumdiff then break;
fdiff:=sumdiff;
end;
if (i>15) and (i<40) then begin
diffdiff:=terskel-fdiff;
diffdiff:=diffdiff/(sumdiff-fdiff);
ProsentDiff:=(i-0.5)+diffdiff;
end
else
ProsentDiff:=99;
end;
Function TStatObject.Median(k,q:integer):real;
var
i:integer;
diff,married45:real;
terskel:real;
married, pop:integer;
begin
married:=0; pop:=0;
for i:=45 to 54 do begin
married:=married+person[i,k+1];
pop:=pop+person[i,k]+person[i,k+1];
end;
married45:=married/pop;
terskel:=1.0-(married45/4*q);
for i:=0 to 99 do
if (person[i,k]+person[i,k+1])>0 then
percent[i]:=person[i,k]/(person[i,k]+person[i,k+1])
else
percent[i]:=0.0;
for i:=0 to 99 do
if terskel>percent[i] then break;
diff:=percent[i-1]-terskel;
diff:=diff/(percent[i-1]-percent[i]);
Median:=(i-0.5)+diff;
end;
Function TStatObject.SMAM(k:integer):real;
var
prop45,single45,single,pop:real;
i, ugifte:integer;
MA:real;
begin
single45:=0.0;
prop45:=0.0;
single:=0.0;
for i:=45 to 54 do begin
single45:=single45+person[i,k];
prop45:=prop45+person[i,k]+person[i,k+1];
end;
if (prop45<>0.0) then
single45:=(single45/prop45)
else
single45:=0.0;
MA:=0.0;
single:=0.0;
pop:=0.0;
ugifte:=0;
MA:=15.0;
for i:=15 to 49 do begin
pop:=pop+person[i,k+1]+person[i,k];
ugifte := ugifte+person[i,k];
if (i mod 5=4) then begin
if (pop>0.0) then
single:=ugifte/pop
else
if (i<20) then single:=1.0
else if(i<30) then single:=0.45
else single:=0.1;
pop:=0.0;
ugifte:=0;
MA:=MA+(single*5);
end;
end;
MA:=MA-(single45*50);
single45:=1-single45;
MA:=MA/single45;
if (MA<20.0) or (MA>40.0) then MA:=0.0;
SMAM:= MA;
end;
Procedure TStatObject.Skriv(startrow:integer);
var linje:string;
i,j:integer;
begin
{ linje:='Vilkår regionar='+IntToStr(Form1.Regionar);
Form1.Memo1.lines.add(linje);
linje:='Ant aggregert='+IntToStr(antagg);
Form1.Memo1.lines.add(linje);
linje:='alder;ugift menn;gift menn;ugift kv;gift kv;barn m;andre m;barn k;andre k';
Form1.Memo1.lines.add(linje);
for i:=0 to 100 do begin
linje:=inttostr(i)+';'+inttostr(person[i,0])+';'+inttostr(person[i,1])+';';
linje:=linje+inttostr(person[i,5])+';'+inttostr(person[i,6]);
linje:=linje+';'+inttostr(person[i,3])+';'+inttostr(person[i,4])+';';
linje:=linje+inttostr(person[i,8])+';'+inttostr(person[i,9]);
Form1.Memo1.lines.add(linje);
end;}
with Form1.StringGrid1 do begin
cells[0,startrow+1]:='SMAM';
cells[2,startrow+1]:=FloatToStrF(SMAM(0),ffFixed,15,2);
cells[5,startrow+1]:=FloatToStrF(SMAM(5),ffFixed,15,2);
cells[0,startrow+2]:='AFM ComputeQ';
cells[1,startrow+2]:=FloattostrF(ComputeQ(1,2,1,0),ffFixed,15,2);
cells[2,startrow+2]:=FloattostrF(ComputeQ(1,2,2,0),ffFixed,15,2);
cells[3,startrow+2]:=FloattostrF(ComputeQ(1,2,3,0),ffFixed,15,2);
cells[4,startrow+2]:=FloattostrF(ComputeQ(6,7,1,0),ffFixed,15,2);
cells[5,startrow+2]:=FloattostrF(ComputeQ(6,7,2,0),ffFixed,15,2);
cells[6,startrow+2]:=FloattostrF(ComputeQ(6,7,3,0),ffFixed,15,2);
cells[0,startrow+3]:='AFM Median';
cells[1,startrow+3]:=FloattostrF(Median(0,1),ffFixed,15,2);
cells[2,startrow+3]:=FloattostrF(Median(0,2),ffFixed,15,2);
cells[3,startrow+3]:=FloattostrF(Median(0,3),ffFixed,15,2);
cells[4,startrow+3]:=FloattostrF(Median(5,1),ffFixed,15,2);
cells[5,startrow+3]:=FloattostrF(Median(5,2),ffFixed,15,2);
cells[6,startrow+3]:=FloattostrF(Median(5,3),ffFixed,15,2);
cells[0,startrow+4]:='AFM ProsentDiff';
cells[1,startrow+4]:=FloattostrF(ProsentDiff(0,1),ffFixed,15,2);
cells[2,startrow+4]:=FloattostrF(ProsentDiff(0,2),ffFixed,15,2);
cells[3,startrow+4]:=FloattostrF(ProsentDiff(0,3),ffFixed,15,2);
cells[4,startrow+4]:=FloattostrF(ProsentDiff(5,1),ffFixed,15,2);
cells[5,startrow+4]:=FloattostrF(ProsentDiff(5,2),ffFixed,15,2);
cells[6,startrow+4]:=FloattostrF(ProsentDiff(5,3),ffFixed,15,2);
cells[0,startrow+5]:='AFM CurveFit';
cells[1,startrow+5]:=FloattostrF(CurveF(0,5,15,1),ffFixed,15,2);
cells[2,startrow+5]:=FloattostrF(CurveF(0,5,15,2),ffFixed,15,2);
cells[3,startrow+5]:=FloattostrF(CurveF(0,5,15,3),ffFixed,15,2);
cells[4,startrow+5]:=FloattostrF(CurveF(5,5,15,1),ffFixed,15,2);
cells[5,startrow+5]:=FloattostrF(CurveF(5,5,15,2),ffFixed,15,2);
cells[6,startrow+5]:=FloattostrF(CurveF(5,5,15,3),ffFixed,15,2);
cells[0,startrow+6]:='ALH Median';
cells[1,startrow+6]:=FloattostrF(Median(3,1),ffFixed,15,2);
cells[2,startrow+6]:=FloattostrF(Median(3,2),ffFixed,15,2);
cells[3,startrow+6]:=FloattostrF(Median(3,3),ffFixed,15,2);
cells[4,startrow+6]:=FloattostrF(Median(8,1),ffFixed,15,2);
cells[5,startrow+6]:=FloattostrF(Median(8,2),ffFixed,15,2);
cells[6,startrow+6]:=FloattostrF(Median(8,3),ffFixed,15,2);
cells[0,startrow+7]:='ALH ComputeQ';
cells[1,startrow+7]:=FloattostrF(ComputeQ(4,2,1,0),ffFixed,15,2);
cells[2,startrow+7]:=FloattostrF(ComputeQ(4,2,2,0),ffFixed,15,2);
cells[3,startrow+7]:=FloattostrF(ComputeQ(4,2,3,0),ffFixed,15,2);
cells[4,startrow+7]:=FloattostrF(ComputeQ(9,7,1,0),ffFixed,15,2);
cells[5,startrow+7]:=FloattostrF(ComputeQ(9,7,2,0),ffFixed,15,2);
cells[6,startrow+7]:=FloattostrF(ComputeQ(9,7,3,0),ffFixed,15,2);
cells[0,startrow+8]:='ALH CurveFit';
cells[1,startrow+8]:=FloattostrF(CurveF(3,5,5,1),ffFixed,15,2);
cells[2,startrow+8]:=FloattostrF(CurveF(3,5,5,2),ffFixed,15,2);
cells[3,startrow+8]:=FloattostrF(CurveF(3,5,5,3),ffFixed,15,2);
cells[4,startrow+8]:=FloattostrF(CurveF(8,6,5,1),ffFixed,15,2);
cells[5,startrow+8]:=FloattostrF(CurveF(8,6,5,2),ffFixed,15,2);
cells[6,startrow+8]:=FloattostrF(CurveF(8,6,5,3),ffFixed,15,2);
cells[0,startrow+9]:='Headship Median';
cells[1,startrow+9]:=FloattostrF(Median(10,1),ffFixed,15,2);
cells[2,startrow+9]:=FloattostrF(Median(10,2),ffFixed,15,2);
cells[3,startrow+9]:=FloattostrF(Median(10,3),ffFixed,15,2);
linje:='';
if startrow=0 then begin
for j:=0 to 6 do
linje:=linje+cells[j,0]+';';
Form1.Memo1.Lines.Add(linje);
linje:='';
end;
for i:=startrow+1 to startrow+9 do begin
for j:=0 to 6 do
linje:=linje+cells[j,i]+';';
Form1.Memo1.Lines.Add(linje);
linje:='';
end;
end; {
linje:='SMAM;menn ;'+FloatToStr(SMAM(0));
Form1.Memo1.lines.add(linje);
linje:='SMAM;kvinner ;'+FloatToStr(SMAM(5));
Form1.Memo1.lines.add(linje);
linje:='ComputeQ;Menn 1. kv. ;'+Floattostr(ComputeQ(1,2,1,0));
Form1.Memo1.lines.add(linje);
linje:='ComputeQ;Menn 2. kv. ;'+Floattostr(ComputeQ(1,2,2,0));
Form1.Memo1.lines.add(linje);
linje:='ComputeQ;Menn 3. kv. ;'+Floattostr(ComputeQ(1,2,3,0));
Form1.Memo1.lines.add(linje);
linje:='ComputeQ;Kvinner 1. kv. ;'+Floattostr(ComputeQ(6,7,1,0));
Form1.Memo1.lines.add(linje);
linje:='ComputeQ;Kvinner 2. kv. ;'+Floattostr(ComputeQ(6,7,2,0));
Form1.Memo1.lines.add(linje);
linje:='ComputeQ;Kvinner 3. kv. ;'+Floattostr(ComputeQ(6,7,3,0));
Form1.Memo1.lines.add(linje);
linje:='Median;Menn 1. kv. ;'+Floattostr(Median(0,1));
Form1.Memo1.lines.add(linje);
linje:='Median;Menn 2. kv. ;'+Floattostr(Median(0,2));
Form1.Memo1.lines.add(linje);
linje:='Median;Menn 3. kv. ;'+Floattostr(Median(0,3));
Form1.Memo1.lines.add(linje);
linje:='Median;kvinner 1. kv. ;'+Floattostr(Median(5,1));
Form1.Memo1.lines.add(linje);
linje:='Median;kvinner 2. kv. ;'+Floattostr(Median(5,2));
Form1.Memo1.lines.add(linje);
linje:='Median;kvinner 3. kv. ;'+Floattostr(Median(5,3));
Form1.Memo1.lines.add(linje);
linje:='ProsentDiff;Menn 1. kv. ;'+Floattostr(ProsentDiff(0,1));
Form1.Memo1.lines.add(linje);
linje:='ProsentDiff;Menn 2. kv. ;'+Floattostr(ProsentDiff(0,2));
Form1.Memo1.lines.add(linje);
linje:='ProsentDiff;Menn 3. kv. ;'+Floattostr(ProsentDiff(0,3));
Form1.Memo1.lines.add(linje);
linje:='ProsentDiff;kvinner 1. kv. ;'+Floattostr(ProsentDiff(5,1));
Form1.Memo1.lines.add(linje);
linje:='ProsentDiff;kvinner 2. kv. ;'+Floattostr(ProsentDiff(5,2));
Form1.Memo1.lines.add(linje);
linje:='ProsentDiff;kvinner 3. kv. ;'+Floattostr(ProsentDiff(5,3));
Form1.Memo1.lines.add(linje);
linje:='CurveFit;Menn 0.25 ;'+FloatToStr(CurveF(0,5,15,0.25));
Form1.Memo1.lines.add(linje);
linje:='CurveFit;Menn 0.5 ;'+FloatToStr(CurveF(0,5,15,0.5));
Form1.Memo1.lines.add(linje);
linje:='CurveFit;Menn 0.75 ;'+FloatToStr(CurveF(0,5,15,0.75));
Form1.Memo1.lines.add(linje);
linje:='CurveFit;kvinner 0.25 ;'+FloatToStr(CurveF(5,5,15,0.25));
Form1.Memo1.lines.add(linje);
linje:='CurveFit;Kvinner 0.5 ;'+FloatToStr(CurveF(5,5,15,0.5));
Form1.Memo1.lines.add(linje);
linje:='CurveFit;Kvinner 0.75 ;'+FloatToStr(CurveF(5,5,15,0.75));
Form1.Memo1.lines.add(linje);
linje:='Median;Menn ALH 1. kv. ;'+Floattostr(Median(3,1));
Form1.Memo1.lines.add(linje);
linje:='Median;Menn ALH 2. kv. ;'+Floattostr(Median(3,2));
Form1.Memo1.lines.add(linje);
linje:='Median;Menn ALH 3. kv. ;'+Floattostr(Median(3,3));
Form1.Memo1.lines.add(linje);
linje:='Median;kvinner ALH 1. kv. ;'+Floattostr(Median(8,1));
Form1.Memo1.lines.add(linje);
linje:='Median;kvinner ALH 2. kv. ;'+Floattostr(Median(8,2));
Form1.Memo1.lines.add(linje);
linje:='Median;kvinner ALH 3. kv. ;'+Floattostr(Median(8,3));
Form1.Memo1.lines.add(linje);
linje:='ComputeQ;Menn ALH 1. kv. ;'+Floattostr(ComputeQ(4,2,1,0));
Form1.Memo1.lines.add(linje);
linje:='ComputeQ;Menn ALH 2. kv. ;'+Floattostr(ComputeQ(4,2,2,0));
Form1.Memo1.lines.add(linje);
linje:='ComputeQ;Menn ALH 3. kv. ;'+Floattostr(ComputeQ(4,2,3,0));
Form1.Memo1.lines.add(linje);
linje:='ComputeQ;Kvinner ALH 1. kv. ;'+Floattostr(ComputeQ(9,7,1,0));
Form1.Memo1.lines.add(linje);
linje:='ComputeQ;Kvinner ALH 2. kv. ;'+Floattostr(ComputeQ(9,7,2,0));
Form1.Memo1.lines.add(linje);
linje:='ComputeQ;Kvinner ALH 3. kv. ;'+Floattostr(ComputeQ(9,7,3,0));
Form1.Memo1.lines.add(linje);
linje:='CurveFit;Menn ALH 0.25 ;'+FloatToStr(CurveF(3,5,5,0.25));
Form1.Memo1.lines.add(linje);
linje:='CurveFit;Menn ALH 0.5 ;'+FloatToStr(CurveF(3,5,5,0.5));
Form1.Memo1.lines.add(linje);
linje:='CurveFit;Menn ALH 0.75 ;'+FloatToStr(CurveF(3,5,5,0.75));
Form1.Memo1.lines.add(linje);
linje:='CurveFit;kvinner ALH 0.25 ;'+FloatToStr(CurveF(8,5,0,0.25));
Form1.Memo1.lines.add(linje);
linje:='CurveFit;Kvinner ALH 0.5 ;'+FloatToStr(CurveF(8,5,5,0.5));
Form1.Memo1.lines.add(linje);
linje:='CurveFit;Kvinner ALH 0.75 ;'+FloatToStr(CurveF(8,5,5,0.75));
Form1.Memo1.lines.add(linje);
linje:='Median;Menn Headship 1. kv. ;'+Floattostr(Median(10,1));
Form1.Memo1.lines.add(linje);
linje:='Median;Menn Headship 2. kv. ;'+Floattostr(Median(10,2));
Form1.Memo1.lines.add(linje);
linje:='Median;Menn Headship 3. kv. ;'+Floattostr(Median(10,3));
Form1.Memo1.lines.add(linje); }
end;
procedure TForm1.LesFil(filname:string);
begin
Fil.Open(filname,'r');
fil.lest:=0;
fil.skr:=0;
Fil.Les;
bosatt:=0;
if (Form1.Radiogroup2.ItemIndex>0) and ((Form1.aar=1900) or (Form1.aar=1865)) then begin
kommnr:=strtoint(fil.felt[fil.fkommnr]);
if (kommnr>100) and (kommnr<10000) then
kode:=Form1.ktab[kommnr]
else
kode:=9
end
else
kode:=-1;
if (kode<9) then begin
while not Fil.endoffile do begin
if (fil.Fbosatt>0) then
bosatt:=strtoint(fil.felt[fil.Fbosatt]);
if (Form1.Radiogroup2.ItemIndex>0) and (Form1.aar=1801) then begin
kommnr:=strtoint(fil.felt[fil.fkommnr]);
if (kommnr>100) and (kommnr<10000) then
kode:=Form1.ktab[kommnr]
else
kode:=9;
end
else if Form1.aar=1801 then
kode:=-1;
if (kode<9) and (bosatt<>2) then begin
if kode>regionar then
Form1.memo1.lines.add(IntTostr(kommnr))
else begin
Mitt[kode].Agg;
fil.skr:=fil.skr+1;
end;
end;
Fil.Les;
end;
end;
Form1.Memo1.Lines.Add(filname+';'+Inttostr(fil.lest)+';'+Inttostr(fil.skr));
Fil.Close;
end;
procedure TForm1.Open1Click(Sender: TObject);
var
I: integer;
dlm:char;
rad:integer;
begin
if (Opendialog1.execute=true) then begin
dlm:=chr(9);
fil:=TFileObject.Create(dlm,aar);
for i:=-1 to Regionar do
Mitt[i]:=TStatObject.Create(chr(9),aar);
with opendialog1.files do
for i:=0 to count-1 do
Lesfil(strings[i]);
rad:=0;
for i:=-1 to Regionar do
if Mitt[i].antagg>0 then begin
Form1.Memo1.lines.add('Region; '+IntToStr(i)+';av '+IntToStr(regionar));
Mitt[i].Skriv(rad*9);
Form1.Memo1.lines.add('Aggregert: '+IntToStr(Mitt[i].antagg));
rad:=succ(rad);
end;
end;
end;
procedure TForm1.Avslutt1Click(Sender: TObject);
var i:integer;
begin
for i:=-1 to regionar do
Mitt[i].free;
Application.terminate;
end;
procedure TForm1.LagSample1Click(Sender: TObject);
var i:integer;
fil:TFileObject;
utfil:textfile;
begin
if (Opendialog1.execute=true) then begin
fil:=TFileObject.Create(chr(9),aar);
assignfile(utfil,'samp'+inttostr(aar)+'.txt');
rewrite(utfil);
with opendialog1.files do
for i:=0 to count-1 do begin
fil.LesSkriv(strings[i],utfil);
end;
closefile(utfil);
Form1.Memo1.lines.add('Ferdig: '+IntToStr(fil.lest)+' '+IntTostr(fil.skr));
end;
end;
procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
If Radiogroup1.ItemIndex=0 then begin
OpenDialog1.InitialDir:='d:\data\nsd\1801\';
OpenDialog1.FileName:='persfil.txt';
OpenDialog1.Filter:='*.txt|*.txt';
OpenDialog1.DefaultExt:='txt';
aar:=1801;
end
else begin
OpenDialog1.InitialDir:='d:\data\kode\';
OpenDialog1.Filter:='*.cod|*.cod';
OpenDialog1.DefaultExt:='cod';
if RadioGroup1.ItemIndex=1 then begin
OpenDialog1.FileName:='?1865*.cod';
aar:=1865
end
else begin
OpenDialog1.FileName:='?1900*.cod';
aar:=1900;
end;
end;
StringGrid1.Cells[0,0]:=IntToStr(aar);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
RadioGroup1Click(Sender);
antkomm:=0;
Regionar:=1;
StringGrid1.colcount:=7;
StringGrid1.rowcount:=50;
StringGrid1.Cells[1,0]:='1. kv';
StringGrid1.Cells[2,0]:='Menn';
StringGrid1.Cells[3,0]:='3. kv';
StringGrid1.Cells[4,0]:='1. kv';
StringGrid1.Cells[5,0]:='Kvinner';
StringGrid1.Cells[6,0]:='3. kv';
StringGrid1.Cells[0,0]:=IntToStr(aar);
StringGrid1.ColWidths[0]:=80;
end;
procedure TForm1.RadioGroup2Click(Sender: TObject);
var kommnr, kode, Fkode:integer;
linje:string;
i,mm,j,ix:integer;
delim:char;
begin
if RadioGroup2.ItemIndex=1 then
Regionar:=5
else if RadioGroup2.ItemIndex=2 then
Regionar:=7
else if RadioGroup2.ItemIndex=3 then
Regionar:=2
else
Regionar:=1;
if (RadioGroup2.ItemIndex>0) and (antkomm=0) then begin
KommTab:=TStringList.create;
delim:=chr(9);
if RadioGroup2.ItemIndex=1 then
Fkode:=1
else
if (RadioGroup2.ItemIndex=2) or (RadioGroup2.ItemIndex=3) then begin
if aar=1900 then Fkode:=5
else Fkode:=2;
end
else Fkode:=1;
for mm:=0 to 9999 do ktab[mm]:=9;
KommTab.LoadFromFile('d:\data\nsd\1900\ksp1918.txt');
for mm:=0 to KommTab.Count-1 do begin
ix:=0;
j:=0;
linje:=kommtab.strings[mm];
for i:=1 to length(linje) do begin
if (linje[i]=delim) then begin
felt[ix]:=copy(linje,j+1,i-j-1);
ix:=succ(ix);
j:=i;
end
end;
felt[ix]:=copy(linje,j+1,i-j-1);
kommnr:=StrToInt(felt[0]);
kode:=StrToInt(felt[Fkode]);
if (RadioGroup2.ItemIndex=3) and (kode>0) then kode:=1;
if (kommnr>100) and (kommnr<10000)
and (kode>=0) and (kode<10) then
ktab[kommnr]:=kode;
end;
Kommtab.free;
end;
end;
procedure TForm1.Kodhushald1Click(Sender: TObject);
var i:integer;
fil:TFileObject;
utfil:textfile;
begin
if (Opendialog1.execute=true) then begin
fil:=TFileObject.Create(chr(9),aar);
assignfile(utfil,'haml'+inttostr(aar)+'.txt');
rewrite(utfil);
with opendialog1.files do
for i:=0 to count-1 do begin
fil.SkrivHushald(strings[i],utfil);
Form1.Memo1.Lines.Add(strings[i])
end;
closefile(utfil);
Form1.Memo1.lines.add('Ferdig: '+IntToStr(fil.lest)+' '+IntTostr(fil.skr));
end;
end;
procedure TForm1.LesMatrikkel1Click(Sender: TObject);
var
fil:TFileObject;
i:integer;
utfil:textfile;
begin
OpenDialog1.InitialDir:='d:\data\mat86\org';
OpenDialog1.Filter:='*.xls|*.xls|*.txt|*.txt';
OpenDialog1.DefaultExt:='txt';
OpenDialog1.FileName:='ma*n.txt';
aar:=1886;
assignfile(utfil,'d:\data\mat86\kommagg.txt');
if OpenDialog1.Execute=true then begin
rewrite(utfil);
write(utfil,'Kommnr;antsk;sumsk;antore;sumore;snittsk;snittore;ant25;sn25;skdecentil;skmedian;oredecentil;oremedian');
write(utfil,';tot bruk;bruk 0-0.2;bruk 0.2-2;bruk 2-10; bruk 10+;pst bruk 0-0.2;pst bruk 0.2-2');
write(utfil,';pst bruk 0-35 ore;pst bruk 36-347 ore');
writeln(utfil);
fil:=TFileObject.Create(chr(9),aar);
with opendialog1.files do
for i:=0 to count-1 do begin
fil.LesMatrikkel(strings[i],utfil);
end;
// fil.Free;
Form1.Memo1.Lines.Add('Ferdig');
closefile(utfil);
end;
end;
procedure TForm1.KopierMatrikkel1Click(Sender: TObject);
var
innfil,utfil:TFileObject;
i:integer;
forste:boolean;
begin
OpenDialog1.InitialDir:='d:\data\mat86\org\';
OpenDialog1.Filter:='*.xls|*.xls|*.txt|*.txt';
OpenDialog1.DefaultExt:='txt';
OpenDialog1.FileName:='ma*n.txt';
aar:=1886;
if OpenDialog1.Execute=true then begin
utfil:=TFileOBject.create(chr(9),1886);
utfil.open('d:\data\mat86\matr1886.txt','w');
forste:=true;
with opendialog1.files do
for i:=0 to count-1 do begin
innfil:=TFileOBject.create(chr(9),1886);
innfil.open(strings[i],'r');
innfil.kopier(utfil,forste);
forste:=false;
Form1.Memo1.Lines.Add(strings[i]);
innfil.Free;
end;
Form1.Memo1.Lines.Add('Ferdig');
utfil.free
end;
end;
end.
Generated by PAS2HTML, copyrights © 1996,97 by
COAS, All rights reserved.