VIDEO.PAS 2.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102
  1. Uses CRT,GRAPH;
  2. Const
  3. Eps = 0.01;
  4. Del = $ffff;
  5. LeftGr = -10;
  6. RightGr = 10;
  7. Procedure InitG;
  8. Var
  9. grDriver: Integer;
  10. grMode: Integer;
  11. i : integer;
  12. Begin
  13. grDriver := Detect;
  14. InitGraph(grDriver, grMode,'');
  15. SetFillStyle(XHatchFill,Green);
  16. Bar(0,0,GetMaxX,GetMaxY);
  17. SetFillStyle(SolidFill,Black);
  18. Bar(100,50,540,450);
  19. SetColor(Red);
  20. Line(100,250,540,250);
  21. End;{InitG}
  22. {--------------------------------}
  23. Function Func(x: real): real;
  24. Begin
  25. { Func := sin(PI*x/4)/cos(PI*x/4)-x+3;}
  26. Func := x * x;
  27. End;
  28. {-----------------------------}
  29. Procedure WriteGraph(l,r,Color:Integer);
  30. Var
  31. x,y,Razm : Integer;
  32. Begin
  33. Razm := r-l;
  34. SetColor(Color);
  35. MoveTo(100,250-Round(Func(l)));
  36. for x := L to R do
  37. begin
  38. y := round(Func(x));
  39. LineTo(round(100+(x-l)*((440)/razm)),250-y);
  40. end;
  41. End;{WriteGraph}
  42. {---------------------------------}
  43. Function AddX(x : real):integer;
  44. Begin
  45. AddX :=round(100+(x-leftGR)*((440)/(RightGr-LeftGr)));
  46. End;
  47. {-----------------}
  48. Procedure Calculate;
  49. Var
  50. R,L,dx,lx,b,k,x : real;
  51. str1 : string;
  52. Begin
  53. R := RightGr;
  54. L := LeftGr;
  55. WriteGraph(round(L),round(R),Blue);
  56. dx := maxint;
  57. lx := 0;
  58. x := r;
  59. repeat
  60. setcolor(green);
  61. line(addx(l),250-round(Func(l)),addx(x),250-round(Func(x)));
  62. Delay(DEL);
  63. line(addx(x),250-round(Func(x)),addx(r),250-round(Func(r)));
  64. Delay(DEL);
  65. k := (Func(x)-Func(l))/(x-l);
  66. b := func(x)-k*x;
  67. if (-b/k>=l)and(-b/k<=x) then
  68. begin
  69. r := x;
  70. x := -b/k;
  71. end
  72. else
  73. begin
  74. k := (Func(r)-Func(x))/(r-x);
  75. b := func(r)-k*r;
  76. l := x;
  77. x := -b/k;
  78. end;
  79. dx := abs(lx-x);
  80. lx := x;
  81. setcolor(yellow);
  82. line(addx(x),250,addx(x),250-round(Func(x)));
  83. delay(del);
  84. until dx < Eps;
  85. setcolor(yellow);
  86. circle(addx(x),250,5);
  87. SetColor(Magenta);
  88. SetTextJustify(LeftText,Centertext);
  89. SetTextStyle(DefaultFont,HorizDir,4);
  90. OutTextXY(250,20,'Done');
  91. str(x:1:6,str1);
  92. SetTextStyle(Defaultfont,HorizDir,3);
  93. insert('X = ',str1,1);
  94. OutTextXY(150,440,str1);
  95. End;
  96. {------------------}
  97. Begin
  98. InitG;
  99. Calculate;
  100. ReadKey;
  101. CloseGraph;
  102. End.