< ΜΕΡΟΣ Α' : ΚΩΔΙΚΑΣ ΣΕ TURBO PASCAL ΤΟΥ ΠΡΟΓΡΑΜΜΑΤΟΣ VISUAL METRIC SYSTEM - ΚΡΑΠΗΣ ΔΑΜΙΑΝΟΣ

Πρόγραμμα Visual Metric System



 

 

{ *******************************************************************

   ****                    Program Visual_Metric_System    (Part 1)        ****

   *******************************************************************

Γραμμένο από τον Κράπη Δαμιανό  το έτος: 1992 - 1993

Έκδοση 31/10/1993 ΓΙΑ IBM Combatible PC.

Το πρόγραμμα αυτό έχει γραφτεί στην TURBO PASCAL Ver.7

Έχει διαμορφωθεί έτσι ώστε να μπορεί να λειτουργεί σε όλες

τις εκδόσεις της Τurbo που είναι μεταγενέστερες της Ver.3.

Δουλεύει με λειτουργικό σύστημα MS-DOS 3.x ή μεταγενέστερο.

  *******************************************************************}

 

 

 

Program Visual_Metric_System;

{$I-,S-}

Uses

Crt,Dos,Graph,GrapScan,joystic,Form,GrWrite,printer,mouseset,Fileman; {GrafRead}

TYPE

SYNOLO=SET OF CHAR;

Const

SR=[#32,#46..#57,#65..#90,#97..#122,#128..#175,#224..#239];

Var

{colorx:Word; if colorx=15 then colorx:=0 else colorx:=colorx+1;}

c,ch:char;

valsamb:array[1..1700] of string[3];

str1,metalstr:string;

st,sst:string[2];

tanval:array[0..60] of Word;

tanbar:array[0..60] of Word;

flef,frig,lef,rig,cen,ZY,cfile,i: Word;

h,m,s,ss,ls,lss,dimcount,testtime: Word;

mtim,stim,sample,Sumtime: Real;bcolor,modetest,Chartflag,Printmode,Ymove: Byte;

BarP,BarPL,BarPh,BarLn:Pointer;

xline,xxline,yline,yyline,xcount,ycount,levTime,xstep, Lineflag:Word;

Function Error:Boolean;

Var sss:String;

Begin

If IOResult>0 Then Begin

If IOResult=2 Then OutTextXY(200-TextWidth(File Not found...) Div 2, 154,File Not found...);

If IOResult=3 Then OutTextXY(200-TextWidth(Path Not found...) Div 2, 154,Path Not found...);

If IOResult=4 Then OutTextXY(200-TextWidth(Too many open files...) Div 2, 154,Too many open files...);

If IOResult=5 Then OutTextXY(200-TextWidth(File access denied...) Div 2, 154,File access denied...);

If IOResult=6 Then OutTextXY(200-TextWidth(Invalid file handle...) Div 2, 154,Invalid file handle...);

If IOResult=12 Then OutTextXY(200-TextWidth(Invalid file access code...) Div 2,154,Invalid file access code...);

If IOResult=15 Then OutTextXY(200-TextWidth(Invalid drive number...) Div 2, 154,Invalid drive number...);

If IOResult=100 Then OutTextXY(200-TextWidth(Disk Read Error...) Div 2, 154,Disk Read Error...);

If IOResult=101 Then OutTextXY(200-TextWidth(Disk Write Error...) Div 2, 154,Disk Write Error...);

If (IOResult<>2) and

(IOResult<>3) and

(IOResult<>4) and

(IOResult<>5) and

(IOResult<>6) and

(IOResult<>12) and

(IOResult<>15) and

(IOResult<>100) and

(IOResult<>101) Then Begin

str(IOResult,sss);

OutTextXY(200-TextWidth(I/O Error # +sss+...) Div 2,154,I/O Error # +sss+...);

End;

Repeat Until KeyPressed;

Ch:=ReadKey;

End;

If IOResult=0 Then Error:=FALSE Else Error:=TRUE;

End;

 

Function Exists(ff:String; Yes:Boolean):Boolean;

Var f:text; Sr:searChrec; sss:String;

Begin

FindFirst(ff,Archive,Sr);

If DosError<>0 Then Begin

If Yes Then Begin

Rectangle(100,150,300,165);

If (DosError=2) or (DosError=18) or (DosError=3) Then

OutTextXY(200-TextWidth(File Not found...) Div 2,154,File Not found...);

If DosError=5 Then OutTextXY(200-TextWidth(File access denied...) Div 2,154,File access denied...);

If DosError=8 Then OutTextXY(200-TextWidth(Not enough memory...) Div 2, 154,Not enough memory...);

If (DosError<>2) And (DosError<>3) And (DosError<>5) and

(DosError<>8) And (DosError<>18) Then Begin

str(DosError,sss);

OutTextXY(200-TextWidth(Error # +sss+...) Div 2, 154,Error # +sss+...);

End;

Repeat Until KeyPressed;

Ch:=ReadKey;

End;

Exists:=FALSE;

End;

If DosError=0 Then Exists:=TRUE;

End;

 

PROCEDURE Title(chart:byte);

begin

SetTextStyle(2,0,4); setcolor(3);

case chart of

1: begin outtextxy(243,240,TIME CHART );

outtextxy(228,250,50o per 2 Bars);

outtextxy(487,240,SAMPLING LINE);

outtextxy(483,250,50º per 2 Lines);

end;

2: begin outtextxy(243,240,TIME CHART );

outtextxy(228,250,50º per 5 Bars);

outtextxy(487,240,SAMPLING LINE);

outtextxy(483,250,50º per 5 Lines);

end;

3: begin outtextxy(243,240,TIME CHART );

outtextxy(228,250,50º per 10 Bars);

outtextxy(487,240,SAMPLING LINE);

outtextxy(483,250,50º per 10 Lines);

end;

4: begin outtextxy(243,240,TIME CHART );

outtextxy(228,250,50º per 3 Bars);

outtextxy(487,240,SAMPLING LINE);

outtextxy(483,250,50º per 3 Lines);

end;

5: begin SetTextStyle(2,0,5); outtextxy(350,35,SAMPLING CHART);

SetTextStyle(2,0,4); outtextxy(355,50,50º per 50 Bars);

end;

6: begin outtextxy(495,240,TIME LINE);

outtextxy(455,250,+25º);

outtextxy(453,320,0º);

outtextxy(455,395,-25º);

end;

7: begin outtextxy(490,240,BALLANCE MAP );

outtextxy(450,320,+25º);

outtextxy(580,320,-25º);

end;

8: begin

IF (testtime>2) and (testtime<7) THEN begin

SetTextStyle(2,0,4); outtextxy(375,35,TIME LINE );

{SetTextStyle(2,0,3); outtextxy(370,50,Tan per Sampling time);}

end;

IF testtime>6 THEN begin

SetTextStyle(2,0,5); outtextxy(365,35,TIME LINE );

SetTextStyle(2,0,4); outtextxy(340,50,Tan per Sampling time);

end;

end;

end;

setcolor(14);

end;

 

 

PROCEDURE casewin;

begin

case testtime of

1: begin xline:=380; xxline:=414; xcount:=387; levTime:=1; xstep:=0; end;

2: begin xline:=371; xxline:=424; xcount:=378; levTime:=1; xstep:=0; end;

3: begin xline:=363; xxline:=434; xcount:=370; levTime:=1; xstep:=0; end;

4: begin xline:=354; xxline:=443; xcount:=361; levTime:=1; xstep:=0; end;

5: begin xline:=345; xxline:=452; xcount:=352; levTime:=1; xstep:=30; end;

6: begin xline:=336; xxline:=461; xcount:=343; levTime:=1; xstep:=27; end;

7: begin xline:=327; xxline:=470; xcount:=334; levTime:=1; xstep:=25; end;

8: begin xline:=318; xxline:=479; xcount:=325; levTime:=1; xstep:=24; end;

9: begin xline:=309; xxline:=488; xcount:=316; levTime:=1; xstep:=24; end;

10: begin xline:=300; xxline:=497; xcount:=307; levTime:=1; xstep:=23; end;

11: begin xline:=291; xxline:=506; xcount:=298; levTime:=1; xstep:=22; end;

12: begin xline:=282; xxline:=515; xcount:=289; levTime:=1; xstep:=22; end;

13: begin xline:=273; xxline:=524; xcount:=280; levTime:=1; xstep:=22; end;

14: begin xline:=264; xxline:=533; xcount:=271; levTime:=1; xstep:=22; end;

15: begin xline:=255; xxline:=542; xcount:=262; levTime:=1; xstep:=22; end;

16: begin xline:=246; xxline:=551; xcount:=253; levTime:=1; xstep:=21; end;

17: begin xline:=237; xxline:=560; xcount:=244; levTime:=1; xstep:=21; end;

18: begin xline:=228; xxline:=569; xcount:=235; levTime:=1; xstep:=21; end;

19: begin xline:=219; xxline:=578; xcount:=226; levTime:=1; xstep:=21; end;

20: begin xline:=210; xxline:=587; xcount:=217; levTime:=1; xstep:=21; end;

21: begin xline:=298; xxline:=504; xcount:=305; levTime:=2; xstep:=11; end;

22: begin xline:=294; xxline:=508; xcount:=301; levTime:=2; xstep:=11; end;

23: begin xline:=290; xxline:=513; xcount:=297; levTime:=2; xstep:=11; end;

24: begin xline:=286; xxline:=518; xcount:=293; levTime:=2; xstep:=11; end;

25: begin xline:=281; xxline:=523; xcount:=288; levTime:=2; xstep:=10; end;

26: begin xline:=276; xxline:=527; xcount:=283; levTime:=2; xstep:=10; end;

27: begin xline:=271; xxline:=531; xcount:=278; levTime:=2; xstep:=10; end;

28: begin xline:=266; xxline:=535; xcount:=273; levTime:=2; xstep:=10; end;

29: begin xline:=261; xxline:=539; xcount:=268; levTime:=2; xstep:=10; end;

30: begin xline:=256; xxline:=543; xcount:=263; levTime:=2; xstep:=10; end;

31: begin xline:=250; xxline:=545; xcount:=257; levTime:=2; xstep:=10; end;

32: begin xline:=246; xxline:=550; xcount:=253; levTime:=2; xstep:=10; end;

33: begin xline:=241; xxline:=556; xcount:=248; levTime:=2; xstep:=10; end;

34: begin xline:=236; xxline:=560; xcount:=243; levTime:=2; xstep:=10; end;

35: begin xline:=232; xxline:=565; xcount:=239; levTime:=2; xstep:=10; end;

36: begin xline:=228; xxline:=570; xcount:=235; levTime:=2; xstep:=10; end;

37: begin xline:=224; xxline:=574; xcount:=231; levTime:=2; xstep:=10; end;

38: begin xline:=220; xxline:=579; xcount:=227; levTime:=2; xstep:=10; end;

39: begin xline:=216; xxline:=584; xcount:=223; levTime:=2; xstep:=10; end;

40: begin xline:=212; xxline:=589; xcount:=219; levTime:=2; xstep:=10; end;

41: begin xline:=267; xxline:=530; xcount:=274; levTime:=3; xstep:=7; end;

42: begin xline:=265; xxline:=533; xcount:=272; levTime:=3; xstep:=7; end;

43: begin xline:=262; xxline:=536; xcount:=269; levTime:=3; xstep:=7; end;

44: begin xline:=259; xxline:=539; xcount:=266; levTime:=3; xstep:=7; end;

45: begin xline:=256; xxline:=542; xcount:=263; levTime:=3; xstep:=7; end;

46: begin xline:=253; xxline:=545; xcount:=260; levTime:=3; xstep:=7; end;

47: begin xline:=250; xxline:=548; xcount:=257; levTime:=3; xstep:=7; end;

48: begin xline:=247; xxline:=551; xcount:=254; levTime:=3; xstep:=7; end;

49: begin xline:=244; xxline:=554; xcount:=251; levTime:=3; xstep:=7; end;

50: begin xline:=241; xxline:=557; xcount:=248; levTime:=3; xstep:=7; end;

51: begin xline:=238; xxline:=560; xcount:=245; levTime:=3; xstep:=7; end;

52: begin xline:=235; xxline:=563; xcount:=242; levTime:=3; xstep:=7; end;

53: begin xline:=232; xxline:=566; xcount:=239; levTime:=3; xstep:=7; end;

54: begin xline:=229; xxline:=569; xcount:=236; levTime:=3; xstep:=7; end;

55: begin xline:=226; xxline:=572; xcount:=233; levTime:=3; xstep:=7; end;

56: begin xline:=223; xxline:=575; xcount:=230; levTime:=3; xstep:=7; end;

57: begin xline:=220; xxline:=578; xcount:=227; levTime:=3; xstep:=7; end;

58: begin xline:=217; xxline:=581; xcount:=224; levTime:=3; xstep:=7; end;

59: begin xline:=214; xxline:=584; xcount:=221; levTime:=3; xstep:=7; end;

60: begin xline:=211; xxline:=587; xcount:=218; levTime:=3; xstep:=7; end;

end;

end;

 

 

PROCEDURE GraphLine;

var

ms,xcenter,center, ts, grt, stepx,Ymove:Word;

sec,lsec:real;

begin

WITH REC DO

begin;

testtime:=TIME;

Ymove:=12; ycount:=110+Ymove; center:=395;

dimcount:=1;

casewin;

yline:=49+Ymove; yyline:=185+Ymove;

setfillstyle(1,7); bar(xline,Yline-30,xxline,yyline);

box(xline,Yline-30,xxline,yyline,3,5,9,4);

setfillstyle(1,0); bar(xline+6,Yline+6-30,xxline-6,yyline-6);

setlinestyle(0,0,2); setcolor(6);line(xcount,56+Ymove,xcount,177+Ymove);

Title(8);

sec:=1; lsec:=19; ts:=0; grt:=1;

for dimcount:=1 to DIMC-1 do

begin

setcolor(14); {draw-data}

i:=56+Ymove; repeat putpixel(xcount,i,12); i:=i+20; until i>186+Ymove;

moveto(xcount,ycount); ycount:=((DATA[dimcount]*2)+66+Ymove); lineto(xcount,ycount);

if dimcount=grt then begin xcount:=xcount+1; grt:=dimcount+levTime; end;

setcolor(6);

if dimcount=lsec then begin line(xcount,56+Ymove,xcount,177+Ymove); lsec:=lsec+18; end;

end;

end;

end;

 

 

PROCEDURE GraphLineSat;

var

ms,xcenter,center, ts, grt, stepx,Ymove ,i,imt,xi,mesi,lastx:Word;

sec,lsec:real;

begin

WITH REC DO

begin;

testtime:=TIME;

Ymove:=12; ycount:=110+Ymove; center:=395;

dimcount:=1;

casewin;

yline:=49+Ymove; yyline:=185+Ymove;

setfillstyle(1,7); bar(xline,Yline-30,xxline,yyline);

box(xline,Yline-30,xxline,yyline,3,5,9,4);

setfillstyle(1,0); bar(xline+6,Yline+6-30,xxline-6,yyline-6);

setlinestyle(0,0,2); setcolor(6);line(xcount,56+Ymove,xcount,177+Ymove);

Title(8);

sec:=1; lsec:=19; ts:=0; grt:=1;

for dimcount:=1 to DIMC-1 do

begin

if DATA[dimcount]>24 then setcolor(3)

else setcolor(2); {draw-data}

i:=56+Ymove; repeat putpixel(xcount,i,12); i:=i+20; until i>186+Ymove;

moveto(xcount,128); ycount:=((DATA[dimcount]*2)+66+Ymove); lineto(xcount,ycount);

if dimcount=grt then begin xcount:=xcount+1; grt:=dimcount+levTime; end;

setcolor(6); lastx:=xcount;

if dimcount=lsec then begin line(xcount,56+Ymove,xcount,177+Ymove); lsec:=lsec+18; end;

end;

Ymove:=12; ycount:=110+Ymove; center:=395;

{ dimcount:=1;

casewin;

 

sec:=1; lsec:=19; ts:=0; grt:=1;

for dimcount:=1 to DIMC-1 do

begin

setcolor(14); {draw-data}

{ i:=56+Ymove; repeat putpixel(xcount,i,12); i:=i+20; until i>186+Ymove;

{ moveto(xcount,ycount); ycount:=((DATA[dimcount] div 2)+Ymove+108); lineto(xcount,ycount);}

{ if dimcount=grt then begin

moveto(xcount,ycount); ycount:=((DATA[dimcount] div 2)+Ymove+108); lineto(xcount,ycount);

xcount:=xcount+1; grt:=dimcount+levTime;

end;

setcolor(6); lastx:=xcount;

end; }

casewin;

setcolor(15); xi:=xcount;

imt:=20; mesi:=0;

FOR i:=1 TO DIMC-1 DO

begin

mesi:=mesi+DATA[i];

if imt=i then

begin

imt:=imt+20;

mesi:=mesi div 20;

if i=20 then moveto(xi,(mesi*2)+81);

lineto(xi,(mesi*2)+81);

xi:=xi+xstep;

mesi:=0;

end;

end;

casewin;

setlinestyle(1,1,1);

setcolor(14); xi:=xcount;

moveto(xi,81+(trunc(mtim)*2));

lineto(lastx,81+(trunc(mtim)*2));

setlinestyle(0,0,1);

end;

end;

 

PROCEDURE Bares3d(barmode:byte);

var st:string[6];

lst:string[6];

yval:array[1..10] of word;

mesi:word;

xi,i,ii,iy,divval,xx,xrep,li,imt:word;

maxtan ,levTime, center, stepx, ms:word;

xcenter, ts, grt,Ymove:Word;

sec,lsec:real;

begin

maxtan:=0; divval:=0; xx:=0;

setcolor(14);

 

for xi:=1 to 10 do begin yval[xi]:=0; end;

for xi:=0 to 50 do begin tanbar[xi]:=0; end;

case barmode of

1: begin {2 bars}

divval:=4;

for xi:=0 to 24 do

begin

tanbar[1]:= tanbar[1]+tanval[xi];

tanbar[2]:= tanbar[2]+tanval[xi+25];

end;

 

if Printmode=0 then

begin

maxtan:=tanbar[1];if maxtan<tanbar[2] then maxtan:=tanbar[2];

case maxtan of 0..299:divval:=4; 300..499:divval:=5; 500..2999:divval:=8;end;

setfillstyle(9,4); bar(197,238,348,413); bar(452,238,603,413);

title(1);

setfillstyle(1,6); SetTextStyle(2,0,4); setcolor(14);

yval[1]:=400-(tanbar[1] div divval);

yval[2]:=400-(tanbar[2] div divval);

 

bar3d(205,400,250,yval[1],20,Topon);

 

bar3d(275,400,320,yval[2],20,Topon);

realform(225,yval[1]-35,14,7,tanbar[1]*sample);

realform(292,yval[2]-35,14,7,tanbar[2]*sample);

line(500,402,550,402);

circle(500,yval[1],3); line(500,yval[1],500,402);

circle(550,yval[2],3); line(550,yval[2],550,402);

line(500,yval[1],550,yval[2]);

setfillstyle(3,2); FloodFill(510,398,14);

str(tanbar[1],st); outtextxy(490,yval[1]-30,st);

str(tanbar[2],st); outtextxy(540,yval[2]-30,st);

end;

end;

2: begin {5 bars}

for xi:=0 to 9 do

begin

tanbar[1]:= tanbar[1]+tanval[xi];

tanbar[2]:= tanbar[2]+tanval[xi+10];

tanbar[3]:= tanbar[3]+tanval[xi+20];

tanbar[4]:= tanbar[4]+tanval[xi+30];

tanbar[5]:= tanbar[5]+tanval[xi+40];

end;

 

if Printmode=0 then

begin

xx:=270; xrep:=205;

maxtan:=tanbar[1];for xi:=1 to 9 do begin if maxtan<tanbar[xi] then maxtan:=tanbar[xi]; end;

case maxtan of 0..299:divval:=4; 300..499:divval:=5; 500..2999:divval:=8;end;

setfillstyle(9,4); bar(197,238,348,413); bar(452,238,603,413);

title(2);

setfillstyle(1,6); SetTextStyle(2,1,4);

 

yval[1]:=400-(tanbar[1] div divval);

yval[2]:=400-(tanbar[2] div divval);

yval[3]:=400-(tanbar[3] div divval);

yval[4]:=400-(tanbar[3] div divval);

yval[5]:=400-(tanbar[5] div divval);

end;

for xi:=1 to 5 do begin

bar3d(xrep,400,xrep+15,yval[xi],10,Topon);

realform(xrep+10,yval[xi]-45,14,7,tanbar[xi]*sample);

xrep:=xrep+25;

end;

xrep:=205;line(xrep+xx,402,xrep+xx+100,402); moveto(xrep+xx,yval[1]);

for xi:=1 to 5 do begin lineto(xrep+xx,yval[xi]); xrep:=xrep+25; end;

xrep:=205;

for xi:=1 to 5 do begin circle(xrep+xx,yval[xi],3); lineto(xrep+xx,402); xrep:=xrep+25; end;

xrep:=205; setfillstyle(3,2);

for xi:=1 to 4 do begin FloodFill(xrep+xx+5,401,14);xrep:=xrep+25; end;

xrep:=205;

for xi:=1 to 5 do begin str(tanbar[xi],st); outtextxy(xx+xrep-8,yval[xi]-35,st);xrep:=xrep+25;end;

end;

3: begin {10 bars}

for xi:=0 to 4 do

begin

tanbar[1]:= tanbar[1]+tanval[xi];

tanbar[2]:= tanbar[2]+tanval[xi+5];

tanbar[3]:= tanbar[3]+tanval[xi+10];

tanbar[4]:= tanbar[4]+tanval[xi+15];

tanbar[5]:= tanbar[5]+tanval[xi+20];

tanbar[6]:= tanbar[6]+tanval[xi+25];

tanbar[7]:= tanbar[7]+tanval[xi+30];

tanbar[8]:= tanbar[8]+tanval[xi+35];

tanbar[9]:= tanbar[9]+tanval[xi+40];

tanbar[10]:= tanbar[10]+tanval[xi+45];

end;

 

if Printmode=0 then

begin

xx:=260; xrep:=200;

maxtan:=tanbar[1];for xi:=1 to 10 do begin if maxtan<tanbar[xi] then maxtan:=tanbar[xi]; end;

case maxtan of 0..299:divval:=3; 300..499:divval:=4; 500..999:divval:=8;end;

setfillstyle(9,4); bar(197,238,348,413); bar(452,238,603,413);

title(3);

setfillstyle(1,6); SetTextStyle(2,1,4);

 

yval[1]:=400-(tanbar[1] div divval);

yval[2]:=400-(tanbar[2] div divval);

yval[3]:=400-(tanbar[3] div divval);

yval[4]:=400-(tanbar[3] div divval);

yval[5]:=400-(tanbar[5] div divval);

yval[6]:=400-(tanbar[6] div divval);

yval[7]:=400-(tanbar[7] div divval);

yval[8]:=400-(tanbar[8] div divval);

yval[9]:=400-(tanbar[9] div divval);

yval[10]:=400-(tanbar[10] div divval);

 

 

for xi:=1 to 10 do begin bar3d(xrep,400,xrep+10,yval[xi],5,Topon);

realform(xrep+2,yval[xi]-45,14,7,tanbar[xi]*sample); xrep:=xrep+14;

end;

xrep:=205;line(xrep+xx,402,xrep+xx+130,402); moveto(xrep+xx,yval[1]);

for xi:=1 to 10 do begin lineto(xrep+xx,yval[xi]); xrep:=xrep+14; end;

xrep:=205;

for xi:=1 to 10 do begin circle(xrep+xx,yval[xi],3); lineto(xrep+xx,402); xrep:=xrep+14; end;

xrep:=205;setfillstyle(3,2);

for xi:=1 to 9 do begin FloodFill(xrep+xx+5,401,14);xrep:=xrep+14; end;

xrep:=205;

for xi:=1 to 10 do begin str(tanbar[xi],st); outtextxy(xx+xrep-8,yval[xi]-35,st);xrep:=xrep+14;end;

end;

end;

4: begin

for xi:=0 to 9 do {3 bars}

begin

tanbar[1]:= tanbar[1]+tanval[xi];

tanbar[2]:= tanbar[2]+tanval[xi+10];

tanbar[3]:= tanbar[3]+tanval[xi+20];

tanbar[4]:= tanbar[4]+tanval[xi+30];

tanbar[5]:= tanbar[5]+tanval[xi+40];

end;

tanbar[1]:=tanbar[1]+tanbar[2];

tanbar[2]:= tanbar[3];

tanbar[3]:=tanbar[4]+tanbar[5];

 

if Printmode=0 then

begin

xx:=260; xrep:=210; i:=0;

maxtan:=tanbar[1];for xi:=1 to 9 do begin if maxtan<tanbar[xi] then maxtan:=tanbar[xi]; end;

case maxtan of 0..299:divval:=4; 300..499:divval:=5; 500..999:divval:=8;end;

setfillstyle(9,4); bar(197,238,348,413); bar(452,238,603,413);

title(4);

setfillstyle(1,6); SetTextStyle(2,1,4);

 

yval[1]:=400-(tanbar[1] div divval);

yval[2]:=400-(tanbar[2] div divval);

yval[3]:=400-(tanbar[3] div divval);

 

for xi:=1 to 3 do begin

if xi=2 then i:=5 else i:=0; bar3d(xrep+i,404,xrep+30-i,yval[xi],10,Topon);

realform(xrep+15+i,yval[xi]-45-i,14,7,tanbar[xi]*sample);

xrep:=xrep+40;

end;

 

xrep:=215;line(xrep+xx,402,xrep+xx+100,402); moveto(xrep+xx,yval[1]);

for xi:=1 to 3 do begin lineto(xrep+xx,yval[xi]); xrep:=xrep+50; end;

xrep:=215;

for xi:=1 to 3 do begin circle(xrep+xx,yval[xi],3); lineto(xrep+xx,402); xrep:=xrep+50; end;

xrep:=215;setfillstyle(3,2);

for xi:=1 to 2 do begin FloodFill(xrep+xx+5,398,14);xrep:=xrep+50; end;

xrep:=215;

for xi:=1 to 3 do begin str(tanbar[xi],st); outtextxy(xrep+xx-8,yval[xi]-35-i,st);xrep:=xrep+50;end;

end; end;

5:begin {50 bars}

i:=0;iy:=0;sumtime:=0;

maxtan:=tanval[0];for xi:=1 to 49 do begin if maxtan<tanval[xi] then maxtan:=tanval[xi]; end;

case maxtan of 0..99:divval:=1; 100..299:divval:=2; 300..399:divval:=4; 400..999:divval:=8;end;

setfillstyle(9,4); bar(196,31,604,199);

title(5);

setfillstyle(1,12); SetTextStyle(2,1,4);

for xi:=0 to 49 do

begin

bar3d(206+i,160,200+i,160-(tanval[xi] div divval),0,Topon);str(tanval[xi],st);

outtextxy(198+i,145-(tanval[xi] div divval),st);

RealForm(198+i,165,14,6,(tanval[xi]*sample)); sumtime:=sumtime+tanval[xi]*sample;

i:=i+8;

end;

{ SetTextStyle(0,0,0); RealForm(95,316,15,8,sumtime);}

end;

6: begin GraphLineSat;

end;

7: begin

setfillstyle(9,4);bar(452,238,603,413);

title(7);

i:=0;

setcolor(2);

i:=475; repeat line(i,275,i,375); i:=i+10; until i>575;

i:=275; repeat line(475,i,575,i); i:=i+10; until i>375;

setcolor(14);

rectangle(475,275,575,375);

setcolor(14);

i:=475; repeat line(i,324,i,326); i:=i+2; until i>575;

i:=275; repeat line(524,i,526,i); i:=i+2; until i>375;

setcolor(15);

circle(475+trunc(mtim*2),325,1);

circle(475+trunc(mtim*2),325,2);

circle(475+trunc(mtim*2),325,trunc(stim));

end;

end;

End;

 

PROCEDURE clearname;

begin

setfillstyle(1,7);bar(35,130,170,220); box(35,130,170,220,0,7,7,4);

SetTextStyle(2,0,4);

box(70,138,160,152,1,7,7,4); setcolor(0); outtextxy(39,140,FIRST); {BOX ONOMATVN}

box(70,138+20,160,152+20,1,7,7,4); setcolor(0); outtextxy(40,140+20,LAST);

box(70,138+40,160,152+40,1,7,7,4); setcolor(0); outtextxy(40,140+40,DATE);

box(70,138+60,160,152+60,1,7,7,4); setcolor(0); outtextxy(40,140+60,SPOR);

end;

 

PROCEDURE clearwin;

begin

setfillstyle(9,4); bar(197,238,348,413);

setfillstyle(9,4); bar(452,238,603,413); setfillstyle(1,6);

setfillstyle(9,4); bar(196,31,604,199); {BOX WINDOWS}

{setfillstyle(6,7); bar(196,65,604,199);}

{ setcolor(6); i:=56; repeat line(216,i,585,i); i:=i+20; until i>186;

{ setcolor(12); line(216,56,216,176); line(585,56,585,176);}

{setcolor(12);line(216,116,585,116);}

 

setfillstyle(1,6); bar(56,46,154,94);

box(70,138,160,152,1,7,7,4);

box(70,138+20,160,152+20,1,7,7,4);

box(70,138+40,160,152+40,1,7,7,4);

box(70,138+60,160,152+60,1,7,7,4);

 

setfillstyle(1,7);bar(100,230,160,270); box(100,230,160,270,2,5,1,6); {BOX TAG}

bar(100,280,160,300);box(100,280,160,300,0,7,7,4);

bar(100,280+30,160,300+30);box(100,280+30,160,300+30,0,7,7,4); {BOX STATISTIC}

bar(100,280+60,160,300+60);box(100,280+60,160,300+60,0,7,7,4);

bar(100,280+90,160,300+90);box(100,280+90,160,300+90,0,7,7,4);

Title(3); Title(8);

end;

 

 

PROCEDURE stat;

var st:string[2];

lst:string[2];

timesam:real;

ms:word;

i:word;

begin

WITH REC DO begin

sample:=((TIME*100)/DIMC);

dimcount:=DIMC;

timesam:=0 ;stim:=0; mtim:=0;

 

for i:=0 to 50 do tanval[i]:=0;

for i:=1 to DIMC do

begin

tanval[DATA[i]]:=tanval[DATA[i]]+1; {atrisma kata sixnotita}

mtim:=mtim+DATA[i];

end;

mtim:=mtim/DIMC;

for i:=1 to DIMC do

begin

stim:=stim+sqr(mtim-data[i]);

end;

 

 

stim:=stim/dimc-1;IF stim<0 then stim :=0;

stim:=sqrt(stim);

end;

SetTextStyle(0,0,0);

RealForm(115,286,15,4,dimcount);

RealForm(95,316,15,8,sample);

RealForm(98,346,15,7,mtim);

RealForm(98,376,15,7,stim);

end;

 

 

 

PROCEDURE Test;

var st,lst,jst:string[2];

lms,tms:string[10];

mi,tm,sample,timesam:Real;

mj,de,lss:Byte;

ms,xcenter,center, stepx,Ymove, dc, mvx,mvy ,ts,grt:Word;

myval,lmyval,sec,lsec:real;

begin

clearwin;

Ymove:=12; ycount:=110+Ymove; center:=395;

dimcount:=1; dc:=1;

casewin;

yline:=49+Ymove; yyline:=185+Ymove;

setfillstyle(1,7); bar(xline,Yline-30,xxline,yyline);

box(xline,Yline-30,xxline,yyline,3,5,9,4);

setfillstyle(1,0); bar(xline+6,Yline+6-30,xxline-6,yyline-6);

ts:=0; grt:=1; jst:= ; setlinestyle(0,0,2);

setcolor(6);line(xcount,56+Ymove,xcount,177+Ymove);

Title(8);

WITH REC DO

begin;

myval:=MemW[$0040:$006C]; lmyval:=myval+1; sec:=myval+1; lsec:=myval+19;

repeat

repeat myval:=MemW[$0040:$006C] until myval=lmyval; lmyval:=myval+1; sec:=myval;

GetJoyPos( jsp[1], jsp[2] ); mj:=jsp[1].y; {dim-data}

gettime(h,m,s,ss);

DATA[dimcount]:=mj div 5; {data[]=value tan}

setcolor(14);

i:=56+Ymove; repeat putpixel(xcount,i,12); i:=i+20; until i>186+Ymove;

moveto(xcount,ycount); {draw-data}

ycount:=((DATA[dimcount]*2)+66+Ymove);

lineto(xcount,ycount);

SetTextStyle(0,0,2);

setcolor(6);outtextxy(115,245,jst+);

jst:=LeadingZero(DATA[dimcount]);

setcolor(12); outtextxy(115,245,jst+);

if dimcount=grt then begin xcount:=xcount+1; grt:=dimcount+levTime; end;

if sec=lsec then

begin

setcolor(6);line(xcount,56+Ymove,xcount,177+Ymove);

lsec:=sec+18; inc(ts,1);

SetTextStyle(0,0,3); {write s}

setcolor(6);outtextxy(78,60,lst);

lst:=LeadingZero(ts);

setcolor(12); outtextxy(78,60,lst);

end;

inc(dimcount,1);

until (ts=testtime) or keypressed;

DIMC:=dimcount; {dim of final sampling}

TIME:=testtime; {test time }

{writer(120,316,dimcount,15);}

SetTextStyle(0,0,0);

{ RealForm(110,286,15,4,dimcount);}

stat;

Bares3d(3);

end;

end;

 

 

PROCEDURE SCRLOAD(mode:byte);

var sample,timesam:real;

i:WORD;

xcount,ycount:word;

drawcount:word;

Begin

if mode=0 then begin clearname; end;

if mode=1 then begin

{setfillstyle(7,4); bar(196,31,604,199);setcolor(12); line(195,115,605,115);}

end

else clearwin;

title(8);

WITH REC DO

BEGIN

case lineflag of

0:begin GraphLineSat; end;

1: begin GraphLine; end;

end;

dimcount:=DIMC;

SetTextStyle(0,0,3);

setcolor(12); outtextxy(78,60,LeadingZero(TIME));

for i:=1 to dimcount do str(DATA[i],valsamb[i]);

for i:=1 to 50 do tanval[i]:=0;

for i:=1 to dimcount do tanval[DATA[i]]:=tanval[DATA[i]]+1;

SetTextStyle(2,0,4);

setcolor(14);

outtextxy(75,140,FNAM);

outtextxy(75,160,LNAM);

outtextxy(75,180,DATE);

outtextxy(75,200,SPOR);

end;

End;

PROCEDURE chart;

begin

case chartflag of

0:begin

Bares3d(5); chartflag:=1; end;

1: begin SCRLOAD(1); STAT; chartflag:=0; end;

end;

End;

 

 

PROCEDURE exitproc;

begin

if cur>0 then begin

freemem(g1,imagesize(0,0,b-1,a-1));

freemem(g2,imagesize(0,100,b-1,100+a-1));

end;

closegraph;

halt(0);

end;

 




Copyrigth 1992 - 2007 Κράπης Δαμιανός







p?? ???(e-mail)

ΠΡΟΗΓΟΥΜΕΝΟ
ΑΡΧΗ
ΕΠΟΜΕΝΟ