Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 03.06.2014, 19:51   #1
Dimon95
Новичок
Джуниор
 
Регистрация: 03.06.2014
Сообщений: 1
По умолчанию Графика в паскаль авс

Помогите срочно перевести графику программы в паскаль авс
Код:
uses Crt, Graph;
const d = 12; {13}
  r = 2;
  del = #219#219#219;
var Gd, Gm, i, j, x, y, k, n: integer;
  Q: array[1..5] of integer;
  b: pointer;
  z: string;

procedure init;
begin
  clrscr; writeln('vsego zeren:16*k');
  write('vvedite koeffisient(ot 1 do 60)k=?', #8); readln(k);
  Gd := vga; Gm := vgaHi; InitGraph(Gd, Gm, ''); {ClipOn}
  SetViewPort(GetMaxX div 2, 10, GetMaxX, GetMaxy, ClipOff);
  SetColor(2); Setlinestyle(Solidln, 0, ThickWidth);
  Line(-6, 0, -25 * d, 0); Line(6, 0, 25 * d, 0);
  OutTextXY(3 * d, -10, '(ostalos)');
  SetColor(10); OutTextXY(-10 * d - 180, 38 * d, 'chisla Paskalya->');
  SetTextJustify(CenterText, TopText);
  Str(6 * k, z); OutTextXY(0, 38 * d, z);
  Str(4 * k, z); OutTextXY(4 * d, 38 * d, z); OutTextXY(-4 * d, 38 * d, z);
  Str(k, z); OutTextXY(8 * d, 38 * d, z); OutTextXY(-8 * d, 38 * d, z);
  SetFillStyle(9, 2);
  Randomize;
  for i := 1 to 5 do Q[i] := 0;
  n := 0
end; {Init}

procedure Board;
  procedure Half(a: Integer);
  begin
    MoveTo(a, 0);
    for i := 1 to 4 do
    begin LineRel(0, Abs(a)); LineRel(a, Abs(a)) end;
    LineRel(0, Abs(10 * a)); LineRel(-5 * a, 0)
  end;
  procedure Obstacle(x, Y: Integer);
  begin
    MoveTo(x, y);
    LineRel(d, -d); LineRel(0, -2 * d); LineRel(-d, -d);
    LineRel(-d, d); LineRel(0, 2 * d); LineRel(d, d);
    FloodFill(x, y - d, 10)
  end;
begin
  Half(2 * d); {pravaya polovina}
  Half(-2 * d); {leveya polovina}
  for i := 1 to 4 do
    for j := 1 to i do
    begin
      Obstacle(2 * (2 * i - j - 4) * d, (23 - 4 * j) * d); {prepyatstviya}
      if j = 1 then LineRel(0, 17 * d) {peregorodki}
    end
end; {board}

procedure Ball;
var size: Word;
begin
  SetColor(13); SetFillStyle(1, 13); FillEllipse(3, 3, r, r);
  size := ImageSize(0, 0, 6, 6);
  GetMem(b, size); GetImage(0, 0, 6, 6, b^);
  SetColor(0); FillEllipse(3, 3, r, r);
  FreeMem(b, size)
end; {Ball}

procedure PutBall;
const v = 5; {konstanta,vliyaushaya na skorost dvigeniya sharika}
begin
  PutImage(x, y, B^, XorPut); Delay(v); PutImage(x, y, B^, XorPut);
  Inc(y)
end; {PutBall}

procedure Upper; {prohojdenie verhney chasty doski}
var dx: - 1..1;
  procedure Choise; {vibor puti}
  begin
    dx := -1 + 2 * Random(2); {pirashenie abscisi:1 ili -1}
    Sound(40); Delay(1); NoSound
  end; {Choise}
begin
  Inc(n); Str(n, z);
  SetColor(0); OutTextXY(0, -10, del);
  SetColor(13); OutTextXY(0, -10, z);
  Str(16 * k - n, z);
  SetColor(0); OutTextXY(12 * d, -10, del);
  x := 0; y := 0;
  for j := 1 to 4 do
  begin
    for i := 1 to 2 * d do PutBall; {vniz}
    Choise; {nflevo ili napravo?}
    for i := 1 to 2 * d do begin PutBall; Inc(x, dx) end {naiskos}
  end
end; {Upper}

procedure Lower; {prohojdenie nijnei chasty doski}
const bottom = 36 * d - 2 * r - 2; {ordinata centrov sharov nijnego ryada}
var top: Word; {ordinata verhnego ryada v tekeshem otdelenii}
  num: 1..5; {nomer otdeleniya}
begin
  num := x div (4 * d) + 3; {opredelenie nomera otdeleniya}
  top := bottom - (Q[num] div 5) * 3 * r;
  if top < 19 * d then top := 19 * d;
  repeat PutBall; {Inc(y)} until y = top; {vniz}
  Sound(3000); Delay(2); NoSound;
  SetColor(0); OutTextXY(x, 37 * d, del);
  Str(Q[num] + 1, z);
  SetColor(13); OutTextXY(x, 37 * d, z);
  x := x - d + (Q[num] mod 5) * (3 * r + 1); {abscissa fiksiryemogo}
  FillEllipse(x, y, r, r); {v otdelenii sharika}
  Inc(Q[num]) {podschet sharikov v otdeleniyah}
end; {Lower}
begin
  Init; Board; Ball;
  repeat Upper; Lower until (n = 16 * k) or KeyPressed;
  Write(#7); Readln; CloseGraph
end.


________
Код нужно оформлять по правилам:
тегом [CODE]..[/СODE]
(это кнопочка на панели форматирования с решёточкой #)
Не забывайте об этом!

Модератор.

Последний раз редактировалось Serge_Bliznykov; 03.06.2014 в 20:22.
Dimon95 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
паскаль АВС shablakov Помощь студентам 1 20.12.2012 18:34
Паскаль АВС TRAMAL Помощь студентам 1 06.12.2012 09:59
Как можно в Паскаль АВС (Паскаль-Турбо) вставлять в результаты печати программы графики, таблицы, схемы, набранные формулы, выраже IZOPGRAM Паскаль, Turbo Pascal, PascalABC.NET 0 11.06.2012 10:54
паскаль АВС tanya61043 Помощь студентам 2 03.06.2012 08:32
паскаль авс Саранск-сити Помощь студентам 1 08.06.2010 20:08