Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:

KURSOV~1 / DIAGS

.PAS
Скачиваний:
4
Добавлен:
16.12.2013
Размер:
3.56 Кб
Скачать
unit diags;
interface
uses graph;
type DMR=array[1..1] of real;
DMS=array[1..1] of string;

var MasR:^DMR;
MasS:^DMS;
procedure Legend(var Mas_N:DMS; N, x0, y0, xk, yk:integer; St:string);
{‘®§¤ св «ҐЈҐ­¤г}
procedure Stolbik(var Mas_G:DMR; N: integer; x0,y0,xk,yk:integer);
{‘в®«ЎЁЄ®ў п ¤Ё Ја ¬¬ }
procedure Krug (var Mas_G:DMR;n,x0,y0,xk,yk:integer);
{ЉагЈ®ў п ¤Ё Ја ¬¬ }
procedure initgr;
{€­ЁжЁ «Ё§ жЁп Ја дЁЄЁ}
implementation
procedure Legend(var Mas_N:DMS; N, x0, y0, xk, yk:integer; St:string);
var c, k, x, y, i:integer;
begin
SetTextJustify(CenterText, Centertext);
St:='„Ё Ја ¬¬  Ї®«п '+St;
OuttextXy(320, 290, St);
SetFillStyle(1, 1);
SetColor(14);
Bar(x0,y0,xk,yk);
Rectangle(x0,y0,xk,yk);
SettextJustify(LeftText, Centertext);
x:=x0+20;
y:=y0+20;
K:=1;
for i:=1 to N do begin
if i mod 6=0 then k:=k+1;
c:=i mod 5+2;
setfillstyle(k,c);
bar(x-7, y-7, x+7, y+7);
SetColor(7);
rectangle(x-7, y-7, x+7, y+7);
outtextxy(x+15, y, Mas_N[i]);
y:=y+30;
if i mod 5=0 then
begin
x:=x+100;
y:=y0+20;
end;
end;
end;

procedure Stolbik(var Mas_G:DMR; N, x0, y0, xk, yk:integer);
var i,dy,dx,x,y,mx,my,d, c:integer;
max:real;
gmx,gmy,k:integer;
st:string;
begin
setfillstyle(1,1);
gmx:=getmaxx; {Ї®«г祭ЁҐ Max Є®«-ў  в®зҐЄ Ї® •}
gmy:=getmaxy; {Ї®«г祭ЁҐ Max Є®«-ў  в®зҐЄ Ї® Y}
if xk>gmx then xk:=gmx;
if yk>gmy then yk:=gmy;
bar(x0,y0,xk,yk);
rectangle(x0,y0,xk,yk);
my:=yk-y0; mx:=xk-x0;
{****** ђЁб㥬 ЋбЁ *******}
dx:=mx div (n+2); {иЁаЁ­  бв®«ЎЁЄ }
dy:=my div 6;
x0:=x0+dx;
y0:=y0+dy;
yk:=yk-dy;
xk:=xk-dx;
line(x0,y0-20,x0,yk); {®бм •}
outtextxy(x0-15,y0-15,'Y');
line(x0,yk,xk,yk); {®бм Y}
outtextxy(xk,yk+10,'X');
my:=yk-y0; {Max ўлб®в  бв®«ЎЁЄ }
max:=Mas_G[1];
for i:=2 to n do
if Mas_G[i]>max then max:=Mas_G[i];
str(max:4:1,st);
outtextxy(x0+dx,y0-dy div 2,st);
x:=x0;y:=y0;d:=dx div 6;
k:=1;
for i:=1 to n do begin
if i mod 6=0 then k:=k+1;
dy:=round(Mas_G[i]/max*my);
y:=yk-dy;
c:=i mod 5+2;
setfillstyle(k, c);
bar3d(x,y,x+dx-d, yk,dx div 4, true);
rectangle(x,y,x+dx-d,yk);
if Mas_G[i]=max then line (x0,y,x,y);
str(i,st);
outtextxy(x+dx div 2,yk+10,st);
x:=x+dx;
end;
end;

procedure Krug (var Mas_G:DMR; n,x0,y0,xk,yk:integer);
var y01, x, k, c, d,i,dy,mx,my,r,y,y_n,y_k:integer;
s:real;
st:string;
begin
y01:=y0;
Setfillstyle(1,1); setcolor(14);
bar(x0,y0,xk,yk);{Єў ¤а в}
rectangle(x0,y0,xk,yk); {а ¬Є }
my:=yk-y0;
mx:=xk-x0;
y0:=y0+(my div 2);
x0:=x0+y0; {Є®®а¤. жҐ­а  }
s:=0;
for i:= 1 to n do s:=s+mas_g[i];
y_k:=0;
y_n:=0;
d:=my div 6;
r:=(my div 2)-d;
{*********Џ®бва.*************}
K:=1;
For i:=1 to n do
begin
if i mod 6=0 then k:=k+1;
y:=round(mas_g[i]*360/s);
y_n:=y_k;
y_k:=y_k+y;
if i=n then y_k:=360;
c:=i mod 5+2;
Setcolor(7);
setfillstyle(k, c);
pieslice(x0,y0,y_n,y_k,r);
end;
SettextJustify(LeftText, Centertext);
x:=x0*2+20;
y:=y01+20;
K:=1;
for i:=1 to N do begin
if i mod 6=0 then k:=k+1;
c:=i mod 5+2;
setfillstyle(k,c);
bar(x-7, y-7, x+7, y+7);
SetColor(7);
rectangle(x-7, y-7, x+7, y+7);
str(Mas_G[i]:5:0, St);
outtextxy(x+10, y, St);
y:=y+30;
if i mod 8=0 then
begin
x:=x+100;
y:=y01+20;
end;
end;

end;

procedure initgr;
var gm,gn:integer;
begin
gm:=0;
gn:=0;
initgraph(gn,gm,'c:\tp\bgi');
end;
end.
Соседние файлы в папке KURSOV~1
  • #
    16.12.201324.06 Кб71.DOC
  • #
    16.12.2013434 б4DATA.DAT
  • #
    16.12.20133.56 Кб4DIAGS.PAS
  • #
    16.12.20136.27 Кб3DIAGS.TPU
  • #
    16.12.20131.65 Кб4DMOUSE.PAS
  • #
    16.12.20131.74 Кб3DMOUSE.TPU
  • #
    16.12.201317.79 Кб3FFILE.PAS
  • #
    16.12.201330.93 Кб3FFILE.TPU