old/PAS/OLD/CENMMOS.PAS

Uses Crt,Graph,MyTPU,F_mouse;

Const
 MaxPoints = 15;
 Path = '';
 StepPixel = 20;

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,numdelpoint : byte;
  CounterPoints : byte;
  Butt : Integer;
  ch : char;
  i,x0,y0 : Integer;
  SaveF : File of tpoints;
{-------------------------------------------}
Procedure Recenter;forward;
{----------------------------------------------}
Function GetFreePoint:Byte;
Var
 i:byte;
Begin
  GetFreePoint := 0;
  for i := 1 to MaxPoints do if points[i]^.massa = 0 then GetFreePoint := i;
End;{GetFreePoint}
{-------------------------------------------}
Procedure NewPoint(num:byte);
Var
Xm,Ym : Integer;
Begin
 MouseWhereXY(Xm,Ym);
 HideMouse;
 points[num]^.x := Xm;
 points[num]^.y := ym;
 points[num]^.massa := GetValue('Введите массу точки от 1 до 9',Xm,Ym,1,9);
 PutImage(points[num]^.x-Points[num]^.massa,points[num]^.y-Points[num]^.massa,
          circles[Points[num]^.massa]^,XorPut);
 Recenter;
 Inc(CounterPoints);
 ShowMouse;
End;{NewPoint}
{-------------------------------------------}
Procedure DelPoint(Num:byte);
Begin
  HideMouse;
  PutImage(points[num]^.x-points[num]^.massa,
           points[num]^.y-points[num]^.massa,Circles[points[num]^.massa]^,XorPut);
  With Points[num]^ do begin
    x := 0;
    y := 0;
    massa :=0;
  end;
  Dec(CounterPoints);
  ReCenter;
  ShowMouse;
End;{DelPoint}
{------------------------------------------}
Function TestPos(x1,y1: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
 if counterPoints <> 0 then begin
  SummaX:=0;
  SummaY:=0;
  Smas:=0;
  for i:= 1 to MaxPoints do if points[i]^.massa <> 0 then
   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;
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(410)+10;
      X1 := random(490)+10;
      massa1 := random(8)+1;
     end;
    until TestPos(x1,y1);
    with points[i]^ do
     begin
      x := x1;
      y := y1;
      massa := massa1;
     end;
    inc(CounterPoints);
   end;
End;{SetPoints}
{-----------------------------------------}
Procedure WriteTbl;
Var i : byte;
Begin
  SetLineStyle(SolidLn,1,3);
  SetColor(Blue);
  Rectangle(1,1,500,420);
  SetFillStyle(SolidFill,LightGray);
  SetTextJustify(CenterText,TopText);
  for i := 1 to 5 do Bar(515,i*70-20,625,i*70+30);
  OutTextXY(570,65,'Сменить');
  OutTextXY(570,80,'точки');
  OutTextXY(570,130,'Стереть');
  OutTextXY(570,155,'траекторию');
  OutTextXY(570,215,'Сохранить');
  OutTextXY(570,280,'Загрузить');
  OutTextXY(570,350,'Выход');
{-------===Ввод поинтеров=======---------}
   SetColor(White);
   SetLineStyle(SolidLn,1,1);
   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;{WriteTbl}
{---------------------------------------------}
Procedure ReCenter;
Begin
 PutImage(center.X-4,center.Y-4,CenterM^,XORPut);
 FindCenter;
 PutImage(center.X-4,center.Y-4,CenterM^,XORPut);
End;{ReCenter}
{--------------------------------------------}
Procedure MovePoint(n:byte;x,y:Integer);
Var
 s1,s2,s3:string;
Begin
 PutImage(points[n]^.x-points[n]^.massa,points[n]^.y-points[n]^.massa,
          Circles[points[n]^.massa]^,XORPut);
 if x+points[n]^.massa > 499 then x := 499 - points[n]^.massa;
 if y+points[n]^.massa > 419 then y := 419 - points[n]^.massa;
 if X-points[n]^.massa < 2 then x := 2 + points[n]^.massa;
 if Y-points[n]^.massa < 2 then y := 2 + points[n]^.massa;
 points[n]^.x := x;
 points[n]^.Y := Y;
 SetFillStyle(SolidFill,Black);
 Bar(100,430,300,450);
 Str(x,s1);
 Str(y,s2);
 Str(points[n]^.massa,s3);
 s1 := s1+' '+s2+' '+s3;
 OutTextXY(220,440,s1);
 PutImage(points[n]^.x-points[n]^.massa,points[n]^.y-points[n]^.massa,
          Circles[points[n]^.massa]^,XORPut);
 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}
{------------------------------}
Function TestCircles(var circle_num :byte):boolean;
Var
 i : byte;
Begin
 TestCircles := false;
 for i := 1 to MaxPoints do if MouseIn(points[i]^.X-points[i]^.massa,
                                       points[i]^.y-points[i]^.massa,
                                       points[i]^.X+points[i]^.massa,
                                       points[i]^.y+points[i]^.massa)
                            then begin
                                   circle_num :=i;
                                   TestCircles :=true;
                            end;

End;{TestCircles}
{------------------------------------}
Procedure EXITp;
var i : byte;
Begin
 For i := 1 to MaxPoints do Dispose(Points[i]);
 For i := 1 to 9 do FreeMem(circles[i],size[i]);
 FreeMem(CenterM,SizeC);
 CloseGraph;
 Halt(1)
End;{EXITp}
{-----------------------------------------}
Function GetEvent:byte;
var
 value : byte;
Begin
 value := 0;
 GetMouseState(Butt,x0,y0);
 case butt of
  1: begin
      if TestCircles(Num_of_point) then value := 6;
      if MouseIn(515, 50,625,100) then value :=1;
      if MouseIn(515,120,625,170) then value :=2;
      if MouseIn(515,190,625,240) then value :=3;
      if MouseIn(515,260,625,310) then value :=4;
      if MouseIn(515,330,625,380) then value :=5;
      if (value = 0) and mousein(2,2,500,420) and (GetFreePoint <> 0) then
       value := 7;
     end;
  2: if TestCircles(NumDelPoint) then value := 8;
 end;
 GetEvent := value;
End;{GetEvent}
{------------------------------------------}
Procedure RandomPoints;
Begin
  HideMouse;
  for i := 1 to MaxPoints do PutImage(points[i]^.x-points[i]^.massa,
                                      points[i]^.y-points[i]^.massa,
                                      Circles[points[i]^.massa]^,XorPut);
  SetFillStyle(SolidFill,Black);
  Bar(2,2,499,419);
  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);
  ShowMouse;
End;{RandomPoints}
{-----------------------------------------}
Procedure Save;
Var i :Byte;
Begin
  {$I-}
  REWrite(SaveF);
  {$I+}
  if IOResult <> 0 then
    Exit
  else
   for i:= 1 to 10 do
    begin
      Seek(SaveF,i);
      Write(SaveF,Points[i]^);
    end;
  Close(SaveF);
End;{Save}
{-----------------------------------------}
Procedure Load;
Var i :byte;
Begin
  {$I-}
  Reset(SaveF);
  {$I+}
 if IOResult <> 0 then
  else
   begin
    HideMouse;
    for i := 1 to MaxPoints do PutImage(points[i]^.x-points[i]^.massa,
                                        points[i]^.y-points[i]^.massa,
                                        Circles[points[i]^.massa]^,XorPut);
    SetFillStyle(SolidFill,Black);
    Bar(2,2,499,419);
    for i := 1 to 10 do
     begin
      Seek(SaveF,i);
      Read(SaveF,Points[i]^);
    end;
    for i := 1 to MaxPoints do PutImage(points[i]^.x-points[i]^.massa,
                                        points[i]^.y-points[i]^.massa,
                                        Circles[points[i]^.massa]^,XorPut);
   end;
  FindCenter;
  PutImage(center.X-4,center.Y-4,CenterM^,XORPut);
  ShowMouse;
  Close(SaveF);
End;{Load}
{-----------------------------------------}
Begin {MAIN Program}
 Assign(SaveF,'center.tbl');
 CounterPoints:=0;
 Randomize;
 InitVGA;
 WriteTbl;
 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);
 ReCenter;
 Mouse;
 SetStepToPixel(StepPixel,StepPixel);
 MouseWindow(2,2,630,420);
 repeat
  case getEvent of
   6 : begin
        HideMouse;
        MouseGotoXY(points[num_of_point]^.x,points[num_of_point]^.y);
        repeat
          MouseWhereXY(x0,y0);
          MovePoint(Num_of_point,X0,Y0);
        Until Not MousePressed;
        ShowMouse
       end;
   7:  NewPoint(GetFreePoint);
   8:  DelPoint(NumDelPoint);
   1:  RandomPoints;
   2:  begin
        HideMouse;
        for i := 1 to MaxPoints do PutImage(points[i]^.x-points[i]^.massa,
                                            points[i]^.y-points[i]^.massa,
                                            Circles[points[i]^.massa]^,XorPut);
        PutImage(center.X-4,center.Y-4,CenterM^,XORPut);
        SetFillStyle(SolidFill,Black);
        Bar(2,2,499,419);
        for i := 1 to MaxPoints do PutImage(points[i]^.x-points[i]^.massa,
                                            points[i]^.y-points[i]^.massa,
                                            Circles[points[i]^.massa]^,XorPut);
        PutImage(center.X-4,center.Y-4,CenterM^,XORPut);
        ShowMouse;
       end;
   3: Save;
   4: load;
   5: Exitp;
  end;

 if keypressed then ch := readkey;
 if ch = #27 then ExitP;
 until false;
End.