Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Скачиваний:
15
Добавлен:
17.04.2013
Размер:
2 Кб
Скачать
Program XXX;
{$L EGAVGA.OBJ}
 {51875}
Uses CRT,DOS, GRAPH;
Var
   D:Char;
   I,II,III,J,JJ:Integer;
   T,TK:Real;
   TF,GF,EF,YF,UF:Array[0..500] Of Real;
   FF:File Of Real;
   G,Y,E,U:Real;

Procedure UY;
   Var
     UC,T,P:Byte;
     UI:Integer;
Begin
   UI:=ROUND(U*128+128);
   If UI<0 Then UI:=0;
   If (UI>255) Then UI:=255;
   T:=UI;
   Asm
    CLI;
   End;
   Repeat
    P:=Port[$31E];
   Until P=127;
   Port[$31F]:=T;
   UC:=Port[$31F];
   Asm
    STI
   End;
   Y:=(UC-128)/128-0.5;
End;

Procedure PPP;
 Begin
     Writeln('   T           G          E          U           Y');
     For II:=0 To 20 Do
      Begin
        I:=II*25;
        Writeln(TF[I]:7:3,GF[I]:11:3,EF[I]:11:3,UF[I]:11:3,YF[I]:11:3);
      End;
     Readln;
 End;


Begin
  TEXTATTR:=58;
  CLRSCR;

 Repeat
  TEXTATTR:=111;
  CLRSCR;

  For I:=1 To 10 Do Writeln(' ');
  Writeln('                   1.‚‚Ћ„ ЏЂђЂЊ…’ђЋ‚.');
  Writeln('                   2.ЊЋ„…‹€ђЋ‚ЂЌ€… .');
  Writeln('                   3.‡ЂЏ€‘њ ');
  Writeln('                   4.—’…Ќ€… ');
  Write('                   0.ЉЋЌ…– ђЂЃЋ’›. -------->');
  While Not (D In ['0'..'4']) Do D:=READKEY;
  Readln(D);
  If D='1' Then
        Begin

        End;

  If D='2' Then
    Begin
     TEXTATTR:=111;
     CLRSCR;

     TK:=TF[2]-TF[1];
     S1:=0;S2:=0;S3:=0;
     For I:=1 To 500 Do
      Begin
          TF[I]:=TK*I;

          GF[I]:=SIN(I*6.28/500);
          EF[I]:=SIN(I*3.141/500);
          UF[I]:=1;
          YF[I]:=1;

     End;
     PPP;

    End;

  If D='3' Then
    Begin
     Assign(FF,'RA.DAT');
     Rewrite(FF);
     For I:=0 To 500 Do
      Begin
        Write(FF,TF[I]);
        Write(FF,GF[I]);
        Write(FF,EF[I]);
        Write(FF,UF[I]);
        Write(FF,YF[I]);
      End;
     Close(FF);
    End;


  If D='4' Then
    Begin
     Assign(FF,'RA.DAT');
     Reset(FF);
     I:=0;
     {If IORESULT=0 Then  }
      While Not EOF (FF) Do Begin
       Read(FF,TF[I]);
       Read(FF,GF[I]);
       Read(FF,EF[I]);
       Read(FF,UF[I]);
       Read(FF,YF[I]);
      INC (I);
     End;
     Close(FF);
     PPP;
   End;

 Until D='0';
End.

Соседние файлы в папке curstau