Πρόγραμμα 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-} UsesCrt,Dos,Graph,GrapScan,joystic,Form,GrWrite,printer,mouseset,Fileman; {GrafRead} TYPESYNOLO=SET OF CHAR;ConstSR=[#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: beginIF (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 beginSetTextStyle(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 DObegin 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 DObegin; 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 DOBEGIN 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 Κράπης Δαμιανός
|