• Добро пожаловать на компьютерный форум Tehnari.ru. Здесь разбираемся с проблемами ПК и ноутбуков: Windows, драйверы, «железо», сборка и апгрейд, софт и безопасность. Форум работает много лет, сейчас он переехал на новый движок, но старые темы и аккаунты мы постарались сохранить максимально аккуратно.

    Форум не связан с магазинами и сервисами – мы ничего не продаём и не даём «рекламу под видом совета». Отвечают обычные участники и модераторы, которые следят за порядком и качеством подсказок.

    Если вы у нас впервые, загляните на страницу о форуме и правила – там коротко описано, как задать вопрос так, чтобы быстро получить ответ. Чтобы создавать темы и писать сообщения, сначала зарегистрируйтесь, а затем войдите под своим логином.

    Не знаете, с чего начать? Создайте тему с описанием проблемы – подскажем и при необходимости перенесём её в подходящий раздел.
    Задать вопрос Новые сообщения Как правильно спросить
    Если пришли по старой ссылке со старого Tehnari.ru – вы на нужном месте, просто продолжайте обсуждение.

Турбо Паскаль. Задание на анимацию

Светик123

Новые
Регистрация
2 Мар 2014
Сообщения
32
Реакции
0
Баллы
0
Турбо Паскаль. Задание на анимацию

Помогите написать программу, выводящую на экран анимацию "гармошка"
 
я даже в голове это смутно представляю =)
 
ну как бы объяснить... нужна анимация движения обычной гармошки))
как то так: tehnobaian только строго по горизонтали, без колебаний вверх-вниз)
 
ну как бы объяснить... нужна анимация движения обычной гармошки))
как то так: tehnobaian только строго по горизонтали, без колебаний вверх-вниз)
Хорошо, попробую на выходных сотворить. Только сразу предупреждаю:
1. Графика - Borland.
2. Инициализацию графического режима (задание параметров функции InitGraph) делаете самостоятельно: у меня она настроена под мою систему и графика инициализируется через использование написанного мною спец. модуля, который у Вас работать не будет.
Если что-то из этого не устроит, напишите.
 
я не очень поняла про задание параметров функции,так как раньше не имела дела с графическим модулем. следовательно,не очень представляю как это сделать. но если не очень сложно - постараюсь понять
 
Стандартная процедура инициализации графики описана в справке среды разработки.
На всякий случай привожу здесь (вдруг вам лень искать)

Код:
Uses Graph;

Var  grDriver : Integer;
      grMode : Integer;
      ErrCode : Integer;

Begin
 grDriver:=Detect;
 InitGraph(grDriver, grMode, '');
 ErrCode:=GraphResult;
 If ErrCode = grOk Then
  Begin
   { Графика }
   Line(0, 0, GetMaxX, GetMaxY);
   ReadLn;
   CloseGraph;
  End
 Else WriteLn('Ошибка инициализации графики:', GraphErrorMsg(ErrCode));
End.

Эта программа рисует диагональную линию из левого верхнего угла экрана, до правого нижнего.
 
Стандартная процедура инициализации графики описана в справке среды разработки. На всякий случай привожу здесь (вдруг вам лень искать)
Да, очень хороший тест. Света, попробуйте запустить эту программку, и если всё будет нормально, то так и сделаем инициализацию.
 
Света, попробуйте запустить эту программку, и если всё будет нормально, то так и сделаем инициализацию.
...и молчанье гробовое было ему ответом...
Ладно, в любом случае раз обещал - сделал. Будем исходить из того, что выложенная Давидом тестовая программка работает, и сделаем инициализацию, как там:
Код:
Uses CRT, Graph;

Var
 X0,Y0,StepX:Word;
 grDriver : Integer;
 grMode : Integer;

Procedure Garm(Step:Word);
var i:byte;
begin
 SetLineStyle(SolidLn,0,ThickWidth);
 Line(X0,Y0-40,X0,Y0+40);
 for i:=1 to 8 do
  begin
   Line(X0-Step*2*i,Y0-40,X0-Step*2*i,Y0+40);
   Line(X0+Step*2*i,Y0-40,X0+Step*2*i,Y0+40);
  end;
 SetLineStyle(SolidLn,0,NormWidth);
 for i:=1 to 8 do
  begin
   Line(X0-Step*(2*i-1),Y0-30,X0-Step*(2*i-1),Y0+30);
   Line(X0+Step*(2*i-1),Y0-30,X0+Step*(2*i-1),Y0+30);
  end;
 MoveTo(X0,Y0-40);
 for i:=1 to 8 do
  begin
   LineTo(X0-step*(2*i-1),Y0-30);
   LineTo(X0-step*2*i,Y0-40);
  end;
 MoveTo(X0,Y0+40);
 for i:=1 to 8 do
  begin
   LineTo(X0-step*(2*i-1),Y0+30);
   LineTo(X0-step*2*i,Y0+40);
  end;
 MoveTo(X0,Y0-40);
 for i:=1 to 8 do
  begin
   LineTo(X0+step*(2*i-1),Y0-30);
   LineTo(X0+step*2*i,Y0-40);
  end;
 MoveTo(X0,Y0+40);
 for i:=1 to 8 do
  begin
   LineTo(X0+step*(2*i-1),Y0+30);
   LineTo(X0+step*2*i,Y0+40);
  end;
end;

Procedure Left(Step:Word);
begin
 SetLineStyle(SolidLn,0,ThickWidth);
 Rectangle(X0-16*Step,Y0-40,X0-16*Step-35,Y0+40);
 Line(X0-16*Step-20,Y0-40,X0-16*Step-20,Y0+40);
end;

Procedure Right(Step:Word);
begin
 SetLineStyle(SolidLn,0,ThickWidth);
 Rectangle(X0+16*Step,Y0-40,X0+16*Step+20,Y0+40);
end;

Function LeftBorder(Step:Word):Boolean;
begin
 LeftBorder:=X0-16*Step-35>0;
end;

Begin
 grDriver:=Detect;
 InitGraph(grDriver, grMode, '');

 X0:=GetMaxX div 2;
 Y0:=GetMaxY div 2;
 StepX:=4;
 ClearDevice;
 Garm(StepX);
 Left(StepX);
 Right(StepX);
 SetTextJustify(CenterText,BottomText);
 OutTextXY(X0,Y0*2-20,'Press any key to start...');
 ReadKey;
 Repeat
  StepX:=4;
  repeat
   StepX:=StepX+1;
   If LeftBorder(StepX) then
    begin
     ClearDevice;
     Garm(StepX);
     Left(StepX);
     Right(StepX);
     OutTextXY(X0,Y0*2-20,'Press any key to stop...');
     Delay(100);
    end;
  until Not(LeftBorder(StepX)) or KeyPressed;
  repeat
   StepX:=StepX-1;
   If StepX>3 then
    begin
     ClearDevice;
     Garm(StepX);
     Left(StepX);
     Right(StepX);
     OutTextXY(X0,Y0*2-20,'Press any key to stop...');
     Delay(100);
    end;
  until (StepX=3) or KeyPressed;
 Until KeyPressed;
 ReadKey;
 CloseGraph;
End.
Рисунок, конечно, примитивный, но если нужны всякие рюшечки-кнопочки-клавиши, напишите - сделаем.
 

Вложения

  • AA01.webp
    AA01.webp
    4.2 KB · Просмотры: 186
  • AA02.webp
    AA02.webp
    5.6 KB · Просмотры: 122
  • AA03.webp
    AA03.webp
    7.3 KB · Просмотры: 240
к сожалению, у меня не было возможности ответить раньше(
мой паскаль ругается, выдает ошибку "file not found" в первой строке. ему не нравится модуль Graph(
 
Так, ну этого я и опасался.
Ну что же, попробуем решить проблему.

Начнем с вопроса: есть ли в составе Вашего пакета TurboPascal файл по имени graph.tpu?
Всё остальное - только в случае положительного ответа на этот вопрос.
Итак, если таковой файл имеется, то:
1. Открываем Турбо Среду.
2. Там лезем в Options - Directories.
3. В открывшемся окошке находим строку Unit Directories. Убеждаемся, что там правильно прописан путь к папке, в которой сидит graph.tpu. Если строка пустая или путь не соответствует, то вписываем правильный путь (напр. у меня это C:\TP\UNITS), после чего жмём ОК, потом обязательно вновь щелкаем по Options, а затем по Save.
4. Запускаем программу "Гармошка".
Если она перестанет ругаться на отсутствие файла, но тем не менее не запустится, то начнем конфигурировать параметры процедуры запуска InitGraph.
Но это уже следующий этап.

Если же файла graph.tpu у Вас не обнаруживается, то это означает, что либо там встроена другая (не Borland) графика, либо графика отсутствует вовсе. Если так, то - увы!

P.S. Света, всё-таки было бы очень желательно, если бы Вы смогли появляться здесь почаще. А то при коротких визитах раз в неделю мы, боюсь, протелепаемся с этой задачкой до Нового года.
 
я сделала, как вы мне сказали. итог: на отсутствие файла перестал ругаться, но выдал следующее сообщение: BGI Error: Graphics not initialized (use InitGraph)
 
Тогда в этой строке вашей программы
Код:
 InitGraph(grDriver, grMode, '');
где стоят апострофы ' ', указать путь к вашему *.bgi файлу. Например:
Код:
InitGraph(grDriver, grMode, 'D:\TP\BIN\');

Ищите в папках egavga.bgi ;)
 
программа заработала, спасибо. только получается, что гармошка не "играет туда-обратно" а растягивается только в одном направлении. можно, пожалуйста, подредактировать так, чтобы гармошка "играла в обе стороны"?)
 
программа заработала, спасибо. только получается, что гармошка не "играет туда-обратно" а растягивается только в одном направлении. можно, пожалуйста, подредактировать так, чтобы гармошка "играла в обе стороны"?)
Хм... до крайности странно. У меня гармошка вот именно "играет в обе стороны", сперва растягивается, потом, дойдя до левого края экрана, сжимается, потом обратно идёт, и так до нажатия любой клавиши. Похоже, у Вас не срабатывает условие окончания цикла растяжки и перехода к сжатию. Ладно, подумаю.

Ага, кажется понял, "где собачка порылась". Вероятно, Ваш Паскаль несколько строже относится к совместимости типов данных, чем мой. А потому попробуйте заменить функцию LeftBorder на такой вариант:
Код:
Function LeftBorder(Step:Word):Boolean;
var LB:Integer;
begin
 LB:=-16*Step-35+X0;
 LeftBorder:=LB>0;
end;
 
у меня tp7 тоже грамонь играет в одну сторону.
а со сменой функции вообще какие то артефакты, не правильно отрисовывает.
 
у меня tp7 тоже грамонь играет в одну сторону.
а со сменой функции вообще какие то артефакты, не правильно отрисовывает.
Совсем не понимаю. Сейчас запустил (с измененной функцией) в TP7 (обычно я работаю с FreePascal) - безупречно!
Правда, есть одно "но": оба пакета я гоняю исключительно в DOS-моде с эмуляцией VGA-экрана (640х480). А Вы, вероятно, запускаете в оконном? Может быть, дело в этом?
Ладно, поразмыслю над другим вариантом прерывания цикла растяжки и перехода к циклу сжатия.
 
Протестируйте, пожалуйста, такой вариант:
Код:
Uses CRT, Graph;

Var
 X0,Y0,StepX,StepX_max:Word;
 grDriver, grMode: Integer;

Procedure Garm(Step:Word);
var i:byte;
begin
 SetLineStyle(SolidLn,0,ThickWidth);
 Line(X0,Y0-40,X0,Y0+40);
 for i:=1 to 8 do
  begin
   Line(X0-Step*2*i,Y0-40,X0-Step*2*i,Y0+40);
   Line(X0+Step*2*i,Y0-40,X0+Step*2*i,Y0+40);
  end;
 SetLineStyle(SolidLn,0,NormWidth);
 for i:=1 to 8 do
  begin
   Line(X0-Step*(2*i-1),Y0-30,X0-Step*(2*i-1),Y0+30);
   Line(X0+Step*(2*i-1),Y0-30,X0+Step*(2*i-1),Y0+30);
  end;
 MoveTo(X0,Y0-40);
 for i:=1 to 8 do
  begin
   LineTo(X0-step*(2*i-1),Y0-30);
   LineTo(X0-step*2*i,Y0-40);
  end;
 MoveTo(X0,Y0+40);
 for i:=1 to 8 do
  begin
   LineTo(X0-step*(2*i-1),Y0+30);
   LineTo(X0-step*2*i,Y0+40);
  end;
 MoveTo(X0,Y0-40);
 for i:=1 to 8 do
  begin
   LineTo(X0+step*(2*i-1),Y0-30);
   LineTo(X0+step*2*i,Y0-40);
  end;
 MoveTo(X0,Y0+40);
 for i:=1 to 8 do
  begin
   LineTo(X0+step*(2*i-1),Y0+30);
   LineTo(X0+step*2*i,Y0+40);
  end;
end;

Procedure Left(Step:Word);
begin
 SetLineStyle(SolidLn,0,ThickWidth);
 Rectangle(X0-16*Step,Y0-40,X0-16*Step-35,Y0+40);
 Line(X0-16*Step-20,Y0-40,X0-16*Step-20,Y0+40);
end;

Procedure Right(Step:Word);
begin
 SetLineStyle(SolidLn,0,ThickWidth);
 Rectangle(X0+16*Step,Y0-40,X0+16*Step+20,Y0+40);
end;

Begin
 grDriver:=Detect;
 InitGraph(grDriver, grMode, [COLOR=Red]'________'[/COLOR]); [COLOR=Red][B]- тут самостоятельно![/B]
[/COLOR] 
 X0:=GetMaxX div 2;
 Y0:=GetMaxY div 2;
 StepX_max:=Trunc((X0-35)/16);
 StepX:=4;
 ClearDevice;
 Garm(StepX);
 Left(StepX);
 Right(StepX);
 SetTextJustify(CenterText,BottomText);
 OutTextXY(X0,Y0*2-20,'Press any key to start...');
 ReadKey;
 Repeat
  StepX:=4;
  repeat
   StepX:=StepX+1;
   If StepX<=StepX_max then
    begin
     ClearDevice;
     Garm(StepX);
     Left(StepX);
     Right(StepX);
     OutTextXY(X0,Y0*2-20,'Press any key to stop...');
     Delay(100);
    end;
  until (StepX>=StepX_max) or KeyPressed;
  repeat
   StepX:=StepX-1;
   If StepX>3 then
    begin
     ClearDevice;
     Garm(StepX);
     Left(StepX);
     Right(StepX);
     OutTextXY(X0,Y0*2-20,'Press any key to stop...');
     Delay(100);
    end;
  until (StepX=3) or KeyPressed;
 Until KeyPressed;
 ReadKey;
 CloseGraph;
End.
 
подтверждаю. в DOS-mode работает туда и обратно. запускал через DOSBox 0.74.
 
Назад
Сверху