old/PAS/OLD/CENMKEY.PAS

Uses Crt,Graph;

Const
 MaxPoints = 10;
 Path = '';

Type TPoints = record
  x,y,massa : Word;
end;

Var
  points : array[1..MaxPoints] of ^TPoints;
  center : PointType;
  circles : array [1..9] of Pointer;
  Size : array [1..9] of Word;
  CenterM :Pointer;
  SizeC  : Word;
  mod_num : Word;
  num_of_point : byte;
  ch : char;
  i : Integer;
{-------------------------------------------}
Function TestPos(x1,y1,m1:Integer) : boolean;
 Var
i:integer;
begin
 TestPos := true;
 for i := 1 to MaxPoints do
  with Points[i]^ do if (x1=x) and (y1=y) then TestPos:=false;
end;
{----------------------------------------------}
Procedure FindCenter;
Var
 i:Integer;
 summaX,SummaY,smas:real;
Begin
 SummaX:=0;
 SummaY:=0;
 Smas:=0;
 for i:= 1 to MaxPoints do
  begin
   summaX := SummaX + points[i]^.massa * points[i]^.x;
   summaY := SummaY + points[i]^.massa * points[i]^.Y;
   smas := smas + points[i]^.massa;
  end;
 center.x := round(summaX/smas);
 center.y := round(summaY/smas);
End;{FindCenter}
{--------------------------------------------}
Procedure SetPoints;
Var
 i,x1,y1,massa1 : Integer;
Begin
  for i := 1 to MaxPoints do
   begin
    New(points[i]);
    repeat
     begin
      Y1 := random(400)+40;
      X1 := random(560)+40;
      massa1 := random(8)+1;
     end;
    until TestPos(x1,y1,massa1);
   with points[i]^ do
    begin
     x := x1;
     y := y1;
     massa := massa1;
    end;
   end;
End;{SetPoints}
{-----------------------------------------}
Procedure InitG;
Var
  Gm,Gd : Integer;
Begin
 Gd := VGA; Gm := VGAhi;
 InitGraph(Gd, Gm,Path);
 if GraphResult <> grOk then
  begin
   WriteLn(GraphErrorMsg(GraphResult));
   Halt(1);
  end
 else
  begin
   SetColor(blue);
   Line(40,440,600,440);
   Line(40,40,40,440);
   Line(35,340,45,340);
   Line(140,435,140,445);
   SetColor(White);
   SetTextStyle(SmallFont,0,4);
   SetTextJustify(Centertext,TopText);
   OutTextXY(140,448,'100');
   OutTextXY(590,450,'X');
   OutTextXY(35,450,'0');
   SetTextJustify(RightText,CenterText);
   OutTextXY(38,52,'Y');
   OutTextXY(33,340,'100');
   SetColor(White);
   for i := 1 to 9 do
    begin
     Circle(100,100,i);
     Size[i] := ImageSize(100-i,100-i,100+i,100+i);
     GetMem(circles[i],Size[i]);
     GetImage(100-i,100-i,100+i,100+i,circles[i]^);
     PutImage(100-i,100-i,circles[i]^,XORput);
    end;
   SetFillStyle(SolidFill,Red);
   FillEllipse(100,100,4,4);
   SizeC := ImageSize(96,96,104,104);
   GetMem(CenterM,SizeC);
   GetImage(96,96,104,104,CenterM^);
   PutImage(96,96,CenterM^,XORPut);
  end;
end;{InitG}
{--------------------------------------------}
Procedure MovePoint(n,dir:byte);
Begin
 PutImage(points[n]^.x-points[n]^.massa,points[n]^.y-points[n]^.massa,
          Circles[points[n]^.massa]^,XORPut);
 case dir of
  1 : begin
       inc(Points[n]^.x);
       if Points[n]^.x + Points[n]^.massa > 601 then Points[n]^.x := 600 - Points[n]^.massa;
       PutImage(points[n]^.x-points[n]^.massa,points[n]^.y-points[n]^.massa,
                circles[points[n]^.massa]^,XORPut);
      End;
  2 : begin
       inc(Points[n]^.y);
       if Points[n]^.y + Points[n]^.massa > 441 then Points[n]^.Y := 440 - Points[n]^.massa;
       PutImage(points[n]^.x-points[n]^.massa,points[n]^.y-points[n]^.massa,
                circles[points[n]^.massa]^,XORPut);
      end;
  3 : begin
       dec(Points[n]^.x);
       if Points[n]^.x - Points[n]^.massa < 40 then Points[n]^.x := 40 + Points[n]^.massa;
       PutImage(points[n]^.x-points[n]^.massa,points[n]^.y-points[n]^.massa,
                circles[points[n]^.massa]^,XORPut);
      end;
  4 : begin
       dec(Points[n]^.y);
       if Points[n]^.y - Points[n]^.massa < 40 then Points[n]^.Y := 40 + Points[n]^.massa;
       PutImage(points[n]^.x-points[n]^.massa,points[n]^.y-points[n]^.massa,
                circles[points[n]^.massa]^,XORPut);
      end;
  end;
  PutImage(center.x-4,center.y-4, CenterM^,XORPut);
  PutPixel(Center.x,Center.Y,Yellow);
  FindCenter;
  PutImage(center.x-4,center.y-4, CenterM^,XORPut);
 End;{MovePoint}
{-----------------------------------------}
Begin
 Num_OF_point :=1;
 Randomize;
 InitG;
 SetPoints;
 for i := 1 to MaxPoints do PutImage(points[i]^.x-points[i]^.massa,
                                     points[i]^.y-points[i]^.massa,
                                     Circles[points[i]^.massa]^,XorPut);
 FindCenter;
 PutImage(center.X-4,center.Y-4,CenterM^,XORPut);
 repeat
  ch := readkey;
  if ch = #0 then
   begin
    ch := readkey;
    case ch of
     #77 : MovePoint(num_of_point,1);
     #80 : MovePoint(num_of_point,2);
     #75 : MovePoint(num_of_point,3);
     #72 : MovePoint(num_of_point,4);
    end;
   end;
  if ch = #32 then
   begin
    inc(Num_of_point);
    if num_of_point = 11 then num_of_point := 1;
   end;
  if ch = #13 then
   begin
    for i := 1 to MaxPoints do PutImage(points[i]^.x-points[i]^.massa,
                                        points[i]^.y-points[i]^.massa,
                                        Circles[points[i]^.massa]^,XorPut);
    FindCenter;
    PutImage(center.X-4,center.Y-4,CenterM^,XORPut);
    for i := 1 to MaXPoints do with points[i]^ do
     begin
      X:=0;
      Y:=0;
      massa := 0;
     end;
    SetFillStyle(solidfill,black);
    Bar(45,41,600,430);
    SetPoints;
    FindCenter;
    for i := 1 to MaxPoints do PutImage(points[i]^.x-points[i]^.massa,
                                        points[i]^.y-points[i]^.massa,
                                        Circles[points[i]^.massa]^,XorPut);
    FindCenter;
    PutImage(center.X-4,center.Y-4,CenterM^,XORPut);
   end;
 until ch = #27;
 For i := 1 to MaxPoints do Dispose(Points[i]);
 For i := 1 to 9 do FreeMem(circles[i],size[i]);
 FreeMem(CenterM,SizeC);
 CloseGraph;
End.