KURSOV~1 / MENUSHKA

.PAS
Скачиваний:
Добавлен:
16.12.2013
Размер:
15.56 Кб
Скачать
☆
unit menushka;
interface
uses crt,graph,ffile,menu,mdl,mouse, menuwork;

type DMR=array[1..1] of real;
     DMS=array[1..1] of string;

 var MasR:^DMR;
     MasS:^DMS;
 var swp1,swp2:base;
{Procedure Open_fl(var fl:t_file; var nf:string; kod: byte);}
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 punkt_2;
procedure punkt_3;
procedure punkt_1;
Procedure punkt_5;
procedure change(i,j:integer);
procedure sort(priznak:integer;pole:integer);
procedure initgr;
procedure punkt_gr;
implementation

procedure punkt_gr;
var td,pg:integer;
begin
MakeVertMenu(33,2,2,s7);
pg:=MouseVert(33,2,6,2,3,s7,con);

case pg of
1: begin  {ЉагЈ®ў п}
   MakeVertMenu(49,2,7,s8);
   td:=MouseVert(49,2,8,7,4,s8,con);
   window(1,1,80,25);
   GetMem(MasR, nz*sizeof(real));
   GetMem(MasS, nz*sizeof(string));
            Assign(f,'temp.dat');
            Reset(f);
            for i:=1 to nz do
            begin
            Read(f,zt);
            MasS^[i]:=zt.name;
            case td of
            1:begin
              MasR^[i]:=zt.nd;
              St:=' жЁ® «мл© ¤®е®¤';
              end;
            2:begin
              MasR^[i]:=zt.de;
              St:='¤®е®¤ ®в нЄбЇ®ав ';
              end;
            3:begin
              MasR^[i]:=zt.ri;
              St:='а бе®¤   Ё¬Ї®ав';
              end;
            4:begin
              MasR^[i]:=zt.otn1;
              St:='';
              end;
            5:begin
              MasR^[i]:=zt.otn2;
              St:='';
              end;
            6:begin
              MasR^[i]:=zt.otn3;
              St:='';
              end;
            7:begin
              MasR^[i]:=zt.otn4;
              St:='';
              end;
            end;
            end;
            Close(f);
            initgr;
            Legend(MasS^, nz, 10, 300, 630, 470, St);
            Krug (MasR^, nz,10,10,630,280);
            Readkey;
            CloseGraph;
            Cursor(off);

end;
2: begin  {‘в®«ЎЁЄ®ў п}
   MakeVertMenu(49,2,7,s8);
   td:=MouseVert(49,2,8,7,4,s8,con);
   window(1,1,80,25);
   GetMem(MasR, nz*sizeof(real));
   GetMem(MasS, nz*sizeof(string));
            Assign(f,'temp.dat');
            Reset(f);
            for i:=1 to nz do
            begin
            Read(f,zt);
            MasS^[i]:=zt.name;
            case td of
            1:begin
              MasR^[i]:=zt.nd;
              St:=' жЁ® «мл© ¤®е®¤';
              end;
            2:begin
              MasR^[i]:=zt.de;
              St:='¤®е®¤ ®в нЄбЇ®ав ';
              end;
            3:begin
              MasR^[i]:=zt.ri;
              St:='а бе®¤   Ё¬Ї®ав';
              end;
            4:begin
              MasR^[i]:=zt.otn1;
              St:='';
              end;
            5:begin
              MasR^[i]:=zt.otn2;
              St:='';
              end;
            6:begin
              MasR^[i]:=zt.otn3;
              St:='';
              end;
            7:begin
              MasR^[i]:=zt.otn4;
              St:='';
              end;
            end;
            end;
            Close(f);
            initgr;
            Legend(MasS^, nz, 10, 300, 630, 470, St);
            Stolbik(MasR^, nz,10,10,630,280);
            Readkey;
            CloseGraph;
            Cursor(off);

end;
end;
end;




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:='Diagramma polya '+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;

{Risuet stolbikovuyu diagrammu ispolzuya dinam. massiv znacheniy, dalee:
kol-vo zapisey, koordinaty fonovogo pryamougolnika}
 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;

{Risuet krugovuyu diagrammu ispolzuya dinam. massiv znacheniy, dalee:
ih kol-vo, koordinaty fonovogo pryamougolnika}
 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;

{menu fail}
PROCEDURE punkt_1;
var x,y,x0,y0:byte;

begin
MakeVertMenu(1,2,4,s2);
p1:=MouseVert(1,2,6,4,1,s2,con);
window(1,1,80,25);
gotoxy(1,11);
writeln(chr(204));
textbackground(2);
textcolor(7);


       case p1 of
1:begin cursor(on);create;cursor(off);end;



2:begin
     clrscr;
     SelectF;
     window(1,1,80,25);
  end;

3: begin
       clrscr;
{$I-}
repeat
clrscr;
window(1,1,80,25);
clrscr;
obramlenie(1,1,80,25,26,$9,$f);
obramlenie(12,7,68,17,0,$7,$f);
textcolor(0);
gotoxy(3,3);
write('BўҐ¤ЁвҐ Ё¬п д ©«  ¤«п аҐ§г«мв в®ў Ё«Ё Esc ¤«п ®в¬Ґл:');
window(14,11,65,11);
textbackground(9);
textcolor(15);
clrscr;
ch:=readkey; if ch=#27 then begin window(1,1,80,25);exit;end;
write (ch);
readln(path_o);
path_o:=ch+path_o;
assign (fo,path_o);
reset (fo);
window(14,12,65,15);
textcolor(0);
textbackground(7);
k:=ioresult;
if k=0 then begin
repeat
gotoxy(10,5);
writeln;
writeln ('               ',path_o, '-г¦Ґ бгйҐбвўгҐв');
gotoxy(10,7);
writeln ('                ЏҐаҐ§ ЇЁб вм ?(Y/N)');
ch:=upcase(readkey)
until ch in ['N', 'Y'];
if ch='Y' then rewrite (fo)
else k:=1;
end
else begin rewrite (fo); k:=0; end;
if k>0 then
writeln (path_o, '-гЄ § ®Ґ Ё¬п ҐўҐа®, Ї®Їа®Ўг©вҐ Ґйс а §');
until k=0;
{$I+}
window(1,1,80,25);
clrscr;
end;





   4:  begin;clrscr;exit;end;

       end;
       cursor(off);
end;



PROCEDURE punkt_5;
begin clrscr;
        textbackground(0);textcolor(4);

        for i:=15 to 62 do begin
        gotoxy(i,6);write(chr(205));
        gotoxy(i,19);write(chr(205));
        end;

        gotoxy(63,6);writeln(chr(187));
        gotoxy(63,19);writeln(chr(188));

        for i:=7 to 18 do begin
        gotoxy(63,i);writeln(chr(186));
        end;

        for i:=7 to 18 do begin
        gotoxy(14,i);writeln(chr(186));
        end;

        gotoxy(14,6);write(chr(201));
        gotoxy(14,19);write(chr(200));

        window(15,7,62,18);clrscr;
        gotoxy(15,5);
        testdisk;
        clrscr;window(1,1,80,25);textbackground(2);textcolor($e); clrscr;end;



PROCEDURE punkt_2;
var
p4:integer;
o:integer;
I:integer;
fil,t:t_filer;
key1:byte;
label a;
begin
   MakeVertMenu(17,2,6,s5);
   p4:=MouseVert(17,2,7,6,2,s5,con);
   window(1,1,80,25);
case p4 of
1:punkt_3;
2: begin
   clrscr;
   print;
   readkey;
   end;
3: AddZap;
4:begin
  print;
  gotoxy(23,20);
  write('‚ўҐ¤ЁвҐ ®¬Ґа г¤ «пҐ¬®© § ЇЁбЁ ');
  readln(d);
  RemZap(d);
  print;
  readkey;
  end;

5:save;
6:begin clrscr;exit;end;
end;
end;
{-------------------------}
{------------------------}
procedure sort(priznak:integer;pole:integer);
  begin
  assign(f,path);
  reset(f);
  case priznak of
 1:begin
     for i:=1 to n-1 do
     for j:=i+1 to n do
      case pole of
      1:begin
        seek(f,dmas^[i]-1);
        read(f,swp1);
        seek(f,dmas^[j]-1);
        read(f,swp2);
        if swp1.name>swp2.name then change(i,j);
        end;
      2:begin
        seek(f,dmas^[i]-1);
        read(f,swp1);
        seek(f,dmas^[j]-1);
        read(f,swp2);
        if swp1.nd>swp2.nd then change(i,j);
        end;
      3:begin
        seek(f,dmas^[i]-1);
        read(f,swp1);
        seek(f,dmas^[j]-1);
        read(f,swp2);
        if swp1.de>swp2.de then change(i,j);
        end;
      4:begin
        seek(f,dmas^[i]-1);
        read(f,swp1);
        seek(f,dmas^[j]-1);
        read(f,swp2);
        if swp1.ri>swp2.ri then change(i,j);
        end;
      5:begin
        seek(f,dmas^[i]-1);
        read(f,swp1);
        seek(f,dmas^[j]-1);
        read(f,swp2);
        if swp1.otn1>swp2.otn1 then change(i,j);
        end;
      6:begin
        seek(f,dmas^[i]-1);
        read(f,swp1);
        seek(f,dmas^[j]-1);
        read(f,swp2);
        if swp1.otn2>swp2.otn2 then change(i,j);
        end;
      7:begin
        seek(f,dmas^[i]-1);
        read(f,swp1);
        seek(f,dmas^[j]-1);
        read(f,swp2);
        if swp1.otn3>swp2.otn3 then change(i,j);
        end;
      8:begin
        seek(f,dmas^[i]-1);
        read(f,swp1);
        seek(f,dmas^[j]-1);
        read(f,swp2);
        if swp1.otn4>swp2.otn4 then change(i,j);
        end;
            end;
    end;
 0:begin
    for i:=1 to n-1 do
     for j:=i+1 to n do
      case pole of
      1:begin
        seek(f,dmas^[i]-1);
        read(f,swp1);
        seek(f,dmas^[j]-1);
        read(f,swp2);
        if swp1.name<swp2.name then change(i,j);
        end;
      2:begin
        seek(f,dmas^[i]-1);
        read(f,swp1);
        seek(f,dmas^[j]-1);
        read(f,swp2);
        if swp1.nd<swp2.nd then change(i,j);
        end;
      3:begin
        seek(f,dmas^[i]-1);
        read(f,swp1);
        seek(f,dmas^[j]-1);
        read(f,swp2);
        if swp1.de<swp2.de then change(i,j);
        end;
      4:begin
        seek(f,dmas^[i]-1);
        read(f,swp1);
        seek(f,dmas^[j]-1);
        read(f,swp2);
        if swp1.ri<swp2.ri then change(i,j);
        end;
      5:begin
        seek(f,dmas^[i]-1);
        read(f,swp1);
        seek(f,dmas^[j]-1);
        read(f,swp2);
        if swp1.otn1<swp2.otn1 then change(i,j);
        end;
      6:begin
        seek(f,dmas^[i]-1);
        read(f,swp1);
        seek(f,dmas^[j]-1);
        read(f,swp2);
        if swp1.otn2<swp2.otn2 then change(i,j);
        end;
      7:begin
        seek(f,dmas^[i]-1);
        read(f,swp1);
        seek(f,dmas^[j]-1);
        read(f,swp2);
        if swp1.otn3<swp2.otn3 then change(i,j);
        end;
      8:begin
        seek(f,dmas^[i]-1);
        read(f,swp1);
        seek(f,dmas^[j]-1);
        read(f,swp2);
        if swp1.otn4<swp2.otn4 then change(i,j);
        end;

    end;
            end;
  end;
  close(f);
  end;
{------------------------}
procedure change(i,j:integer);
   var sc:integer;
   begin
          sc:=dmas^[i];
          dmas^[i]:=dmas^[j];
          dmas^[j]:=sc;
   end;
PROCEDURE punkt_3;
var o:integer;
    t:t_filer;
    begin
   MakeVertMenu(33,2,9,s3);
   p2:=MouseVert(33,2,10,9,3,s3,con);
   case p2 of
   1:begin
     MakeVertMenu(49,2,3,s4);
     p3:=MouseVert(49,2,4,3,4,s4,con);
   window(1,1,80,25);
   textbackground(2);textcolor($e);
    case p3 of
        1:begin sort(0,1);exit;end;
        2:begin sort(1,1);exit;end;
        3:begin clrscr;exit;end;
    end;

    end;



   2:begin
     MakeVertMenu(49,2,3,s4);
     p3:=MouseVert(49,2,4,3,4,s4,con);
   window(1,1,80,25);
   textbackground(2);textcolor($e);
   case p3 of
        1:begin sort(0,2);exit;end;
        2:begin sort(1,2);exit;end;
        3:begin clrscr;exit;end;
        end;
    end;


3:  begin
     MakeVertMenu(49,2,3,s4);
     p3:=MouseVert(49,2,4,3,4,s4,con);
   window(1,1,80,25);
   textbackground(2);textcolor($e);
   case p3 of
        1:begin sort(0,3);exit;end;
        2:begin sort(1,3);exit;end;
        3:begin clrscr;exit;end;
        end;
   end;

4:
   begin
     MakeVertMenu(49,2,3,s4);
     p3:=MouseVert(49,2,4,3,4,s4,con);
   window(1,1,80,25);
   textbackground(2);textcolor($e);
    case p3 of
        1:begin sort(0,4);exit;end;
        2:begin sort(1,4);exit;end;
        3:begin clrscr;exit;end;
     end;
    end;

5:

        begin
     MakeVertMenu(49,2,3,s4);
     p3:=MouseVert(49,2,4,3,4,s4,con);
   window(1,1,80,25);
   textbackground(2);textcolor($e);
    case p3 of
        1:begin sort(0,5);exit;end;
        2:begin sort(1,5);exit;end;
        3:begin clrscr;exit;end;
     end;
       end;
6:

        begin
     MakeVertMenu(49,2,3,s4);
     p3:=MouseVert(49,2,4,3,4,s4,con);
   window(1,1,80,25);
   textbackground(2);textcolor($e);
    case p3 of
        1:begin sort(0,6);exit;end;
        2:begin sort(1,6);exit;end;
        3:begin clrscr;exit;end;
     end;
       end;
7:
        begin
     MakeVertMenu(49,2,3,s4);
     p3:=MouseVert(49,2,4,3,4,s4,con);
   window(1,1,80,25);
   textbackground(2);textcolor($e);
    case p3 of
        1:begin sort(0,7);exit;end;
        2:begin sort(1,7);exit;end;
        3:begin clrscr;exit;end;
     end;
       end;
8:

        begin
     MakeVertMenu(49,2,3,s4);
     p3:=MouseVert(49,2,4,3,4,s4,con);
   window(1,1,80,25);
   textbackground(2);textcolor($e);
    case p3 of
        1:begin sort(0,8);exit;end;
        2:begin sort(1,8);exit;end;
        3:begin clrscr;exit;end;
     end;
       end;

9:     begin;clrscr;exit;end;
end;end;

end.
Соседние файлы в папке KURSOV~1
#
16.12.201330.93 Кб3FFILE.TPU
#
16.12.20134.25 Кб3FFIND.PAS
#
16.12.20135.42 Кб3FFIND.TPU
#
16.12.2013668 б3HELP.TXT
#
16.12.20132.76 Кб3MENU.PAS
#
16.12.201315.56 Кб3MENUSHKA.PAS
#
16.12.201326.77 Кб4MENUSHKA.TPU
#
16.12.20136.95 Кб3MENUWORK.PAS
#
16.12.201310.46 Кб4MENUWORK.TPU
#
16.12.20131.43 Кб3MOUSE.PAS
#
16.12.20132.03 Кб3MOUSE.TPU