Соединение заставки с программой

{$N+}
 
Uses Graph;
Type
  TPoint =
    Record
      X, Y: Integer;
    End;
  PArrPoint = ^arrPoint;
  arrPoint =
    Array[1 .. maxInt Div SizeOf(TPoint)] Of TPoint;
 
  TFigure =
    Object
      nPoints: Byte;
      arr: PArrPoint;
 
      p: Integer;
      a: Double;
 
      Constructor Init(np: Integer;
        pVal: Integer; aVal: Double);
      Destructor Done;
      Procedure Run;
 
    Private
      Procedure InitPoints;
 
      Function Recalc: Boolean;
      Procedure Draw;
    End;
 
Constructor TFigure.Init(np: Integer;
            pVal: Integer; aVal: Double);
  Begin
    nPoints := np;
    a := aVal; p := pVal;
    GetMem(arr, nPoints * SizeOf(TPoint));
 
    InitPoints
  End;
 
Destructor TFigure.Done;
  Begin
    FreeMem(arr, nPoints * SizeOf(TPoint));
  End;
 
Procedure TFigure.InitPoints;
 
  Const
    RadToGrad = (180 / Pi);
 
  Procedure GetPoint(Var P: TPoint;
            Len: Integer; phi: Integer);
    Var fPhi: Double;
    Begin
      fPhi := phi / RadToGrad;
      P.X := (GetMaXX div 2) + Trunc(Len * Sin(fPhi));
      P.Y := (GetMaxY div 2) - Trunc(Len * Cos(fPhi));
    End;
 
  Var
    i, Len, phi: Integer;
    x: Double;
  Begin
    phi := 360 div nPoints;
    x := Cos(phi / RadToGrad);
    Len := Trunc(p / Sqrt(2* (1 - x)));
 
    For i := 1 To nPoints Do
      GetPoint(arr^[i], Len, Pred(i) * phi);
  End;
 
Function TFigure.Recalc: Boolean;
  Var
    T: PArrPoint;
    i, next: Integer;
  Begin
    GetMem(T, nPoints * SizeOf(TPoint));
    For i := 1 To nPoints Do
      Begin
        If i = nPoints Then next := 1 Else next := Succ(i);
 
        T^[i].x := Trunc((arr^[i].x + a*arr^[next].x) / (1 + a));
        T^[i].y := Trunc((arr^[i].y + a*arr^[next].y) / (1 + a));
      End;
    Recalc := (T^[1].x <> arr^[1].x);
 
    Move(T^, arr^, nPoints * SizeOf(TPoint));
    FreeMem(T, nPoints * SizeOf(TPoint))
  End;
 
Procedure TFigure.Draw;
 
  Procedure DrawLine( p1, p2: TPoint );
    Begin
      Line( p1.X, p1.Y, p2.X, p2.Y )
    End;
 
  Var
    i, next: Integer;
  Begin
    For i := 1 To nPoints Do
      Begin
        next := Succ(i);
        If i = nPoints Then next := 1;
        DrawLine( arr^[i], arr^[next] );
      End;
  End;
 
 
Procedure TFigure.Run;
  Begin
    Repeat
      Draw
    Until not ReCalc;
    ReadLn
  End;
 
 
Var
  f: TFigure;
 
  grDriver, grMode, ErrCode: Integer;
Begin
  grDriver := Detect;
  InitGraph(grDriver, grMode, 'c:\tp7\bin');
  ErrCode := GraphResult;
  If ErrCode <> grOk Then
    Begin
      WriteLn('Graphic Error: ', GraphErrorMsg(ErrCode));
      Halt(100)
    End;
 
  { 7 ўҐаиЁ ¤«Ё Є ¦¤®© бв®а® = 140, Є®нддЁжЁҐ = 0.05 }
  f.Init( 7, 140, 0.05 );
  f.Run;
  f.Done;
 
  CloseGraph;
End.

Program admiral;
Uses Crt;
Type   Inf= Record
             pred: Longint;
             Sort,Name: String;
             Chena, Cex: Longint;
           End;
Var   m: Array [1..15] of Inf;
      a: Array [1..15] of Inf;
      Buf: Inf;
      Info:file of Inf;
          CV:char;
          zm:set of '0'..'9';
          xm:set of 'A'..'п';
      Code,gd,gm,n,i,j,l,z: Integer;
      Poiskpred,XKey,k,w,Poiskcex: Longint;
      str,b1,b2: String;
      Poisksort,PoiskSort2: String;
      Key:Char;
 
 
Procedure Chislo(Var Chisl: Longint; k: Byte);
Begin
zm:=['0'..'9'];
Str:='';
Xkey:=WhereX;
K:=WhereX+K;
While Key<>#13
Do Begin
Key:=#0;
If KeyPressed
Then Key:=ReadKey;
If WhereX<=k
Then Begin
If Key in zm
Then Begin
Write(Key);
Str:=Str+Key;
End;
If (key=#8) And (Xkey<WhereX)
Then Begin
Write(#8);
Write(' ');
Write(#8);
Delete(Str,Length(Str),1);
End;
End
Else Begin
Write(#8);
Write(' ');
Write(#8);
Delete(Str,Length(Str),1);
End;
End;
    Key:=#0;
    Val(Str,Chisl,Code);
    Writeln;
End;
 
 
Procedure Stroka(Var Strok: String; k: Byte);
Begin
    xm:=['Ђ'..'п']+['A'..'z']+[' ']-['[',']','_'];
    Str:='';
    XKey:= WhereX;
    k:=WhereX+k;
    While Key<>#13
    Do Begin
    Key:=#0;
If KeyPressed
Then Key:=ReadKey;
If WhereX<=k
Then Begin
If Key in xm
Then Begin
Write(key);
Str:=Str+Key;
End;
If (key=#8) and (Xkey<WhereX)
Then Begin
Write(#8);
Write(' ');
Write(#8);
Delete(Str,Length(Str),1);
End;
If Key = ' '
Then Begin
Write(key);
Str:=Str+Key;
End;
End
Else Begin
Write(#8);
Write(' ');
Write(#8);
Delete(Str,Length(str),1);
End;
             End;
 
    Key:=#0;
    Strok:=Str;
    Writeln;
End;
 
 
Procedure imput;
Begin
  ClrScr;
   if w=1 then Rewrite(Info)
                  else
   If w=3
   then Begin
          Reset(info);
          Seek(info,filesize(info));
        End;
         Writeln('ЙННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННН»');
         Writeln('є                          ‘®§¤**ЁҐ е«ҐЎ®Ўг«®з*®Ј® бЇа*ў®з*ЁЄ*                є');
         Writeln('ИНННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННј');
   Write('Љ®«-ў® ЇаҐ¤ЇаЁпвЁ©: ');
       Chislo(k,2);
   For i:=1 to k do
      With m[i] do
 
         Begin  Write('Ќ®¬Ґа ЇаҐ¤ЇаЁпвЁп: ');Chislo(pred,8);
                Write('Ќ*Ё¬Ґ*®ў**ЁҐ Ё§¤Ґ«Ёп:');stroka(name,10);
                Write('–Ґе: ');Chislo(cex,12);
                Write('–Ґ**: ');Chislo(chena,5);
                Write('‘®ав:');Stroka(sort,10);
                Writeln;
         End;
For i:=1 to k do Write(info, m[i]);
   ReadKey;
   ClrScr;
   Close(Info);
   w:=0;
End;
 
 
Procedure Vich;
Begin
   ClrScr;
   Reset(Info);
   For i:=1 To Filesize(Info)
       Do Read(Info,m[i]);
        Writeln('ЙННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННН»');
        Writeln('є                           Џа®б¬®ва бЇа*ў®з*ЁЄ*                              є');
        Writeln('ИНННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННј');
    Writeln('  ЙНННННННННННЛННННННННННННННННЛНННННННННННННННЛНННННННННННЛННННННННННННННН»');
    Writeln('  єЏаҐ¤ЇаЁпвЁҐє   Ќ*Ё¬Ґ*®ў**ЁҐ є     ‘®ав      є   –…ЌЂ    є      –Ґе      є');
    Writeln('  ЗДДДДДДДДДДДЧДДДДДДДДДДДДДДДДЧДДДДДДДДДДДДДДДЧДДДДДДДДДДД¶ДДДДДДДДДДДДДДД¶');
      For i:=1 To Filesize(Info)
            Do Begin
  Write(  '  є',m[i].pred:11,'є',m[i].name:16,'є',m[i].sort:15,'є', m[i].chena:11,'є',m[i].cex:15,'є');
                Writeln;
               End;
    Writeln('  ИНННННННННННКННННННННННННННННКНННННННННННННННКНННННННННННКНННННННННННННННј');
 
   ReadKey;
   ClrScr;
   Close(Info);
   w:=0;
End;
 
 
 
 
Procedure Poisk1;
Begin
   ClrScr;
    Writeln('ЙННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННН»');
    Writeln('є                           Џ®ЁбЄ Ї® §*Їа®бг                                  є');
    Writeln('ИНННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННј');
   Reset(Info);seek(info,0);
   For i:=1 To Filesize(Info)
       Do Read(Info,m[i]);
   Write('‚ўҐ¤ЁвҐ ЇаҐ¤ЇаЁпвЁҐ ¤«п Ї®ЁбЄ* -> ');
   Chislo(Poiskpred,2);
   Write('‚ўҐ¤ЁвҐ жҐе ¤«п Ї®ЁбЄ* -> ');
   Chislo(Poiskcex,5);
   z:=0;
   For i:=1 To Filesize(Info)
       Do If (Poiskpred=m[i].pred)and (Poiskcex=m[i].cex)
                    Then Begin
                   Inc(z);
                   a[z]:=m[i];
                  End;
 
       For i:=1 to z-1
       Do for j:=i+1 to z
              Do If a[i].chena>a[j].chena
                    Then Begin
                          buf:=a[i];
                          a[i]:=a[j];
                          a[j]:=buf;
                         End;
Writeln('ЙННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННН»');
Writeln('є                           ‚лў®¤ Ў*§л Ї® §*Їа®бг                             є');
Writeln('ИНННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННј');
Writeln;
    Writeln('  ЙНННННННННННЛННННННННННННННННЛНННННННННННННННЛНННННННННННЛННННННННННННННН»');
    Writeln('  єЏаҐ¤ЇаЁпвЁҐє   Ќ*Ё¬Ґ*®ў**ЁҐ є     ‘®ав      є   –…ЌЂ    є      –Ґе      є');
    Writeln('  ЗДДДДДДДДДДДЧДДДДДДДДДДДДДДДДЧДДДДДДДДДДДДДДДЧДДДДДДДДДДД¶ДДДДДДДДДДДДДДД¶  ');
   For i:=1 To z
            Do Begin
        Write(  '  є',a[i].pred:11,'є',a[i].name:16,'є',a[i].sort:15,'є', a[i].chena:11,'є',a[i].cex:15,'є');
                Writeln;
               End;
    Writeln('  ИНННННННННННКННННННННННННННННКНННННННННННННННКНННННННННННКНННННННННННННННј');
   w:=0;
   Close(Info);
   ReadKey;
   ClrScr;
 
End;
 
 
Procedure Poisk3;
var cex:string;
    sort:string;
Begin
   ClrScr;
    Writeln('ЙННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННН»');
    Writeln('є                           Џ®ЁбЄ Ї® §*Їа®бг                                  є');
    Writeln('ИНННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННј');
   Reset(Info);
   write('‚ўҐ¤ЁвҐ ЇҐаўго ЎгЄўг Ё§¤Ґ«Ёп->  ');
   Stroka(b1,1);
   write('‚ўҐ¤ЁвҐ ЇҐаўго ЎгЄўг Ё§¤Ґ«Ёп->  ');
   Stroka(b2,1);
   write('‚ўҐ¤Ё б®ав->  ');
   Stroka(Poisksort2,10);
   For i:=1 To Filesize(Info)
       Do Read(Info,m[i]);
Writeln('ЙННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННН»');
Writeln('є                           ‚лў®¤ Ў*§л Ї® §*Їа®бг                             є');
Writeln('ИНННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННј');
Writeln;
    Writeln('  ЙНННННННННННЛННННННННННННННННЛНННННННННННННННЛНННННННННННЛННННННННННННННН»');
    Writeln('  єЏаҐ¤ЇаЁпвЁҐє   Ќ*Ё¬Ґ*®ў**ЁҐ є      ‘®ав     є   –…ЌЂ    є      –Ґе      є');
    Writeln('  ЗДДДДДДДДДДДЧДДДДДДДДДДДДДДДДЧДДДДДДДДДДДДДДДЧДДДДДДДДДДД¶ДДДДДДДДДДДДДДД¶');
   For i:=1 To Filesize(Info)
       Do If ((m[i].Name[1]=b1) or (m[i].Name[1]=b2)) and (m[i].Sort<>PoiskSort2)
             Then
   Writeln(  '  є',m[i].pred:11,'є',m[i].name:16,'є',m[i].sort:15,'є', m[i].chena:11,'є',m[i].cex:15,'є');
   Writeln('  ИНННННННННННКННННННННННННННННКНННННННННННННННКНННННННННННКНННННННННННННННј');
   w:=0;
   Close(Info);
   ReadKey;
   ClrScr;
 
End;
 
procedure poisk2;
var sred:real;
ima:string;
begin
reset(Info);
Writeln('ЙННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННН»');
Writeln('є                           Џ®ЁбЄ Ї® §*Їа®бг                                  є');
Writeln('ИНННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННј');
Write('‚ўҐ¤ЁвҐ **Ё¬Ґ*®ў**ЁҐ в®ў*а* ->  ');
Stroka(ima,10);
sred:=0;
for i:=1 to filesize(info) do
Read(info,m[i]);
clrscr;
for i:= 1 to filesize(info) do
if (m[i].name=ima) then begin
sred:=m[i].chena+sred;k:=k+1;
end;
sred := sred/k;
Writeln('ЙННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННН»');
Writeln('є                           ‚лў®¤ Ў*§л Ї® §*Їа®бг                             є');
Writeln('ИНННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННННј');
Writeln('‘।*пп жҐ** ** в®ў*а - ',ima,' = ',sred:5:0);
Writeln;
Writeln('  ЙНННННННННННЛННННННННННННННННЛНННННННННННННННЛНННННННННННЛННННННННННННННН»');
Writeln('  єЏаҐ¤ЇаЁпвЁҐє   Ќ*Ё¬Ґ*®ў**ЁҐ є      ‘®ав     є   –…ЌЂ    є       –Ґе     є');
Writeln('  ЗДДДДДДДДДДДЧДДДДДДДДДДДДДДДДЧДДДДДДДДДДДДДДДЧДДДДДДДДДДД¶ДДДДДДДДДДДДДДД¶');
for i:= 1 to filesize(info) do
if (m[i].chena>sred) and (m[i].name=ima) then
with m[i] do Begin
Writeln('  є',m[i].pred:11,'є',m[i].name:16,'є',m[i].sort:15,'є', m[i].chena:11,'є',m[i].cex:15,'є');
End;
Writeln('  ИНННННННННННКННННННННННННННННКНННННННННННННННКНННННННННННКНННННННННННННННј');
 
close(info);
readkey;
end;
 
Procedure Podmenu;
var w:longint;
Begin
w:=0;
clrscr;
Window(28,10,62,20);
Writeln('     Њ…Ќћ ЏЋ?‘ЉЂ        ');
Writeln;
Writeln('1:Џ®ЁбЄ Ї® ЇаҐ¤ЇаЁпвЁо Ё жҐег');
Writeln('2:Џ®ЁбЄ ® в®ў*ॠ');
Writeln('3:Џ®ЁбЄ Ї® Їа®Ё§ў®¤ЁвҐ«о ');
Writeln('4:‚л室 ў Ј«*ў*®Ґ ¬Ґ*о');
Chislo(w,1);
Textmode(CO80);
clrscr;
Case w of
1:Poisk1;
2:poisk2;
3:Poisk3;
4:exit;
End;
Clrscr;
End;
 
Begin
ClrScr;
   assign(Info ,'d:\admiral');
      {Zastavka;}
   Repeat
   clrscr;
    Window(28,10,62,20);
     Writeln('     ѓ‹Ђ‚ЌЋ… Њ…Ќћ     ');
     Writeln;
    Writeln('1:‘®§¤**ЁҐ бЇа*ў®з*ЁЄ*');
    Writeln('2:Џа®б¬®ва');
    Writeln('3:„®§*ЇЁбм бЇа*ў®з*ЁЄ*');
    Writeln('4:ЊҐ*о Ї®ЁбЄ*');
    Writeln('5:‚л室');
    Chislo(w,1);
    Textmode(CO80);
    Case w
         Of 1:Imput;
            2:Vich;
            3:Imput;
            4:PodMenu;
    End;
Until w=5;
End.