pastebin - collaborative debugging

pastebin is a collaborative debugging tool allowing you to share and modify code snippets while chatting on IRC, IM or a message board.

This site is developed to XHTML and CSS2 W3C standards. If you see this paragraph, your browser does not support those standards and you need to upgrade. Visit WaSP for a variety of options.

 >  > Запись оставлена Гость 23.10.2026 в 15:55 Получить справку

Запись оставлена Гость 23.10.2026 в 15:55
запустить | скачать | новая запись

  1. program Sechenie;
  2. { Turbo Pascal 7.0 (DOS). Готово к копированию и компиляции. }
  3.  
  4. uses Graph;
  5.  
  6. const
  7.   { --- Двутавр No20 (ГОСТ 8239-89) --- }
  8.   b2 = 10.0;   h2 = 20.0;   d2 = 0.52;  t2 = 0.84;
  9.   F2 = 26.8;   Ix2 = 1840.0; Iy2 = 104.0;
  10.  
  11.   { --- Уголок 180x110x12 (ГОСТ 8510-86) --- }
  12.   B1 = 18.0;   b1 = 11.0;   t1 = 1.2;
  13.   F1 = 33.69;  Ix1 = 1122.56; Iy1 = 324.09; Ix1y1 = 348.0;
  14.   x0 = 2.52;   y0 = 5.97;
  15.  
  16. var
  17.   gd, gm : integer;
  18.   scale  : double;
  19.   cx0, cy0 : integer;
  20.  
  21.   xc1, yc1, xc2, yc2 : double;
  22.   F, xc, yc : double;
  23.   a1, b1_, a2, b2_ : double;
  24.   Jx, Jy, Jxy : double;
  25.   alpha0 : double;
  26.   Javg, Jrad, Jmax, Jmin, iu, iv : double;
  27.  
  28. { ---------- arctan2 (в TP7 нет) ---------- }
  29. function ArcTan2(y, x: double): double;
  30. begin
  31.   if x > 0 then
  32.     ArcTan2 := ArcTan(y/x)
  33.   else if x < 0 then
  34.   begin
  35.     if y >= 0 then ArcTan2 := ArcTan(y/x) + Pi
  36.     else ArcTan2 := ArcTan(y/x) - Pi;
  37.   end
  38.   else
  39.   begin
  40.     if y > 0 then ArcTan2 := Pi/2
  41.     else if y < 0 then ArcTan2 := -Pi/2
  42.     else ArcTan2 := 0;
  43.   end;
  44. end;
  45.  
  46. { ---------- форматирование числа в строку ---------- }
  47. function Fmt(v: double; dec: integer): string;
  48. var
  49.   s : string;
  50. begin
  51.   Str(v:0:dec, s);
  52.   Fmt := s;
  53. end;
  54.  
  55. { ---------- экранные координаты ---------- }
  56. function SX(x: double): integer;
  57. begin
  58.   SX := Round(cx0 + x * scale);
  59. end;
  60.  
  61. function SY(y: double): integer;
  62. begin
  63.   SY := Round(cy0 - y * scale);
  64. end;
  65.  
  66. procedure WLine(x1,y1,x2,y2: double);
  67. begin
  68.   Line(SX(x1), SY(y1), SX(x2), SY(y2));
  69. end;
  70.  
  71. { ---------- заливка полигона (scanline) ---------- }
  72. procedure FillPolyWorld(var xs, ys: array of double; color: word);
  73. var
  74.   i, j, k, n : integer;
  75.   ymin, ymax, yy : double;
  76.   xint : array[0..255] of double;
  77.   cnt, xi, xj : integer;
  78.   px1, px2 : integer;
  79.   t : double;
  80. begin
  81.   n := Length(xs);
  82.   ymin := ys[0]; ymax := ys[0];
  83.   for i := 1 to n-1 do
  84.   begin
  85.     if ys[i] < ymin then ymin := ys[i];
  86.     if ys[i] > ymax then ymax := ys[i];
  87.   end;
  88.  
  89.   SetColor(color);
  90.   yy := ymin;
  91.   while yy <= ymax do
  92.   begin
  93.     cnt := 0;
  94.     j := n - 1;
  95.     for i := 0 to n-1 do
  96.     begin
  97.       xi := i; xj := j;
  98.       if ((ys[xi] <= yy) and (ys[xj] > yy)) or
  99.          ((ys[xj] <= yy) and (ys[xi] > yy)) then
  100.       begin
  101.         t := (yy - ys[xi]) / (ys[xj] - ys[xi]);
  102.         xint[cnt] := xs[xi] + t * (xs[xj] - xs[xi]);
  103.         Inc(cnt);
  104.       end;
  105.       j := i;
  106.     end;
  107.     for i := 0 to cnt-2 do
  108.       for k := i+1 to cnt-1 do
  109.         if xint[i] > xint[k] then
  110.         begin
  111.           t := xint[i]; xint[i] := xint[k]; xint[k] := t;
  112.         end;
  113.     i := 0;
  114.     while i < cnt-1 do
  115.     begin
  116.       px1 := SX(xint[i]);
  117.       px2 := SX(xint[i+1]);
  118.       Line(px1, SY(yy), px2, SY(yy));
  119.       i := i + 2;
  120.     end;
  121.     yy := yy + 0.05;
  122.   end;
  123. end;
  124.  
  125. { ---------- повернутый эллипс ---------- }
  126. procedure DrawEllipse(cx, cy, a, b, ang: double);
  127. var
  128.   t, x, y, xr, yr : double;
  129.   n, i : integer;
  130.   px, py, pxp, pyp : integer;
  131. begin
  132.   n := 360;
  133.   t := 0;
  134.   x := a; y := 0;
  135.   xr := x*cos(ang) - y*sin(ang) + cx;
  136.   yr := x*sin(ang) + y*cos(ang) + cy;
  137.   pxp := SX(xr); pyp := SY(yr);
  138.   for i := 1 to n do
  139.   begin
  140.     t := 2*Pi*i/n;
  141.     x := a*cos(t); y := b*sin(t);
  142.     xr := x*cos(ang) - y*sin(ang) + cx;
  143.     yr := x*sin(ang) + y*cos(ang) + cy;
  144.     px := SX(xr); py := SY(yr);
  145.     Line(pxp, pyp, px, py);
  146.     pxp := px; pyp := py;
  147.   end;
  148. end;
  149.  
  150. var
  151.   i : integer;
  152.   xs, ys : array[0..20] of double;
  153.   L, dx, dy : double;
  154.  
  155. begin
  156.   { --- Расчёт --- }
  157.   xc1 := b2/2 + x0;
  158.   yc1 := y0;
  159.   xc2 := 0; yc2 := 0;
  160.   F := F1 + F2;
  161.   xc := (F1*xc1 + F2*xc2) / F;
  162.   yc := (F1*yc1 + F2*yc2) / F;
  163.  
  164.   a1 := yc1 - yc;  b1_ := xc1 - xc;
  165.   a2 := yc2 - yc;  b2_ := xc2 - xc;
  166.  
  167.   Jx  := Ix1 + F1*a1*a1 + Ix2 + F2*a2*a2;
  168.   Jy  := Iy1 + F1*b1_*b1_ + Iy2 + F2*b2_*b2_;
  169.   Jxy := Ix1y1 + F1*a1*b1_ + 0 + F2*a2*b2_;
  170.  
  171.   alpha0 := 0.5*ArcTan2(-2*Jxy, Jx-Jy);
  172.   Javg := (Jx+Jy)/2;
  173.   Jrad := 0.5*Sqrt(Sqr(Jx-Jy) + 4*Jxy*Jxy);
  174.   Jmax := Javg + Jrad;
  175.   Jmin := Javg - Jrad;
  176.   iu := Sqrt(Jmax/F);
  177.   iv := Sqrt(Jmin/F);
  178.  
  179.   { --- Графика --- }
  180.   gd := Detect;
  181.   InitGraph(gd, gm, '');
  182.   if GraphResult <> grOk then Halt(1);
  183.  
  184.   scale := 20.0;
  185.   cx0 := 300;
  186.   cy0 := 400;
  187.  
  188.   { --- Сетка 1 см --- }
  189.   SetColor(LightGray);
  190.   SetLineStyle(DottedLn, 0, NormWidth);
  191.   for i := -10 to 20 do
  192.     Line(SX(i), SY(-15), SX(i), SY(25));
  193.   for i := -15 to 25 do
  194.     Line(SX(-10), SY(i), SX(20), SY(i));
  195.   SetLineStyle(SolidLn, 0, NormWidth);
  196.  
  197.   { --- Оси x2, y2 --- }
  198.   SetColor(Blue);
  199.   WLine(-10, 0, 20, 0);
  200.   WLine(0, -15, 0, 25);
  201.   OutTextXY(SX(19), SY(0.5), 'x2');
  202.   OutTextXY(SX(0.5), SY(24), 'y2');
  203.  
  204.   { --- Двутавр --- }
  205.   xs[0] := -b2/2;  ys[0] :=  h2/2;
  206.   xs[1] :=  b2/2;  ys[1] :=  h2/2;
  207.   xs[2] :=  b2/2;  ys[2] :=  h2/2-t2;
  208.   xs[3] :=  d2/2;  ys[3] :=  h2/2-t2;
  209.   xs[4] :=  d2/2;  ys[4] := -h2/2+t2;
  210.   xs[5] :=  b2/2;  ys[5] := -h2/2+t2;
  211.   xs[6] :=  b2/2;  ys[6] := -h2/2;
  212.   xs[7] := -b2/2;  ys[7] := -h2/2;
  213.   xs[8] := -b2/2;  ys[8] := -h2/2+t2;
  214.   xs[9] := -d2/2;  ys[9] := -h2/2+t2;
  215.   xs[10]:= -d2/2;  ys[10]:=  h2/2-t2;
  216.   xs[11]:= -b2/2;  ys[11]:=  h2/2-t2;
  217.   xs[12]:= -b2/2;  ys[12]:=  h2/2;
  218.  
  219.   FillPolyWorld(xs, ys, LightBlue);
  220.   SetColor(Black);
  221.   for i := 0 to 11 do
  222.     WLine(xs[i], ys[i], xs[i+1], ys[i+1]);
  223.   WLine(xs[12], ys[12], xs[0], ys[0]);
  224.  
  225.   { --- Уголок --- }
  226.   xs[0] := b2/2;       ys[0] := 0;
  227.   xs[1] := b2/2;       ys[1] := B1;
  228.   xs[2] := b2/2 + t1;  ys[2] := B1;
  229.   xs[3] := b2/2 + t1;  ys[3] := t1;
  230.   xs[4] := b2/2 + b1;  ys[4] := t1;
  231.   xs[5] := b2/2 + b1;  ys[5] := 0;
  232.   xs[6] := b2/2;       ys[6] := 0;
  233.  
  234.   FillPolyWorld(xs, ys, LightRed);
  235.   SetColor(Black);
  236.   for i := 0 to 5 do
  237.     WLine(xs[i], ys[i], xs[i+1], ys[i+1]);
  238.   WLine(xs[6], ys[6], xs[0], ys[0]);
  239.  
  240.   { --- Центральные оси --- }
  241.   SetColor(Green);
  242.   WLine(-10, yc, 20, yc);
  243.   WLine(xc, -15, xc, 25);
  244.   OutTextXY(SX(19), SY(yc+0.6), 'x');
  245.   OutTextXY(SX(xc+0.5), SY(24), 'y');
  246.  
  247.   { --- Главные оси u, v --- }
  248.   SetColor(Red);
  249.   L := 20;
  250.   dx := cos(alpha0)*L;  dy := sin(alpha0)*L;
  251.   WLine(xc-dx, yc-dy, xc+dx, yc+dy);
  252.   OutTextXY(SX(xc+dx*0.9), SY(yc+dy*0.9), 'u');
  253.  
  254.   SetColor(Magenta);
  255.   dx := -sin(alpha0)*L;  dy := cos(alpha0)*L;
  256.   WLine(xc-dx, yc-dy, xc+dx, yc+dy);
  257.   OutTextXY(SX(xc+dx*0.9), SY(yc+dy*0.9), 'v');
  258.  
  259.   { --- Эллипс инерции --- }
  260.   SetColor(DarkGray);
  261.   DrawEllipse(xc, yc, iu, iv, alpha0);
  262.  
  263.   { --- Точки центров --- }
  264.   SetColor(Green);
  265.   SetFillStyle(SolidFill, Green);
  266.   FillCircle(SX(xc), SY(yc), 5);
  267.   OutTextXY(SX(xc)+8, SY(yc)-8, 'C');
  268.  
  269.   SetColor(LightRed);
  270.   SetFillStyle(SolidFill, LightRed);
  271.   FillCircle(SX(xc1), SY(yc1), 5);
  272.   OutTextXY(SX(xc1)+6, SY(yc1)-8, 'C1');
  273.  
  274.   SetColor(Blue);
  275.   SetFillStyle(SolidFill, Blue);
  276.   FillCircle(SX(xc2), SY(yc2), 5);
  277.   OutTextXY(SX(xc2)+6, SY(yc2)+2, 'C2');
  278.  
  279.   { --- Текст результатов --- }
  280.   SetColor(Black);
  281.   OutTextXY(10, 10, 'Dvutavr No20 + Ugolok 180x110x12');
  282.   OutTextXY(10, 25, 'xc = ' + Fmt(xc,2) + ' sm,  yc = ' + Fmt(yc,2) + ' sm');
  283.   OutTextXY(10, 40, 'Jx = ' + Fmt(Jx,1) + ',  Jy = ' + Fmt(Jy,1) + ' sm4');
  284.   OutTextXY(10, 55, 'Jxy = ' + Fmt(Jxy,1) + ' sm4');
  285.   OutTextXY(10, 70, 'alpha0 = ' + Fmt(alpha0*180/Pi,2) + ' grad');
  286.   OutTextXY(10, 85, 'Ju = ' + Fmt(Jmax,1) + ',  Jv = ' + Fmt(Jmin,1) + ' sm4');
  287.   OutTextXY(10, 100,'iu = ' + Fmt(iu,2) + ' sm,  iv = ' + Fmt(iv,2) + ' sm');
  288.  
  289.   SetColor(Blue);    OutTextXY(10, 130, '--- osi x2,y2');
  290.   SetColor(Green);   OutTextXY(10, 145, '--- centralnye x,y');
  291.   SetColor(Red);     OutTextXY(10, 160, '--- glavnaya u');
  292.   SetColor(Magenta); OutTextXY(10, 175, '--- glavnaya v');
  293.   SetColor(DarkGray);OutTextXY(10, 190, '--- ellips inercii');
  294.  
  295.   OutTextXY(10, 220, 'Nazhmite Enter dlya vyhoda...');
  296.   ReadLn;
  297.  
  298.   CloseGraph;
  299. end.

Отправка исправлений и поправок. (cоздать новую запись)
После отправки поправок вы сможете посмотреть различия между старой и новой записью.

Использовать подсветку синтаксиса
В текущей реализации JS-DOS Read/ReadLn работают только при подключенном модуле Crt! Для подсветки отдельных строк используйте для них префикс @@


картинка


Запомнить мои настройки